/[MITgcm]/MITgcm/pkg/fizhi/fizhi_swrad.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/fizhi_swrad.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.23 by molod, Sat May 21 23:50:13 2005 UTC revision 1.24 by ce107, Thu Jun 16 16:46:12 2005 UTC
# Line 169  c -------------------------------------- Line 169  c --------------------------------------
169          do L =1,lm          do L =1,lm
170          do j =1,jm          do j =1,jm
171          do i =1,im          do i =1,im
172           cldtot(i,j,L)=min(1.0,max(cldsw(i,j,L),fccave(i,j,L)/imstturb))           cldtot(i,j,L)=min(1.0 _d 0,max(cldsw(i,j,L),fccave(i,j,L)/imstturb))
173           cldmxo(i,j,L)=min(1.0,cswmo(i,j,L))           cldmxo(i,j,L)=min(1.0 _d 0,cswmo(i,j,L))
174             swlz(i,j,L)=swlz(i,j,L)+qliqave(i,j,L)/imstturb             swlz(i,j,L)=swlz(i,j,L)+qliqave(i,j,L)/imstturb
175          enddo          enddo
176          enddo          enddo
# Line 179  c -------------------------------------- Line 179  c --------------------------------------
179          do L =1,lm          do L =1,lm
180          do j =1,jm          do j =1,jm
181          do i =1,im          do i =1,im
182           cldtot(i,j,L) =  min( 1.0,cldsw(i,j,L) )           cldtot(i,j,L) =  min( 1.0 _d 0,cldsw(i,j,L) )
183           cldmxo(i,j,L) =  min( 1.0,cswmo(i,j,L) )           cldmxo(i,j,L) =  min( 1.0 _d 0,cswmo(i,j,L) )
184          enddo          enddo
185          enddo          enddo
186          enddo          enddo
# Line 426  c Partition Tau between Water and Ice Pa Line 426  c Partition Tau between Water and Ice Pa
426  c ---------------------------------------------  c ---------------------------------------------
427        do L= 1,lm        do L= 1,lm
428        do i= 1,istrip        do i= 1,istrip
429                alf = min( max((tzl(i,l)-253.15)/20.,0.) ,1.)                alf = min( max((tzl(i,l)-253.15)/20.,0. _d 0) ,1. _d 0)
430        taua(i,L)   = 0.        taua(i,L)   = 0.
431    
432        if( alf.ne.0.0 .and. alf.ne.1.0 ) then        if( alf.ne.0.0 .and. alf.ne.1.0 ) then
# Line 586  c ---------------------------- Line 586  c ----------------------------
586        do L=1,lm        do L=1,lm
587        do j=1,jm        do j=1,jm
588        do i=1,im        do i=1,im
589                   alf   =  min( max(( tl(i,j,L)-233.15)/20.,0.) ,1.)                   alf   =  min( max(( tl(i,j,L)-233.15)/20.,0. _d 0) ,1. _d 0)
590                    dp   =  ple(i,j,L+1)-ple(i,j,L)                    dp   =  ple(i,j,L+1)-ple(i,j,L)
591           tau(i,j,L,1)  = 0.0           tau(i,j,L,1)  = 0.0
592           tau(i,j,L,2)  = 0.0           tau(i,j,L,2)  = 0.0
# Line 606  c -------------------------------------- Line 606  c --------------------------------------
606    
607  c Large-Scale Ice  c Large-Scale Ice
608  c ---------------  c ---------------
609           tauice = max( 0.0002, 0.002*min(500*lz(i,j,L)*1000,1.0) )           tauice = max( 0.0002 _d 0, 0.002*min(500*lz(i,j,L)*1000,1.0 _d 0) )
610           tau(i,j,L,1) = fracls*(1-alf)*tauice*dp           tau(i,j,L,1) = fracls*(1-alf)*tauice*dp
611    
612  c Large-Scale Water  c Large-Scale Water
613  c -----------------  c -----------------
614  C Over Land  C Over Land
615           if( lwi(i,j).le.10 ) then           if( lwi(i,j).le.10 ) then
616            tauh2o = max( 0.0020, 0.200*min(200*lz(i,j,L)*1000,1.0) )              tauh2o = max( 0.0020 _d 0, 0.200*min(200*lz(i,j,L)*1000,1.0 _d 0) )  
617            tau(i,j,L,3) = fracls*alf*tauh2o*dp            tau(i,j,L,3) = fracls*alf*tauh2o*dp
618           else           else
619  C Non-Precipitation Clouds Over Ocean  C Non-Precipitation Clouds Over Ocean
# Line 622  C Non-Precipitation Clouds Over Ocean Line 622  C Non-Precipitation Clouds Over Ocean
622             tau(i,j,L,2) = fracls*alf*tauh2o*dp             tau(i,j,L,2) = fracls*alf*tauh2o*dp
623            else            else
624  C Over Ocean  C Over Ocean
625             tauh2o = max( 0.0020, 0.120*min( 20*lz(i,j,L)*1000,1.0) )               tauh2o = max( 0.0020 _d 0, 0.120*min( 20*lz(i,j,L)*1000,1.0 _d 0) )  
626             tau(i,j,L,3) = fracls*alf*tauh2o*dp             tau(i,j,L,3) = fracls*alf*tauh2o*dp
627            endif            endif
628           endif           endif
# Line 1079  c-----normalize cloud cover Line 1079  c-----normalize cloud cover
1079    
1080  c-----table look-up  c-----table look-up
1081    
1082             taux=min(taux,32.)             taux=min(taux,32. _d 0)
1083    
1084             fm=cosz(i,j)/dm             fm=cosz(i,j)/dm
1085             ft=(log10(taux)-t1)/dt             ft=(log10(taux)-t1)/dt
# Line 1115  c     angle, optical thickness, and clou Line 1115  c     angle, optical thickness, and clou
1115       *     caib(im,it,ia+1)*(1.+fa))*fa*.5+caib(im,it,ia)*(1.-fa*fa)       *     caib(im,it,ia+1)*(1.+fa))*fa*.5+caib(im,it,ia)*(1.-fa*fa)
1116    
1117             xai= xai-2.*caib(im,it,ia)             xai= xai-2.*caib(im,it,ia)
1118             xai=max(xai,0.0)             xai=max(xai,0.0 _d 0)
1119            
1120             tauclb(i,j,k) = taux*xai             tauclb(i,j,k) = taux*xai
1121    
# Line 1130  c     thickness and cover but not the so Line 1130  c     thickness and cover but not the so
1130       *      caif(it,ia+1)*(1.+fa))*fa*.5+caif(it,ia)*(1.-fa*fa)       *      caif(it,ia+1)*(1.+fa))*fa*.5+caif(it,ia)*(1.-fa*fa)
1131    
1132             xai= xai-caif(it,ia)             xai= xai-caif(it,ia)
1133             xai=max(xai,0.0)             xai=max(xai,0.0 _d 0)
1134            
1135             tauclf(i,j,k) = taux*xai             tauclf(i,j,k) = taux*xai
1136    
# Line 1341  c     for a mixture of ice and liquid pa Line 1341  c     for a mixture of ice and liquid pa
1341             taux=taucld(i,j,k,1)+taucld(i,j,k,2)             taux=taucld(i,j,k,1)+taucld(i,j,k,2)
1342            if (taux.gt.0.05 .and. fcld(i,j,k).gt.0.01) then            if (taux.gt.0.05 .and. fcld(i,j,k).gt.0.01) then
1343    
1344             reff1=min(reff(i,j,k,1),130.)             reff1=min(reff(i,j,k,1),130. _d 0)
1345             reff2=min(reff(i,j,k,2),20.0)             reff2=min(reff(i,j,k,2),20.0 _d 0)
1346    
1347             w1=(1.-(aia(ib,1)+(aia(ib,2)+             w1=(1.-(aia(ib,1)+(aia(ib,2)+
1348       *         aia(ib,3)*reff1)*reff1))*taucld(i,j,k,1)       *         aia(ib,3)*reff1)*reff1))*taucld(i,j,k,1)
# Line 1397  c-----compute reflectance and transmitta Line 1397  c-----compute reflectance and transmitta
1397    
1398  c            if (ssato .gt. 0.001) then  c            if (ssato .gt. 0.001) then
1399    
1400  c             ssato=min(ssato,0.999999)  c             ssato=min(ssato,0.999999 _d 0)
1401  c             asyto=asysto/(ssato*tauto)  c             asyto=asysto/(ssato*tauto)
1402    
1403  c             call deledd(tauto,ssato,asyto,csm(i,j),  c             call deledd(tauto,ssato,asyto,csm(i,j),
# Line 1429  c-----compute reflectance and transmitta Line 1429  c-----compute reflectance and transmitta
1429    
1430                tauto=tausto+tauclb(i,j,k)                tauto=tausto+tauclb(i,j,k)
1431                ssato=(ssatau+ssacl(i,j,k)*tauclb(i,j,k))/tauto+1.0e-8                ssato=(ssatau+ssacl(i,j,k)*tauclb(i,j,k))/tauto+1.0e-8
1432                ssato=min(ssato,0.999999)                ssato=min(ssato,0.999999 _d 0)
1433                asyto=(asysto+asycl(i,j,k)*ssacl(i,j,k)*tauclb(i,j,k))/                asyto=(asysto+asycl(i,j,k)*ssacl(i,j,k)*tauclb(i,j,k))/
1434       *              (ssato*tauto)       *              (ssato*tauto)
1435    
# Line 1438  c-----compute reflectance and transmitta Line 1438  c-----compute reflectance and transmitta
1438    
1439                tauto=tausto+tauclf(i,j,k)                tauto=tausto+tauclf(i,j,k)
1440                ssato=(ssatau+ssacl(i,j,k)*tauclf(i,j,k))/tauto+1.0e-8                ssato=(ssatau+ssacl(i,j,k)*tauclf(i,j,k))/tauto+1.0e-8
1441                ssato=min(ssato,0.999999)                ssato=min(ssato,0.999999 _d 0)
1442                asyto=(asysto+asycl(i,j,k)*ssacl(i,j,k)*tauclf(i,j,k))/                asyto=(asysto+asycl(i,j,k)*ssacl(i,j,k)*tauclf(i,j,k))/
1443       *              (ssato*tauto)       *              (ssato*tauto)
1444    
# Line 1732  c     liquid and ice particles.  unit of Line 1732  c     liquid and ice particles.  unit of
1732             taux=taucld(i,j,k,1)+taucld(i,j,k,2)             taux=taucld(i,j,k,1)+taucld(i,j,k,2)
1733            if (taux.gt.0.05 .and. fcld(i,j,k).gt.0.01) then            if (taux.gt.0.05 .and. fcld(i,j,k).gt.0.01) then
1734    
1735             reff1=min(reff(i,j,k,1),130.)             reff1=min(reff(i,j,k,1),130. _d 0)
1736             reff2=min(reff(i,j,k,2),20.0)             reff2=min(reff(i,j,k,2),20.0 _d 0)
1737    
1738             g1=(aig(1)+(aig(2)+aig(3)*reff1)*reff1)*taucld(i,j,k,1)             g1=(aig(1)+(aig(2)+aig(3)*reff1)*reff1)*taucld(i,j,k,1)
1739             g2=(awg(1)+(awg(2)+awg(3)*reff2)*reff2)*taucld(i,j,k,2)             g2=(awg(1)+(awg(2)+awg(3)*reff2)*reff2)*taucld(i,j,k,2)
# Line 1784  c-----compute reflectance and transmitta Line 1784  c-----compute reflectance and transmitta
1784    
1785            tauto=tausto            tauto=tausto
1786            ssato=ssatau/tauto+1.0e-8            ssato=ssatau/tauto+1.0e-8
1787            ssato=min(ssato,0.999999)            ssato=min(ssato,0.999999 _d 0)
1788            asyto=asysto/(ssato*tauto)            asyto=asysto/(ssato*tauto)
1789    
1790            call deledd(tauto,ssato,asyto,csm(i,j),            call deledd(tauto,ssato,asyto,csm(i,j),
# Line 1806  c-----compute reflectance and transmitta Line 1806  c-----compute reflectance and transmitta
1806    
1807             tauto=tausto+tauclb(i,j,k)             tauto=tausto+tauclb(i,j,k)
1808             ssato=(ssatau+tauclb(i,j,k))/tauto+1.0e-8             ssato=(ssatau+tauclb(i,j,k))/tauto+1.0e-8
1809             ssato=min(ssato,0.999999)             ssato=min(ssato,0.999999 _d 0)
1810             asyto=(asysto+asycl(i,j,k)*tauclb(i,j,k))/(ssato*tauto)             asyto=(asysto+asycl(i,j,k)*tauclb(i,j,k))/(ssato*tauto)
1811    
1812             call deledd(tauto,ssato,asyto,csm(i,j),             call deledd(tauto,ssato,asyto,csm(i,j),
# Line 1814  c-----compute reflectance and transmitta Line 1814  c-----compute reflectance and transmitta
1814    
1815             tauto=tausto+tauclf(i,j,k)             tauto=tausto+tauclf(i,j,k)
1816             ssato=(ssatau+tauclf(i,j,k))/tauto+1.0e-8             ssato=(ssatau+tauclf(i,j,k))/tauto+1.0e-8
1817             ssato=min(ssato,0.999999)             ssato=min(ssato,0.999999 _d 0)
1818             asyto=(asysto+asycl(i,j,k)*tauclf(i,j,k))/(ssato*tauto)             asyto=(asysto+asycl(i,j,k)*tauclf(i,j,k))/(ssato*tauto)
1819    
1820             call sagpol (tauto,ssato,asyto,rs2t(i,j),ts2t(i,j))             call sagpol (tauto,ssato,asyto,rs2t(i,j),ts2t(i,j))
Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22