outmds_trans.f

Go to the documentation of this file.

      subroutine outmds_trans
c
c     write the output data set
c
c**********************************************************************
c
c     include the common blocks
c
      implicit real*8 (a-h,o-z)
      include 'common_all.cmn'
c
c**********************************************************************
c
c
      do m=1,4
         do j=1,jpart
            do i=1,jjjj
               k=(m-1)*jpart*jjjj+(j-1)*jjjj+i
               if(m.eq.1)then
                  bfr2(k)=(fioup(1,i,j)+fioup(2,i,j))
                  bfr3(k)=(fioup_btm(1,i,j)+fioup_btm(2,i,j))
               endif
               if(m.eq.2)then
                  bfr2(k)=(fioup(1,i,j)-fioup(2,i,j))
                  bfr3(k)=(fioup_btm(1,i,j)-fioup_btm(2,i,j))
               endif
               if(m.gt.2)then
                  bfr2(k)=fioup(m,i,j)
                  bfr3(k)=fioup_btm(m,i,j)
               endif
            enddo
         enddo
      enddo
c
c
c     write(6,*)'fioup_btm'
c             do i=1,jjjj,5
c                 call radnce(pi,conv,bmu,the,fioup_btm,i,jpart,jphi)
c             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)=albwl(ksza)
        bfr2(nd+8)=albtdr(ksza)
        bfr2(nd+9)=albtdf(ksza)
        bfr2(nd+10)=albtrf(ksza)
        bfr2(nd+11)=albrdr(ksza)
      endif
c
      do i=1,11
         bfr3(nd+i)=-777.0
      enddo
c
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
      write(24,rec=krecz1)ebfr2
      write(24,rec=krecz2)ebfr3
      return
      end
c***********************************************************************