surfgcr.f

Go to the documentation of this file.

      subroutine surfgcr
c
c     apply geometric correction to the stokes parameters of the
c     upwelling diffused radiation leaving the surface
c
c**********************************************************************
c
      implicit real*8 (a-h,o-z)
      include 'afrt_rt2.cmn'
c
c**********************************************************************
c
      m1=jpass-2
      m2=jpass-1
      m3=jpass
c
c     apply geo. series correction to the upwelling radiances leaving 
c     bottom surface
c
      read(72,rec=m3)ftmp
      read(72,rec=m2)ftmpa
      read(72,rec=m1)ftmpb
c
      do i=nx,nmum1
         do j=1,jpart
            do k=1,4
               if(ftmp(k,i,j).le.1.0d-15)then
                  fiosurf(k,i,j)=ftmp(k,i,j)
               else
                  call geom(ftmpb(k,i,j),ftmpa(k,i,j),ftmp(k,i,j),
     1                      srftru1,fiosurf(k,i,j))
               endif
            enddo
         enddo
      enddo
c
c     
        do i=nx,nmum1
           m=nmum1-i+1
           do j=1,jpart
              surfzu(ksza,m,j)=fiosurf(1,i,j)+fiosurf(2,i,j)
           enddo
        enddo
c
      return
      end
c                                                                       
c**********************************************************************