fltocn_diff.f

Go to the documentation of this file.

      subroutine fltocn_diff
c
c     treat the lower boundary of the atmosphere as flat ocean and 
c     reflect all incident light (diffuse) according to 
c     fresnel law
c
c***********************************************************************
c.....include the common and declaration statemnets.....................
      implicit real*8 (a-h,o-z)
c
      include 'afrt_rt2.cmn'
      real*8 zx(4,4),temp(4,2*nsz,nph)
c***********************************************************************
c     write(*,*)'welcome to fltocn'
      xzx=-1.0d-8                                                       
      xr=1.3340d0
      xi=0.0d0
c
      do 500 it=1,(nx-1)
         itp=(nmum1-it)+1
         cost=cosmu(it)
         thetac= dacos(cost)  
         sinsq = (1.0d0-cost**2)
         sinsq2 = sinsq**2      
         a=(xr**2-xi**2-1.0d0+cost**2)                            
         b=(-2.0d0*xr*xi)                                        
         r=dsqrt(a**2+b**2)                                        
         tmr=cost**2*r                                                
         xp=dsqrt(2.0d0*r+2.0d0*a)                                  
         xmm=(2.0d0*r-2.0d0*a)                                  
         if(xmm .lt. 0.0d0 .and. xmm .gt. xzx) xmm=-xmm 
         xm=dsqrt(xmm)                                 
         dnmr1=(sinsq2+tmr+cost*sinsq*xp)                           
         qrmu=(sinsq2-tmr)/dnmr1                                     
         qimu=(cost*sinsq*xm)/dnmr1                                    
         dnmr2=(cost**2+r+cost*xp)                                  
         rrr=(cost**2-r)/dnmr2                                      
         rri=(cost*xm)/dnmr2                                          
         rer=qrmu*rrr-qimu*rri                                      
         rei=qimu*rrr+qrmu*rri                                      
         r11=rer**2+rei**2                                          
         r22=rrr**2+rri**2                                          
         r33=rer*rrr+rei*rri                                        
         r34=rri*rer-rei*rrr                                        
         zx(1,1)=r11
         zx(2,2)=r22
         zx(3,3)=r33
         zx(3,4)=r34
         zx(4,3)=-r34
         zx(4,4)=r33
c
c        apply the zx matrix to the incident radiation
c        solid angle of the incident beam=solid angle of the reflected beam
         do ip=1,jpart
            do i=1,4
               sum2=0.0d0
               do j=1,4
                  sum2=sum2+zx(i,j)*fio(j,it,ip)
               enddo
               temp(i,itp,ip)=sum2
            enddo
         enddo
 500  continue
c
c     tranfer the stokes parameter from the temp buffer to fio
c     only for the upward direction. also add water-leaving radiances
c
      read(55,rec=nolyr+1)fiib
      do it=(nx-1)+1,nmum1
         do ip=1,jpart
            do i=1,4
               fio(i,it,ip)=temp(i,it,ip)+fiib(i,it,ip)
            enddo
         enddo
      enddo
c
c     write(6,*)'Upwelling radiances just above ocn surface'
c     do i=nx,nmum1
c        call radnce(pi,conv,cosmu,the,fio,i,jpart,jphi)
c     enddo
 
c
      return                                                            
      end                                                               
c***********************************************************************