outmds.f

Go to the documentation of this file.

      subroutine outmds
c
c     write the output data set
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)
               k=(m-1)*jpart*(nx-1)+(j-1)*(nx-1)+i
               if(m.eq.1)then
                  bfr2(k)=(fioup(1,i,j)+fioup(2,i,j))
                  bfr3(k)=(fiodn(1,i,j)+fiodn(2,i,j))
               endif
               if(m.eq.2)then
                  bfr2(k)=(fioup(1,i,j)-fioup(2,i,j))
                  bfr3(k)=(fiodn(1,i,j)-fiodn(2,i,j))
               endif
               if(m.gt.2)then
                  bfr2(k)=fioup(m,i,j)
                  bfr3(k)=fiodn(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)=albwl(ksza)
        bfr2(nd+8)=albtdr(ksza)
        bfr2(nd+9)=albtdf(ksza)
        bfr2(nd+10)=albtrf(ksza)
        bfr2(nd+11)=albrdr(ksza)
      endif
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)=albwl(ksza)
        bfr3(nd+8)=albtdr(ksza)
        bfr3(nd+9)=albtdf(ksza)
        bfr3(nd+10)=albtrf(ksza)
        bfr3(nd+11)=albrdr(ksza)
      endif
c
      krecz=(nsza-1)*2+1
      if(kzz.eq.2)then
        krecz=2*nthe0+1
      endif
c
      do i=1,1915
         ebfr2(i)=bfr2(i)
         ebfr3(i)=bfr3(i)
      enddo
c
      krecz1=krecz+1
      krecz2=krecz+2
c     write(6,*)'krecz1,krecz2',krecz1,krecz2
      write(24,rec=krecz1)ebfr2
      write(24,rec=krecz2)ebfr3
      return
      end
c***********************************************************************