flxtop.f

Go to the documentation of this file.

      subroutine flxtop
c
c     subroutine flxtop computes the upward diffused flux at the        
c     top of the atmosphere for rg=0. also, it checks for flux balance  
c***********************************************************************
c.....include common blocks                                             
      implicit real*8 (a-h,o-z)
      include 'common_all.cmn'                                          
c***********************************************************************
c                                                                       
      sum = 0.0                                                         
      do  j = jjj,nmum1                                                 
          psum = 0.0                                                    
          do k = 1,2                                                    
             psum=fio(k,j,1)+fio(k,j,jpart)+psum                        
          enddo                                                         
          do k=1,2                                                      
               do i=2,noph2                                             
                    psum=psum+2.*fio(k,j,i)                             
               enddo                                                    
           enddo                                                        
             sum=sum+psum*dmus2(j)*6.2831854d0/dfloat(nophi)             
      enddo                                                             
      sumup=abs(sum)                                                    
      sumpi=sumup*pi                                                    
      amufac = amuo*factr                                               
      amufpi = amufac*pi                                                
      amzz=amuo                                                         
      if(kzz.eq.2) amzz=1.0                                             
      if(iref.eq.0)then                                                 
          flxbln=(sumup+(1.0-refl)*(sumdwn+amuo*(factr)))/amzz          
      endif                                                             
c     if(kzz.eq.1)write(6,7574)                                         
c     if(kzz.eq.2)write(6,7575)                                         
c     write(6,7576)                                                     
c     write(6,7577) amufac,amufpi                                       
c     write(6,2008) sumdwn,sumdpi                                       
c     write(6,2007) sumup,sumpi                                         
c     if(iref .eq. 0) write(6,2015) flxbln                              
c     if(iref.eq.1 .or. iref.eq.2)then
c        write(6,2011) sumc,sumcpi,calb                    
c     endif
c     if(iref.eq.3)then
c        write(6,2012) sumc,sumcpi,calb
c     endif
c     write(6,2025)jpass                                                
c     if(iref.eq.0)then                                                 
c         flxb(jpass)=flxbln                                            
c     endif                                                             
c******format statements************************************************
2007  format('upward diffused flux (top)',t35,'=',1pe12.4,                    
     1 2x,'( * pi = ',1pe12.4,' )' )                                    
2008  format( 'downward diffused flux (bottom)', t35, '=' ,1pe12.4, 
     1 2x,'( * pi = ',1pe12.4,' )' )                                    
2015   format('flux balance ',t35,'=',1pe12.4)                          
2011   format('upward diff. flux (above ocean)',t35,'=',1pe12.4,           
     1 2x,'( * pi = ',1pe12.4,' )' //                                   
     2  ,'ocean albedo ',t35,'=',1pe12.4  )                           
2012   format('upward diff. flux (above ocean)',t35,'=',1pe12.4,
     1 2x,'( * pi = ',1pe12.4,' )' //
     2  ,'surf. albedo ',t35,'=',1pe12.4  )
2025  format(/  t40,'***** end of iteration no. ', i5,                  
     1 '    *****'    /     )                                           
7574  format(/'illumination from top, f0=1')                            
7575  format(/'illumination from below')                                
7576  format(/'summary of flux calculations'  )                         
7577  format( 'direct downward flux',t35,'=',1pe12.4,                   
     1 2x,'( * pi = ', 1pe12.4,' )'  )                                  
c***********************************************************************
       return                                                           
       end                                                              
c***********************************************************************