crftout.f

Go to the documentation of this file.

      subroutine  crftout
c
c     write the output data set for the aircraft height
c
c**********************************************************************
c
c     include the common blocks
c
      implicit real*8 (a-h,o-z)
      include 'common_all.cmn'
c
c**********************************************************************
c
      do m=1,4
         do j=1,jpart
            do i=1,jjjj
               mz=nmum1-i+1
               k=(m-1)*jpart*jjjj+(j-1)*jjjj+i
               if(m.eq.1)then
                  bfr2(k)=(fiocrft(1,mz,j)+fiocrft(2,mz,j))
                  bfr3(k)=(fiocrft(1,i,j)+fiocrft(2,i,j))
               endif
               if(m.eq.2)then
                  bfr2(k)=(fiocrft(1,mz,j)-fiocrft(2,mz,j))
                  bfr3(k)=(fiocrft(1,i,j)-fiocrft(2,i,j))
               endif
               if(m.gt.2)then
                  bfr2(k)=fiocrft(m,mz,j)
                  bfr3(k)=fiocrft(m,i,j)
               endif
            enddo
         enddo
      enddo
c
      nd=jjjj*jpart*4
c
      bfr2(nd+1)=rmuo
      bfr2(nd+2)=1.0
      bfr2(nd+3)=amufac
      bfr2(nd+4)=temp1(nolyrp)
      bfr2(nd+5)=temp2(1)
      if(iref.eq.1 .or. iref.eq.2 .or. iref.eq.3)then
        bfr2(nd+6)=calb
        bfr2(nd+7)=flxupwat
      endif
      bfr2(nd+8)=crftfd
      bfr2(nd+9)=crftfu
      bfr2(nd+10)=hcrft
      bfr2(nd+11)=taucrft
c
      bfr3(nd+1)=rmuo
      bfr3(nd+2)=1.0
      bfr3(nd+3)=amufac
      bfr3(nd+4)=temp1(nolyrp)
      bfr3(nd+5)=temp2(1)
      if(iref.eq.1 .or. iref.eq.2 .or. iref.eq.3)then
        bfr3(nd+6)=calb
        bfr3(nd+7)=flxupwat
      endif
      bfr3(nd+8)=crftfd
      bfr3(nd+9)=crftfu
      bfr3(nd+10)=hcrft
      bfr3(nd+11)=taucrft
c
      kcrft=(nsza-1)*2+1
      if(kzz.eq.2)then
        kcrft=2*nthe0+1
      endif
c
      do i=1,1915
         ebfr2(i)=bfr2(i)
         ebfr3(i)=bfr3(i)
      enddo
c
      kcrft1=kcrft+1
      kcrft2=kcrft+2
      write(15,rec=kcrft1)ebfr2
      write(15,rec=kcrft2)ebfr3
      return
      end
c***********************************************************************