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

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

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

revision 1.3 by molod, Thu Jun 24 19:57:02 2004 UTC revision 1.24 by ce107, Thu Jun 16 16:46:12 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "FIZHI_OPTIONS.h"
5        subroutine lwrio (nymd,nhms,bi,bj,istrip,npcs,        subroutine lwrio (nymd,nhms,bi,bj,myid,istrip,npcs,
6       .                  pz,tz,qz,plz,plze,pkz,pkht,oz,co2,       .                  low_level,mid_level,
7       .                  cfc11,cfc12,cfc22,       .                  im,jm,lm,
8       .                  methane,n2o,emissivity,       .                  pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,
9         .                  co2,cfc11,cfc12,cfc22,methane,n2o,emissivity,
10       .                  tgz,radlwg,st4,dst4,       .                  tgz,radlwg,st4,dst4,
11       .                  dtradlw,dlwdtg,dtradlwc,lwgclr,       .                  dtradlw,dlwdtg,dtradlwc,lwgclr,
      .                  im,jm,lm,ptop,  
12       .                  nlwcld,cldlw,clwmo,nlwlz,lwlz,       .                  nlwcld,cldlw,clwmo,nlwlz,lwlz,
13       .                  lpnt,imstturb,qliqave,fccave,landtype)       .                  lpnt,imstturb,qliqave,fccave,landtype)
14    
15        implicit none        implicit none
 #ifdef ALLOW_DIAGNOSTICS  
 #include 'diagnostics.h'  
 #endif  
16    
17  c Input Variables  c Input Variables
18  c ---------------  c ---------------
19        integer nymd,nhms,istrip,npcs,bi,bj        integer nymd,nhms,istrip,npcs,bi,bj,myid
20          integer mid_level,low_level
21        integer im,jm,lm                integer im,jm,lm        
22        real  ptop                      _RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1)
23          _RL dpres(im,jm,lm),pkht(im,jm,lm+1),pkz(im,jm,lm)
24        real    pz(im,jm)              _RL tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm)
25        real    tz(im,jm,lm)            _RL co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)    
26        real  pkht(im,jm,lm)            _RL emissivity(im,jm,10)
27          _RL tgz(im,jm),radlwg(im,jm),st4(im,jm),dst4(im,jm)    
28        real    co2,cfc11              _RL dtradlw(im,jm,lm),dlwdtg (im,jm,lm)
29        real    cfc12,cfc22            _RL dtradlwc(im,jm,lm),lwgclr(im,jm)    
30        real    methane (lm)            integer nlwcld,nlwlz
31        real    n2o     (lm)            _RL cldlw(im,jm,lm),clwmo(im,jm,lm),lwlz(im,jm,lm)
32        real    oz(im,jm,lm)            logical lpnt
33        real    qz(im,jm,lm)            integer imstturb
34          _RL qliqave(im,jm,lm),fccave(im,jm,lm)
35        real  radlwg(im,jm)            integer landtype(im,jm)
       real  lwgclr(im,jm)      
       real     st4(im,jm)      
       real    dst4(im,jm)      
       real dtradlw (im,jm,lm)  
       real dtradlwc(im,jm,lm)  
       real  dlwdtg (im,jm,lm)  
   
       integer nlwcld,nlwlz      
       real  cldlw(im,jm,lm)    
       real  clwmo(im,jm,lm)    
       real   lwlz(im,jm,lm)    
   
       real emissivity(im,jm,10)    
       real        tgz(im,jm)      
       logical   lpnt              
       integer   imstturb          
       real    qliqave(im,jm,lm)    
       real     fccave(im,jm,lm)    
   
       integer landtype(im,jm)  
36    
37  c Local Variables  c Local Variables
38  c ---------------  c ---------------
39        integer i,j,l,n,nn        integer i,j,l,n,nn
       integer mid_level,low_level  
40    
41        real          PLZ(im,jm,lm)        _RL cldtot (im,jm,lm)
42        real          PKZ(im,jm,lm)        _RL cldmxo (im,jm,lm)
43        real         PLZE(im,jm,lm+1)  
44        real      cldtot (im,jm,lm)        _RL pl(istrip,lm)
45        real      cldmxo (im,jm,lm)        _RL pk(istrip,lm)
46          _RL pke(istrip,lm)
47        real       pl(istrip,lm)        _RL ple(istrip,lm+1)
48        real       pk(istrip,lm)  
49        real      pke(istrip,lm)        _RL ADELPL(ISTRIP,lm)
50        real      ple(istrip,lm+1)        _RL dtrad(istrip,lm),dtradc(istrip,lm)
51          _RL OZL(ISTRIP,lm),TZL(ISTRIP,lm)
52        real       ADELPL(ISTRIP,lm)        _RL SHZL(ISTRIP,lm),CLRO(ISTRIP,lm)
53        real        dtrad(istrip,lm)   , dtradc(istrip,lm)        _RL CLMO(ISTRIP,lm)
54        real          OZL(ISTRIP,lm)   ,    TZL(ISTRIP,lm)        _RL flx(ISTRIP,lm+1),flxclr(ISTRIP,lm+1)
55        real         SHZL(ISTRIP,lm)   ,   CLRO(ISTRIP,lm)        _RL cldlz(istrip,lm)
56        real         CLMO(ISTRIP,lm)        _RL dfdts(istrip,lm+1),dtdtg(istrip,lm)
57        real          flx(ISTRIP,lm+1) , flxclr(ISTRIP,lm+1)  
58        real        cldlz(istrip,lm)        _RL emiss(istrip,10)
59        real        dfdts(istrip,lm+1) , dtdtg(istrip,lm)        _RL taual(istrip,lm,10)
60          _RL ssaal(istrip,lm,10)
61        real        emiss(istrip,10)        _RL asyal(istrip,lm,10)
62        real        taual(istrip,lm,10)        _RL cwc(istrip,lm,3)
63        real        ssaal(istrip,lm,10)        _RL reff(istrip,lm,3)
64        real        asyal(istrip,lm,10)        _RL tauc(istrip,lm,3)
65        real          cwc(istrip,lm,3)  
66        real         reff(istrip,lm,3)        _RL SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP)
67        real         tauc(istrip,lm,3)        integer lwi(istrip)
68    
69        real        SGMT4(ISTRIP)        _RL tmpstrip(istrip,lm)
70        real        TSURF(ISTRIP)        _RL tmpimjm(im,jm,lm)
71        real       dsgmt4(ISTRIP)        _RL tempor1(im,jm),tempor2(im,jm)
       integer       lwi(istrip)  
   
       real    getcon,secday,convrt,pcheck  
   
       integer  koz, kh2o  
       DATA     KOZ  /20/  
       data     kh2o /18/  
       logical  high,  trace, cldwater  
       data     high /.true./  
       data    trace /.true./  
       data cldwater /.false./  
72    
73          _RL getcon,secday,convrt
74    #ifdef ALLOW_DIAGNOSTICS
75          logical  diagnostics_is_on
76          external diagnostics_is_on
77          _RL tmpdiag(im,jm)
78    #endif
79    
80          logical high,  trace, cldwater
81    c     data high /.true./
82    c     data trace /.true./
83          data high /.false./
84          data trace /.false./
85          data cldwater /.false./
86    
87  C **********************************************************************  C **********************************************************************
88  C ****                     INITIALIZATION                           ****  C ****                     INITIALIZATION                           ****
# Line 113  C ************************************** Line 91  C **************************************
91        SECDAY = GETCON('SDAY')        SECDAY = GETCON('SDAY')
92        CONVRT = GETCON('GRAVITY') / ( 100.0 * GETCON('CP') )        CONVRT = GETCON('GRAVITY') / ( 100.0 * GETCON('CP') )
93    
 c Determine Level Indices for Low-Mid-High Cloud Regions  
 c ------------------------------------------------------  
       low_level = lm  
       mid_level = lm  
       do L = lm-1,1,-1  
       pcheck = plz(  
   
       if (pcheck.gt.700.0) low_level = L  
       if (pcheck.gt.400.0) mid_level = L  
       enddo  
   
94  c Adjust cloud fractions and cloud liquid water due to moist turbulence  c Adjust cloud fractions and cloud liquid water due to moist turbulence
95  c ---------------------------------------------------------------------  c ---------------------------------------------------------------------
96        if(imstturb.ne.0) then        if(imstturb.ne.0) then
97          do L =1,lm          do L =1,lm
98          do j =1,jm          do j =1,jm
99          do i =1,im          do i =1,im
100           cldtot(i,j,L)=min(1.0,max(cldlw(i,j,L),fccave(i,j,L)/imstturb))           cldtot(i,j,L)=min(1.0 _d 0,max(cldlw(i,j,L),fccave(i,j,L)/imstturb))
101           cldmxo(i,j,L) =  min( 1.0 ,      clwmo(i,j,L) )           cldmxo(i,j,L) =  min( 1.0 _d 0,      clwmo(i,j,L) )
102             lwlz(i,j,L) =  lwlz(i,j,L) + qliqave(i,j,L)/imstturb             lwlz(i,j,L) =  lwlz(i,j,L) + qliqave(i,j,L)/imstturb
103          enddo          enddo
104          enddo          enddo
# Line 140  c -------------------------------------- Line 107  c --------------------------------------
107          do L =1,lm          do L =1,lm
108          do j =1,jm          do j =1,jm
109          do i =1,im          do i =1,im
110           cldtot(i,j,L) =  min( 1.0,cldlw(i,j,L) )           cldtot(i,j,L) =  min( 1.0 _d 0,cldlw(i,j,L) )
111           cldmxo(i,j,L) =  min( 1.0,clwmo(i,j,L) )           cldmxo(i,j,L) =  min( 1.0 _d 0,clwmo(i,j,L) )
112          enddo          enddo
113          enddo          enddo
114          enddo          enddo
# Line 173  C ************************************** Line 140  C **************************************
140    
141         call stripitint (landtype,lwi,im*jm,im*jm,istrip,1,nn)         call stripitint (landtype,lwi,im*jm,im*jm,istrip,1,nn)
142    
143         DO I = 1,ISTRIP*lm         DO L = 1,lm
144          ADELPL(I,1) = convrt / ( ple(I,2)-ple(I,1) )         DO I = 1,ISTRIP
145            ADELPL(I,L) = convrt / ( ple(I,L+1)-ple(I,L) )
146           ENDDO
147         ENDDO         ENDDO
148    
149  C Compute Clouds  C Compute Clouds
# Line 182  C -------------- Line 151  C --------------
151         IF(NLWCLD.NE.0)THEN         IF(NLWCLD.NE.0)THEN
152         DO L = 1,lm         DO L = 1,lm
153         DO I = 1,ISTRIP         DO I = 1,ISTRIP
154          CLRO(I,L) = min( 1.0,clro(i,L) )          CLRO(I,L) = min( 1.0 _d 0,clro(i,L) )
155          CLMO(I,L) = min( 1.0,clmo(i,L) )          CLMO(I,L) = min( 1.0 _d 0,clmo(i,L) )
156         ENDDO         ENDDO
157         ENDDO         ENDDO
158         ENDIF         ENDIF
159    
160    C Convert to Temperature from Fizhi Theta
161    C ---------------------------------------
162        DO L = 1,lm        DO L = 1,lm
163        DO I = 1,ISTRIP        DO I = 1,ISTRIP
164        TZL(I,L) = TZL(I,L)*pk(I,L)        TZL(I,L) = TZL(I,L)*pk(I,L)
# Line 251  C ************************************** Line 222  C **************************************
222         do L = 1,lm         do L = 1,lm
223         do i = 1,istrip         do i = 1,istrip
224           dtrad(i,L) = (   flx(i,L)-   flx(i,L+1))*adelpl(i,L)           dtrad(i,L) = (   flx(i,L)-   flx(i,L+1))*adelpl(i,L)
225             tmpstrip(i,L) = flx(i,L)
226           dtdtg(i,L) = ( dfdts(i,L)- dfdts(i,L+1))*adelpl(i,L)           dtdtg(i,L) = ( dfdts(i,L)- dfdts(i,L+1))*adelpl(i,L)
227          dtradc(i,L) = (flxclr(i,L)-flxclr(i,L+1))*adelpl(i,L)          dtradc(i,L) = (flxclr(i,L)-flxclr(i,L+1))*adelpl(i,L)
228         enddo         enddo
# Line 279  C ************************************** Line 251  C **************************************
251  C ****            PASTE AND BUMP SOME DIAGNOSTICS                   ****  C ****            PASTE AND BUMP SOME DIAGNOSTICS                   ****
252  C **********************************************************************  C **********************************************************************
253    
254        IF(IOLR.GT.0)CALL PSTBMP(flx(1,1),QDIAG(1,1,IOLR,bi,bj),ISTRIP,        CALL PASTE(flx(1,1),tempor1,ISTRIP,im*jm,1,NN)
255       .                                                      im*jm, 1,NN)        CALL PASTE(flxclr(1,1),tempor2,ISTRIP,im*jm,1,NN)
       IF(IOLRCLR.GT.0)CALL PSTBMP(flxclr(1,1),QDIAG(1,1,IOLRCLR,bi,bj),  
      .                                                ISTRIP,im*jm,1,NN)  
       IF(IOZLW.GT.0)CALL PSTBMP(OZL(1,1),QDIAG(1,1,IOZLW,bi,bj),ISTRIP,  
      .                                                      im*jm,lm,NN)  
256    
257  C **********************************************************************  C **********************************************************************
258  C ****                 TENDENCY UPDATES                             ****  C ****                 TENDENCY UPDATES                             ****
# Line 292  C ************************************** Line 260  C **************************************
260    
261        DO L = 1,lm        DO L = 1,lm
262        DO I = 1,ISTRIP        DO I = 1,ISTRIP
263        DTRAD (I,L) = ( ple(i,lm+1)-PTOP ) * DTRAD (I,L)/pk(I,L)        DTRAD (I,L) = ple(i,lm+1) * DTRAD (I,L)/pk(I,L)
264        DTRADC(I,L) = ( ple(i,lm+1)-PTOP ) * DTRADC(I,L)/pk(I,L)        DTRADC(I,L) = ple(i,lm+1) * DTRADC(I,L)/pk(I,L)
265         dtdtg(I,L) = ( ple(i,lm+1)-PTOP ) * dtdtg (I,L)/pk(I,L)         dtdtg(I,L) = ple(i,lm+1) * dtdtg (I,L)/pk(I,L)
266        ENDDO        ENDDO
267        ENDDO        ENDDO
268          CALL PASTE ( tmpstrip ,tmpimjm ,ISTRIP,im*jm,lm,NN )
269        CALL PASTE ( DTRAD ,DTRADLW ,ISTRIP,im*jm,lm,NN )        CALL PASTE ( DTRAD ,DTRADLW ,ISTRIP,im*jm,lm,NN )
270        CALL PASTE ( DTRADC,DTRADLWC,ISTRIP,im*jm,lm,NN )        CALL PASTE ( DTRADC,DTRADLWC,ISTRIP,im*jm,lm,NN )
271        CALL PASTE ( dtdtg ,dlwdtg  ,ISTRIP,im*jm,lm,NN )        CALL PASTE ( dtdtg ,dlwdtg  ,ISTRIP,im*jm,lm,NN )
# Line 307  C ************************************** Line 276  C **************************************
276  C ****                     BUMP DIAGNOSTICS                         ****  C ****                     BUMP DIAGNOSTICS                         ****
277  C **********************************************************************  C **********************************************************************
278    
279        if(itgrlw.ne.0) then  #ifdef ALLOW_DIAGNOSTICS
280        do j = 1,jm        if(diagnostics_is_on('TGRLW   ',myid) ) then
281        do i = 1,im         call diagnostics_fill(tgz,'TGRLW   ',0,1,3,bi,bj,myid)
       qdiag(i,j,itgrlw,bi,bj) = qdiag(i,j,itgrlw,bi,bj) + tgz(i,j)  
       enddo  
       enddo  
282        endif        endif
283    
       if (itlw.ne.0) then  
284        do L = 1,lm        do L = 1,lm
       do j = 1,jm  
       do i = 1,im  
       qdiag(i,j,itlw+L-1,bi,bj) = qdiag(i,j,itlw+L-1,bi,bj) +  
      .                                             tz(i,j,L)*pkz(i,j,L)  
       enddo  
       enddo  
       enddo  
       endif  
285    
286        if (ishrad.ne.0) then         if(diagnostics_is_on('TLW     ',myid) ) then
287        do L = 1,lm          do j = 1,jm
288        do j = 1,jm          do i = 1,im
289        do i = 1,im           tmpdiag(i,j) = tz(i,j,L)*pkz(i,j,L)
290        qdiag(i,j,ishrad+L-1,bi,bj) = qdiag(i,j,ishrad+L-1,bi,bj) +          enddo
291       .                                             qz(i,j,L)*1000          enddo
292        enddo          call diagnostics_fill(tmpdiag,'TLW     ',L,1,3,bi,bj,myid)
293        enddo         endif
294    
295           if(diagnostics_is_on('SHRAD   ',myid) ) then
296            do j = 1,jm
297            do i = 1,im
298             tmpdiag(i,j) = qz(i,j,L)*1000.
299            enddo
300            enddo
301            call diagnostics_fill(tmpdiag,'SHRAD   ',L,1,3,bi,bj,myid)
302           endif
303    
304           if(diagnostics_is_on('OZLW    ',myid) ) then
305            do j = 1,jm
306            do i = 1,im
307             tmpdiag(i,j) = oz(i,j,L)
308            enddo
309            enddo
310            call diagnostics_fill(tmpdiag,'OZLW    ',L,1,3,bi,bj,myid)
311           endif
312    
313        enddo        enddo
314    
315          if(diagnostics_is_on('OLR     ',myid) ) then
316           call diagnostics_fill(tempor1,'OLR     ',0,1,3,bi,bj,myid)
317        endif        endif
318    
319          if(diagnostics_is_on('OLRCLR  ',myid) ) then
320           call diagnostics_fill(tempor2,'OLRCLR  ',0,1,3,bi,bj,myid)
321          endif
322    #endif
323    
324  C **********************************************************************  C **********************************************************************
325  C ****    Increment Diagnostics Counters and Zero-Out Cloud Info    ****  C ****    Increment Diagnostics Counters and Zero-Out Cloud Info    ****
326  C **********************************************************************  C **********************************************************************
327    
       ntlw     = ntlw     + 1  
       nshrad   = nshrad   + 1  
       nozlw    = nozlw    + 1  
       ntgrlw   = ntgrlw   + 1  
       nolr     = nolr     + 1  
       nolrclr  = nolrclr  + 1  
   
328        nlwlz    = 0        nlwlz    = 0
329        nlwcld   = 0        nlwcld   = 0
330        imstturb = 0        imstturb = 0
# Line 589  cfpp$ expand (b10kdis) Line 565  cfpp$ expand (b10kdis)
565  c---- input parameters ------  c---- input parameters ------
566    
567        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
568        real pl(m,ndim,np+1),ta(m,ndim,np),wa(m,ndim,np),oa(m,ndim,np),        _RL pl(m,ndim,np+1),ta(m,ndim,np),wa(m,ndim,np),oa(m,ndim,np),
569       *     ts(m,ndim)       *     ts(m,ndim)
570        real co2,n2o(np),ch4(np),cfc11,cfc12,cfc22,emiss(m,ndim,10)        _RL co2,n2o(np),ch4(np),cfc11,cfc12,cfc22,emiss(m,ndim,10)
571        real cwc(m,ndim,np,3),taucl(m,ndim,np,3),reff(m,ndim,np,3),        _RL cwc(m,ndim,np,3),taucl(m,ndim,np,3),reff(m,ndim,np,3),
572       *     fcld(m,ndim,np)       *     fcld(m,ndim,np)
573        real taual(m,ndim,np,10),ssaal(m,ndim,np,10),asyal(m,ndim,np,10)        _RL taual(m,ndim,np,10),ssaal(m,ndim,np,10),asyal(m,ndim,np,10)
574        logical cldwater,high,trace        logical cldwater,high,trace
575    
576  c---- output parameters ------  c---- output parameters ------
577    
578        real flx(m,ndim,np+1),flc(m,ndim,np+1),dfdts(m,ndim,np+1),        _RL flx(m,ndim,np+1),flc(m,ndim,np+1),dfdts(m,ndim,np+1),
579       *     st4(m,ndim)       *     st4(m,ndim)
580    
581  c---- static data -----  c---- static data -----
582    
583        real cb(5,10)        _RL cb(5,10)
584        real xkw(9),aw(9),bw(9),pm(9),fkw(6,9),gkw(6,3),xke(9)        _RL xkw(9),aw(9),bw(9),pm(9),fkw(6,9),gkw(6,3),xke(9)
585        real aib(3,10),awb(4,10),aiw(4,10),aww(4,10),aig(4,10),awg(4,10)        _RL aib(3,10),awb(4,10),aiw(4,10),aww(4,10),aig(4,10),awg(4,10)
586        integer ne(9),mw(9)        integer ne(9),mw(9)
587    
588  c---- temporary arrays -----  c---- temporary arrays -----
589    
590        real pa(m,n,np),dt(m,n,np)        _RL pa(m,n,np),dt(m,n,np)
591        real sh2o(m,n,np+1),swpre(m,n,np+1),swtem(m,n,np+1)        _RL sh2o(m,n,np+1),swpre(m,n,np+1),swtem(m,n,np+1)
592        real sco3(m,n,np+1),scopre(m,n,np+1),scotem(m,n,np+1)        _RL sco3(m,n,np+1),scopre(m,n,np+1),scotem(m,n,np+1)
593        real dh2o(m,n,np),dcont(m,n,np),dco2(m,n,np),do3(m,n,np)        _RL dh2o(m,n,np),dcont(m,n,np),dco2(m,n,np),do3(m,n,np)
594        real dn2o(m,n,np),dch4(m,n,np)        _RL dn2o(m,n,np),dch4(m,n,np)
595        real df11(m,n,np),df12(m,n,np),df22(m,n,np)        _RL df11(m,n,np),df12(m,n,np),df22(m,n,np)
596        real th2o(m,n,6),tcon(m,n,3),tco2(m,n,6,2)        _RL th2o(m,n,6),tcon(m,n,3),tco2(m,n,6,2)
597        real tn2o(m,n,4),tch4(m,n,4),tcom(m,n,2)        _RL tn2o(m,n,4),tch4(m,n,4),tcom(m,n,2)
598        real tf11(m,n),tf12(m,n),tf22(m,n)        _RL tf11(m,n),tf12(m,n),tf22(m,n)
599        real h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)        _RL h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)
600        real n2oexp(m,n,np,4),ch4exp(m,n,np,4),comexp(m,n,np,2)        _RL n2oexp(m,n,np,4),ch4exp(m,n,np,4),comexp(m,n,np,2)
601        real f11exp(m,n,np),  f12exp(m,n,np),  f22exp(m,n,np)        _RL f11exp(m,n,np),  f12exp(m,n,np),  f22exp(m,n,np)
602        real clr(m,n,0:np+1),fclr(m,n)        _RL clr(m,n,0:np+1),fclr(m,n)
603        real blayer(m,n,0:np+1),dlayer(m,n,np+1),dbs(m,n)        _RL blayer(m,n,0:np+1),dlayer(m,n,np+1),dbs(m,n)
604        real clrlw(m,n),clrmd(m,n),clrhi(m,n)        _RL clrlw(m,n),clrmd(m,n),clrhi(m,n)
605        real cwp(m,n,np,3)        _RL cwp(m,n,np,3)
606        real trant(m,n),tranal(m,n),transfc(m,n,np+1),trantcr(m,n,np+1)        _RL trant(m,n),tranal(m,n),transfc(m,n,np+1),trantcr(m,n,np+1)
607        real flxu(m,n,np+1),flxd(m,n,np+1),flcu(m,n,np+1),flcd(m,n,np+1)        _RL flxu(m,n,np+1),flxd(m,n,np+1),flcu(m,n,np+1),flcd(m,n,np+1)
608        real rflx(m,n,np+1),rflc(m,n,np+1)        _RL rflx(m,n,np+1),rflc(m,n,np+1)
609    
610        logical oznbnd,co2bnd,h2otbl,conbnd,n2obnd        logical oznbnd,co2bnd,h2otbl,conbnd,n2obnd
611        logical ch4bnd,combnd,f11bnd,f12bnd,f22bnd,b10bnd        logical ch4bnd,combnd,f11bnd,f12bnd,f22bnd,b10bnd
612    
613        real c1 (nx,nc,nt),c2 (nx,nc,nt),c3 (nx,nc,nt)        _RL c1 (nx,nc,nt),c2 (nx,nc,nt),c3 (nx,nc,nt)
614        real o1 (nx,no,nt),o2 (nx,no,nt),o3 (nx,no,nt)        _RL o1 (nx,no,nt),o2 (nx,no,nt),o3 (nx,no,nt)
615        real h11(nx,nh,nt),h12(nx,nh,nt),h13(nx,nh,nt)        _RL h11(nx,nh,nt),h12(nx,nh,nt),h13(nx,nh,nt)
616        real h21(nx,nh,nt),h22(nx,nh,nt),h23(nx,nh,nt)        _RL h21(nx,nh,nt),h22(nx,nh,nt),h23(nx,nh,nt)
617        real h81(nx,nh,nt),h82(nx,nh,nt),h83(nx,nh,nt)        _RL h81(nx,nh,nt),h82(nx,nh,nt),h83(nx,nh,nt)
618    
619        real dp,xx,p1,dwe,dpe,a1,b1,fk1,a2,b2,fk2        _RL dp,xx,p1,dwe,dpe,a1,b1,fk1,a2,b2,fk2
620        real w1,w2,w3,g1,g2,g3,ww,gg,ff,taux,reff1,reff2        _RL w1,w2,w3,g1,g2,g3,ww,gg,ff,taux,reff1,reff2
621    
622  c-----the following coefficients (equivalent to table 2 of  c-----the following coefficients (equivalent to table 2 of
623  c     chou and suarez, 1995) are for computing spectrally  c     chou and suarez, 1995) are for computing spectrally
# Line 810  c     o3 (band 5), and h2o (bands 1, 2, Line 786  c     o3 (band 5), and h2o (bands 1, 2,
786        logical first        logical first
787        data first /.true./        data first /.true./
788    
789        include "h2o.tran3"  #include "h2o-tran3.h"
790        include "co2.tran3"  #include "co2-tran3.h"
791        include "o3.tran3"  #include "o3-tran3.h"
792    
793        save c1,c2,c3,o1,o2,o3  c     save c1,c2,c3,o1,o2,o3
794        save h11,h12,h13,h21,h22,h23,h81,h82,h83  c     save h11,h12,h13,h21,h22,h23,h81,h82,h83
795    
796        if (first) then        if (first) then
797    
# Line 1120  c     to 0.54 and 0.95, respectively. Line 1096  c     to 0.54 and 0.95, respectively.
1096    
1097            if (taux.gt.0.02 .and. fcld(i,j,k).gt.0.01) then            if (taux.gt.0.02 .and. fcld(i,j,k).gt.0.01) then
1098    
1099             reff1=min(reff(i,j,k,1),130.)             reff1=min(reff(i,j,k,1),130. _d 0)
1100             reff2=min(reff(i,j,k,2),20.0)             reff2=min(reff(i,j,k,2),20.0 _d 0)
1101    
1102             w1=taucl(i,j,k,1)*(aiw(1,ib)+(aiw(2,ib)+(aiw(3,ib)             w1=taucl(i,j,k,1)*(aiw(1,ib)+(aiw(2,ib)+(aiw(3,ib)
1103       *       +aiw(4,ib)*reff1)*reff1)*reff1)       *       +aiw(4,ib)*reff1)*reff1)*reff1)
# Line 1262  c-----initialize fluxes Line 1238  c-----initialize fluxes
1238         enddo         enddo
1239        enddo        enddo
1240    
   
1241        do 2000 k1=1,np        do 2000 k1=1,np
1242    
1243  c-----initialize fclr, th2o, tcon, tco2, and tranal  c-----initialize fclr, th2o, tcon, tco2, and tranal
# Line 1443  c-----compute water vapor transmittance Line 1418  c-----compute water vapor transmittance
1418            if (ib.eq.1) then            if (ib.eq.1) then
1419             call tablup(k1,k2,m,n,np,nx,nh,nt,sh2o,swpre,swtem,             call tablup(k1,k2,m,n,np,nx,nh,nt,sh2o,swpre,swtem,
1420       *                 w1,p1,dwe,dpe,h11,h12,h13,trant)       *                 w1,p1,dwe,dpe,h11,h12,h13,trant)
   
1421            endif            endif
1422            if (ib.eq.2) then            if (ib.eq.2) then
1423             call tablup(k1,k2,m,n,np,nx,nh,nt,sh2o,swpre,swtem,             call tablup(k1,k2,m,n,np,nx,nh,nt,sh2o,swpre,swtem,
# Line 1478  c-----compute co2 transmittance using ta Line 1452  c-----compute co2 transmittance using ta
1452            dpe=0.2            dpe=0.2
1453            call tablup(k1,k2,m,n,np,nx,nc,nt,sco3,scopre,scotem,            call tablup(k1,k2,m,n,np,nx,nc,nt,sco3,scopre,scotem,
1454       *                w1,p1,dwe,dpe,c1,c2,c3,trant)       *                w1,p1,dwe,dpe,c1,c2,c3,trant)
1455    
1456         else         else
1457    
1458  c-----compute co2 transmittance using k-distribution method  c-----compute co2 transmittance using k-distribution method
# Line 1496  c-----All use table look-up to compute o Line 1471  c-----All use table look-up to compute o
1471            dpe=0.2            dpe=0.2
1472            call tablup(k1,k2,m,n,np,nx,no,nt,sco3,scopre,scotem,            call tablup(k1,k2,m,n,np,nx,no,nt,sco3,scopre,scotem,
1473       *                w1,p1,dwe,dpe,o1,o2,o3,trant)       *                w1,p1,dwe,dpe,o1,o2,o3,trant)
1474    
1475        endif        endif
1476    
1477  c***** for trace gases *****  c***** for trace gases *****
# Line 1755  c*************************************** Line 1731  c***************************************
1731    
1732  c---- input parameters -----  c---- input parameters -----
1733    
1734        real pa(m,n,np),dt(m,n,np),sabs0(m,n,np)        _RL pa(m,n,np),dt(m,n,np),sabs0(m,n,np)
1735    
1736  c---- output parameters -----  c---- output parameters -----
1737    
1738        real sabs(m,n,np+1),spre(m,n,np+1),stem(m,n,np+1)        _RL sabs(m,n,np+1),spre(m,n,np+1),stem(m,n,np+1)
1739    
1740  c*********************************************************************  c*********************************************************************
1741          do j=1,n          do j=1,n
# Line 1810  c*************************************** Line 1786  c***************************************
1786    
1787  c---- input parameters ------  c---- input parameters ------
1788    
1789        real dh2o(m,n,np),pa(m,n,np),dt(m,n,np)        _RL dh2o(m,n,np),pa(m,n,np),dt(m,n,np)
1790    
1791  c---- output parameters -----  c---- output parameters -----
1792    
1793        real h2oexp(m,n,np,6)        _RL h2oexp(m,n,np,6)
1794    
1795  c---- static data -----  c---- static data -----
1796    
1797        integer mw(9)        integer mw(9)
1798        real xkw(9),aw(9),bw(9),pm(9)        _RL xkw(9),aw(9),bw(9),pm(9)
1799    
1800  c---- temporary arrays -----  c---- temporary arrays -----
1801    
1802        real xh,xh1        _RL xh,xh1
1803    
1804  c**********************************************************************  c**********************************************************************
1805  c    note that the 3 sub-bands in band 3 use the same set of xkw, aw,  c    note that the 3 sub-bands in band 3 use the same set of xkw, aw,
# Line 1926  c*************************************** Line 1902  c***************************************
1902    
1903  c---- input parameters ------  c---- input parameters ------
1904    
1905        real dcont(m,n,np)        _RL dcont(m,n,np)
1906    
1907  c---- updated parameters -----  c---- updated parameters -----
1908    
1909        real conexp(m,n,np,3)        _RL conexp(m,n,np,3)
1910    
1911  c---- static data -----  c---- static data -----
1912    
1913        real xke(9)        _RL xke(9)
1914    
1915  c**********************************************************************  c**********************************************************************
1916    
# Line 1987  c*************************************** Line 1963  c***************************************
1963    
1964  c---- input parameters -----  c---- input parameters -----
1965    
1966        real dco2(m,n,np),pa(m,n,np),dt(m,n,np)        _RL dco2(m,n,np),pa(m,n,np),dt(m,n,np)
1967    
1968  c---- output parameters -----  c---- output parameters -----
1969    
1970        real co2exp(m,n,np,6,2)        _RL co2exp(m,n,np,6,2)
1971    
1972  c---- temporary arrays -----  c---- temporary arrays -----
1973    
1974        real xc        _RL xc
1975    
1976  c**********************************************************************  c**********************************************************************
1977    
# Line 2089  c*************************************** Line 2065  c***************************************
2065    
2066  c---- input parameters -----  c---- input parameters -----
2067    
2068        real dn2o(m,n,np),pa(m,n,np),dt(m,n,np)        _RL dn2o(m,n,np),pa(m,n,np),dt(m,n,np)
2069    
2070  c---- output parameters -----  c---- output parameters -----
2071    
2072        real n2oexp(m,n,np,4)        _RL n2oexp(m,n,np,4)
2073    
2074  c---- temporary arrays -----  c---- temporary arrays -----
2075    
2076        real xc,xc1,xc2        _RL xc,xc1,xc2
2077    
2078  c**********************************************************************  c**********************************************************************
2079    
# Line 2165  c*************************************** Line 2141  c***************************************
2141    
2142  c---- input parameters -----  c---- input parameters -----
2143    
2144        real dch4(m,n,np),pa(m,n,np),dt(m,n,np)        _RL dch4(m,n,np),pa(m,n,np),dt(m,n,np)
2145    
2146  c---- output parameters -----  c---- output parameters -----
2147    
2148        real ch4exp(m,n,np,4)        _RL ch4exp(m,n,np,4)
2149    
2150  c---- temporary arrays -----  c---- temporary arrays -----
2151    
2152        real xc        _RL xc
2153    
2154  c**********************************************************************  c**********************************************************************
2155    
# Line 2237  c*************************************** Line 2213  c***************************************
2213    
2214  c---- input parameters -----  c---- input parameters -----
2215    
2216        real dcom(m,n,np),dt(m,n,np)        _RL dcom(m,n,np),dt(m,n,np)
2217    
2218  c---- output parameters -----  c---- output parameters -----
2219    
2220        real comexp(m,n,np,2)        _RL comexp(m,n,np,2)
2221    
2222  c---- temporary arrays -----  c---- temporary arrays -----
2223    
2224        real xc,xc1,xc2        _RL xc,xc1,xc2
2225    
2226  c**********************************************************************  c**********************************************************************
2227    
# Line 2314  c*************************************** Line 2290  c***************************************
2290    
2291  c---- input parameters -----  c---- input parameters -----
2292    
2293        real dcfc(m,n,np),dt(m,n,np)        _RL dcfc(m,n,np),dt(m,n,np)
2294    
2295  c---- output parameters -----  c---- output parameters -----
2296    
2297        real cfcexp(m,n,np)        _RL cfcexp(m,n,np)
2298    
2299  c---- static data -----  c---- static data -----
2300    
2301        real a1,b1,fk1,a2,b2,fk2        _RL a1,b1,fk1,a2,b2,fk2
2302    
2303  c---- temporary arrays -----  c---- temporary arrays -----
2304    
2305        real xf        _RL xf
2306    
2307  c**********************************************************************  c**********************************************************************
2308    
# Line 2376  c*************************************** Line 2352  c***************************************
2352    
2353  c---- input parameters -----  c---- input parameters -----
2354    
2355        real dh2o(m,n,np),dcont(m,n,np),dn2o(m,n,np)        _RL dh2o(m,n,np),dcont(m,n,np),dn2o(m,n,np)
2356        real dco2(m,n,np),pa(m,n,np),dt(m,n,np)        _RL dco2(m,n,np),pa(m,n,np),dt(m,n,np)
2357    
2358  c---- output parameters -----  c---- output parameters -----
2359    
2360        real h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)        _RL h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)
2361       *    ,n2oexp(m,n,np,4)       *    ,n2oexp(m,n,np,4)
2362    
2363  c---- temporary arrays -----  c---- temporary arrays -----
2364    
2365        real xx,xx1,xx2,xx3        _RL xx,xx1,xx2,xx3
2366    
2367  c**********************************************************************  c**********************************************************************
2368    
# Line 2527  c*************************************** Line 2503  c***************************************
2503    
2504  c---- input parameters -----  c---- input parameters -----
2505    
2506        real w1,p1,dwe,dpe        _RL w1,p1,dwe,dpe
2507        real sabs(m,n,np+1),spre(m,n,np+1),stem(m,n,np+1)        _RL sabs(m,n,np+1),spre(m,n,np+1),stem(m,n,np+1)
2508        real coef1(nx,nh,nt),coef2(nx,nh,nt),coef3(nx,nh,nt)        _RL coef1(nx,nh,nt),coef2(nx,nh,nt),coef3(nx,nh,nt)
2509    
2510  c---- update parameter -----  c---- update parameter -----
2511    
2512        real tran(m,n)        _RL tran(m,n)
2513    
2514  c---- temporary variables -----  c---- temporary variables -----
2515    
2516        real x1,x2,x3,we,pe,fw,fp,pa,pb,pc,ax,ba,bb,t1,ca,cb,t2        _RL x1,x2,x3,we,pe,fw,fp,pa,pb,pc,ax,ba,bb,t1,ca,cb,t2
2517        integer iw,ip,nn        integer iw,ip,nn
2518    
2519  c**********************************************************************  c**********************************************************************
# Line 2635  c*************************************** Line 2611  c***************************************
2611    
2612  c---- input parameters ------  c---- input parameters ------
2613    
2614        real conexp(m,n,np,3),h2oexp(m,n,np,6)        _RL conexp(m,n,np,3),h2oexp(m,n,np,6)
2615        integer ne(9)        integer ne(9)
2616        real  fkw(6,9),gkw(6,3)        _RL  fkw(6,9),gkw(6,3)
2617    
2618  c---- updated parameters -----  c---- updated parameters -----
2619    
2620        real th2o(m,n,6),tcon(m,n,3),tran(m,n)        _RL th2o(m,n,6),tcon(m,n,3),tran(m,n)
2621    
2622  c---- temporary arrays -----  c---- temporary arrays -----
2623    
2624        real trnth2o        _RL trnth2o
2625    
2626  c-----tco2 are the six exp factors between levels k1 and k2  c-----tco2 are the six exp factors between levels k1 and k2
2627  c     tran is the updated total transmittance between levels k1 and k2  c     tran is the updated total transmittance between levels k1 and k2
# Line 2769  c*************************************** Line 2745  c***************************************
2745    
2746  c---- input parameters -----  c---- input parameters -----
2747    
2748        real co2exp(m,n,np,6,2)        _RL co2exp(m,n,np,6,2)
2749    
2750  c---- updated parameters -----  c---- updated parameters -----
2751    
2752        real tco2(m,n,6,2),tran(m,n)        _RL tco2(m,n,6,2),tran(m,n)
2753    
2754  c---- temporary arrays -----  c---- temporary arrays -----
2755    
2756        real xc        _RL xc
2757    
2758  c-----tco2 is the 6 exp factors between levels k1 and k2.  c-----tco2 is the 6 exp factors between levels k1 and k2.
2759  c     xc is the total co2 transmittance given by eq. (53).  c     xc is the total co2 transmittance given by eq. (53).
# Line 2858  c*************************************** Line 2834  c***************************************
2834    
2835  c---- input parameters -----  c---- input parameters -----
2836    
2837        real n2oexp(m,n,np,4)        _RL n2oexp(m,n,np,4)
2838    
2839  c---- updated parameters -----  c---- updated parameters -----
2840    
2841        real tn2o(m,n,4),tran(m,n)        _RL tn2o(m,n,4),tran(m,n)
2842    
2843  c---- temporary arrays -----  c---- temporary arrays -----
2844    
2845        real xc        _RL xc
2846    
2847  c-----tn2o is the 2 exp factors between levels k1 and k2.  c-----tn2o is the 2 exp factors between levels k1 and k2.
2848  c     xc is the total n2o transmittance  c     xc is the total n2o transmittance
# Line 2935  c*************************************** Line 2911  c***************************************
2911    
2912  c---- input parameters -----  c---- input parameters -----
2913    
2914        real ch4exp(m,n,np,4)        _RL ch4exp(m,n,np,4)
2915    
2916  c---- updated parameters -----  c---- updated parameters -----
2917    
2918        real tch4(m,n,4),tran(m,n)        _RL tch4(m,n,4),tran(m,n)
2919    
2920  c---- temporary arrays -----  c---- temporary arrays -----
2921    
2922        real xc        _RL xc
2923    
2924  c-----tch4 is the 2 exp factors between levels k1 and k2.  c-----tch4 is the 2 exp factors between levels k1 and k2.
2925  c     xc is the total ch4 transmittance  c     xc is the total ch4 transmittance
# Line 3009  c*************************************** Line 2985  c***************************************
2985    
2986  c---- input parameters -----  c---- input parameters -----
2987    
2988        real comexp(m,n,np,2)        _RL comexp(m,n,np,2)
2989    
2990  c---- updated parameters -----  c---- updated parameters -----
2991    
2992        real tcom(m,n,2),tran(m,n)        _RL tcom(m,n,2),tran(m,n)
2993    
2994  c---- temporary arrays -----  c---- temporary arrays -----
2995    
2996        real xc        _RL xc
2997    
2998  c-----tcom is the 2 exp factors between levels k1 and k2.  c-----tcom is the 2 exp factors between levels k1 and k2.
2999  c     xc is the total co2-minor transmittance  c     xc is the total co2-minor transmittance
# Line 3077  c*************************************** Line 3053  c***************************************
3053    
3054  c---- input parameters -----  c---- input parameters -----
3055    
3056        real cfcexp(m,n,np)        _RL cfcexp(m,n,np)
3057    
3058  c---- updated parameters -----  c---- updated parameters -----
3059    
3060        real tcfc(m,n),tran(m,n)        _RL tcfc(m,n),tran(m,n)
3061    
3062  c-----tcfc is the exp factors between levels k1 and k2.  c-----tcfc is the exp factors between levels k1 and k2.
3063    
# Line 3133  c*************************************** Line 3109  c***************************************
3109    
3110  c---- input parameters -----  c---- input parameters -----
3111    
3112        real h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)        _RL h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)
3113       *    ,n2oexp(m,n,np,4)       *    ,n2oexp(m,n,np,4)
3114    
3115  c---- updated parameters -----  c---- updated parameters -----
3116    
3117        real th2o(m,n,6),tcon(m,n,3),tco2(m,n,6,2),tn2o(m,n,4)        _RL th2o(m,n,6),tcon(m,n,3),tco2(m,n,6,2),tn2o(m,n,4)
3118       *    ,tran(m,n)       *    ,tran(m,n)
3119    
3120  c---- temporary arrays -----  c---- temporary arrays -----
3121    
3122        real xx        _RL xx
3123    
3124  c-----initialize tran  c-----initialize tran
3125    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22