NASA Ocean Color

ocssw V2022
       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 'afrt_rt2.cmn'
 c
 c**********************************************************************
 c
       do m=1,4
          do j=1,jpart
             do i=1,(nx-1)
                mz=nmum1-i+1
                k=(m-1)*jpart*(nx-1)+(j-1)*(nx-1)+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=(nx-1)*jpart*4
 c
       bfr2(nd+1)=rmuo
       bfr2(nd+2)=1.0
       bfr2(nd+3)=amufac
       bfr2(nd+4)=temp1(nolyr+1)
       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(nolyr+1)
       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***********************************************************************
crftout
subroutine crftout
Definition: crftout.f:2