/[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.7 by molod, Tue Jul 13 21:26:32 2004 UTC revision 1.22 by molod, Mon May 16 18:50:31 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"
 #include "PACKAGES_CONFIG.h"  
5        subroutine lwrio (nymd,nhms,bi,bj,istrip,npcs,low_level,mid_level,        subroutine lwrio (nymd,nhms,bi,bj,istrip,npcs,low_level,mid_level,
6         .                  im,jm,lm,
7       .                  pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,       .                  pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,
8       .                  co2,cfc11,cfc12,cfc22,methane,n2o,emissivity,       .                  co2,cfc11,cfc12,cfc22,methane,n2o,emissivity,
9       .                  tgz,radlwg,st4,dst4,       .                  tgz,radlwg,st4,dst4,
10       .                  dtradlw,dlwdtg,dtradlwc,lwgclr,       .                  dtradlw,dlwdtg,dtradlwc,lwgclr,
      .                  im,jm,lm,ptop,  
11       .                  nlwcld,cldlw,clwmo,nlwlz,lwlz,       .                  nlwcld,cldlw,clwmo,nlwlz,lwlz,
12       .                  lpnt,imstturb,qliqave,fccave,landtype)       .                  lpnt,imstturb,qliqave,fccave,landtype)
13    
14        implicit none        implicit none
15  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
16  #include "diagnostics.h"  #include "SIZE.h"
17    #include "DIAGNOSTICS_SIZE.h"
18    #include "DIAGNOSTICS.h"
19  #endif  #endif
20    
21  c Input Variables  c Input Variables
# Line 22  c --------------- Line 23  c ---------------
23        integer nymd,nhms,istrip,npcs,bi,bj        integer nymd,nhms,istrip,npcs,bi,bj
24        integer mid_level,low_level        integer mid_level,low_level
25        integer im,jm,lm                integer im,jm,lm        
26        real  ptop                      _RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1)
27        real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1)        _RL dpres(im,jm,lm),pkht(im,jm,lm+1),pkz(im,jm,lm)
28        real dpres(im,jm,lm),pkht(im,jm,lm+1),pkz(im,jm,lm)        _RL tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm)
29        real tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm)        _RL co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)    
30        real co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)            _RL emissivity(im,jm,10)
31        real emissivity(im,jm,10)        _RL tgz(im,jm),radlwg(im,jm),st4(im,jm),dst4(im,jm)    
32        real tgz(im,jm),radlwg(im,jm),st4(im,jm),dst4(im,jm)            _RL dtradlw(im,jm,lm),dlwdtg (im,jm,lm)
33        real dtradlw(im,jm,lm),dlwdtg (im,jm,lm)        _RL dtradlwc(im,jm,lm),lwgclr(im,jm)    
       real dtradlwc(im,jm,lm),lwgclr(im,jm)      
34        integer nlwcld,nlwlz        integer nlwcld,nlwlz
35        real cldlw(im,jm,lm),clwmo(im,jm,lm),lwlz(im,jm,lm)        _RL cldlw(im,jm,lm),clwmo(im,jm,lm),lwlz(im,jm,lm)
36        logical lpnt        logical lpnt
37        integer imstturb        integer imstturb
38        real qliqave(im,jm,lm),fccave(im,jm,lm)        _RL qliqave(im,jm,lm),fccave(im,jm,lm)
39        integer landtype(im,jm)        integer landtype(im,jm)
40    
41  c Local Variables  c Local Variables
42  c ---------------  c ---------------
43        integer i,j,l,n,nn        integer i,j,l,n,nn
44    
45        real cldtot (im,jm,lm)        _RL cldtot (im,jm,lm)
46        real cldmxo (im,jm,lm)        _RL cldmxo (im,jm,lm)
47    
48        real pl(istrip,lm)        _RL pl(istrip,lm)
49        real pk(istrip,lm)        _RL pk(istrip,lm)
50        real pke(istrip,lm)        _RL pke(istrip,lm)
51        real ple(istrip,lm+1)        _RL ple(istrip,lm+1)
52    
53        real ADELPL(ISTRIP,lm)        _RL ADELPL(ISTRIP,lm)
54        real dtrad(istrip,lm),dtradc(istrip,lm)        _RL dtrad(istrip,lm),dtradc(istrip,lm)
55        real OZL(ISTRIP,lm),TZL(ISTRIP,lm)        _RL OZL(ISTRIP,lm),TZL(ISTRIP,lm)
56        real SHZL(ISTRIP,lm),CLRO(ISTRIP,lm)        _RL SHZL(ISTRIP,lm),CLRO(ISTRIP,lm)
57        real CLMO(ISTRIP,lm)        _RL CLMO(ISTRIP,lm)
58        real flx(ISTRIP,lm+1),flxclr(ISTRIP,lm+1)        _RL flx(ISTRIP,lm+1),flxclr(ISTRIP,lm+1)
59        real cldlz(istrip,lm)        _RL cldlz(istrip,lm)
60        real dfdts(istrip,lm+1),dtdtg(istrip,lm)        _RL dfdts(istrip,lm+1),dtdtg(istrip,lm)
61    
62        real emiss(istrip,10)        _RL emiss(istrip,10)
63        real taual(istrip,lm,10)        _RL taual(istrip,lm,10)
64        real ssaal(istrip,lm,10)        _RL ssaal(istrip,lm,10)
65        real asyal(istrip,lm,10)        _RL asyal(istrip,lm,10)
66        real cwc(istrip,lm,3)        _RL cwc(istrip,lm,3)
67        real reff(istrip,lm,3)        _RL reff(istrip,lm,3)
68        real tauc(istrip,lm,3)        _RL tauc(istrip,lm,3)
69    
70        real SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP)        _RL SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP)
71        integer lwi(istrip)        integer lwi(istrip)
72    
73        real getcon,secday,convrt,pcheck        _RL tmpstrip(istrip,lm)
74          _RL tmpimjm(im,jm,lm)
75          _RL tempor1(im,jm),tempor2(im,jm)
76    
77          _RL getcon,secday,convrt
78    
79        logical high,  trace, cldwater        logical high,  trace, cldwater
80        data high /.true./  c     data high /.true./
81        data trace /.true./  c     data trace /.true./
82          data high /.false./
83          data trace /.false./
84        data cldwater /.false./        data cldwater /.false./
85    
86  C **********************************************************************  C **********************************************************************
# Line 133  C ************************************** Line 139  C **************************************
139    
140         call stripitint (landtype,lwi,im*jm,im*jm,istrip,1,nn)         call stripitint (landtype,lwi,im*jm,im*jm,istrip,1,nn)
141    
142         DO I = 1,ISTRIP*lm         DO L = 1,lm
143          ADELPL(I,1) = convrt / ( ple(I,2)-ple(I,1) )         DO I = 1,ISTRIP
144            ADELPL(I,L) = convrt / ( ple(I,L+1)-ple(I,L) )
145           ENDDO
146         ENDDO         ENDDO
147    
148  C Compute Clouds  C Compute Clouds
# Line 148  C -------------- Line 156  C --------------
156         ENDDO         ENDDO
157         ENDIF         ENDIF
158    
159    C Convert to Temperature from Fizhi Theta
160    C ---------------------------------------
161        DO L = 1,lm        DO L = 1,lm
162        DO I = 1,ISTRIP        DO I = 1,ISTRIP
163        TZL(I,L) = TZL(I,L)*pk(I,L)        TZL(I,L) = TZL(I,L)*pk(I,L)
# Line 211  C ************************************** Line 221  C **************************************
221         do L = 1,lm         do L = 1,lm
222         do i = 1,istrip         do i = 1,istrip
223           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)
224             tmpstrip(i,L) = flx(i,L)
225           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)
226          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)
227         enddo         enddo
# Line 239  C ************************************** Line 250  C **************************************
250  C ****            PASTE AND BUMP SOME DIAGNOSTICS                   ****  C ****            PASTE AND BUMP SOME DIAGNOSTICS                   ****
251  C **********************************************************************  C **********************************************************************
252    
253        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)
254       .                                                      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)  
255    
256  C **********************************************************************  C **********************************************************************
257  C ****                 TENDENCY UPDATES                             ****  C ****                 TENDENCY UPDATES                             ****
# Line 252  C ************************************** Line 259  C **************************************
259    
260        DO L = 1,lm        DO L = 1,lm
261        DO I = 1,ISTRIP        DO I = 1,ISTRIP
262        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)
263        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)
264         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)
265        ENDDO        ENDDO
266        ENDDO        ENDDO
267          CALL PASTE ( tmpstrip ,tmpimjm ,ISTRIP,im*jm,lm,NN )
268        CALL PASTE ( DTRAD ,DTRADLW ,ISTRIP,im*jm,lm,NN )        CALL PASTE ( DTRAD ,DTRADLW ,ISTRIP,im*jm,lm,NN )
269        CALL PASTE ( DTRADC,DTRADLWC,ISTRIP,im*jm,lm,NN )        CALL PASTE ( DTRADC,DTRADLWC,ISTRIP,im*jm,lm,NN )
270        CALL PASTE ( dtdtg ,dlwdtg  ,ISTRIP,im*jm,lm,NN )        CALL PASTE ( dtdtg ,dlwdtg  ,ISTRIP,im*jm,lm,NN )
# Line 297  C ************************************** Line 305  C **************************************
305        enddo        enddo
306        endif        endif
307    
308          if (iozlw.ne.0) then
309          do L = 1,lm
310          do j = 1,jm
311          do i = 1,im
312          qdiag(i,j,iozlw+L-1,bi,bj) = qdiag(i,j,iozlw+L-1,bi,bj) +
313         .                                             oz(i,j,L)
314          enddo
315          enddo
316          enddo
317          endif
318    
319          if (iolr.ne.0) then
320          do j = 1,jm
321          do i = 1,im
322          qdiag(i,j,iolr,bi,bj) = qdiag(i,j,iolr,bi,bj) + tempor1(i,j)
323          enddo
324          enddo
325          endif
326    
327          if (iolrclr.ne.0) then
328          do j = 1,jm
329          do i = 1,im
330          qdiag(i,j,iolrclr,bi,bj) = qdiag(i,j,iolrclr,bi,bj) + tempor2(i,j)
331          enddo
332          enddo
333          endif
334    
335  C **********************************************************************  C **********************************************************************
336  C ****    Increment Diagnostics Counters and Zero-Out Cloud Info    ****  C ****    Increment Diagnostics Counters and Zero-Out Cloud Info    ****
337  C **********************************************************************  C **********************************************************************
338    
339    #ifdef ALLOW_DIAGNOSTICS
340          if ( (bi.eq.1) .and. (bj.eq.1) ) then
341        ntlw     = ntlw     + 1        ntlw     = ntlw     + 1
342        nshrad   = nshrad   + 1        nshrad   = nshrad   + 1
343        nozlw    = nozlw    + 1        nozlw    = nozlw    + 1
# Line 309  C ************************************** Line 345  C **************************************
345        nolr     = nolr     + 1        nolr     = nolr     + 1
346        nolrclr  = nolrclr  + 1        nolrclr  = nolrclr  + 1
347    
348    c     nudiag4  = nudiag4  + 1
349          endif
350    #endif
351    
352        nlwlz    = 0        nlwlz    = 0
353        nlwcld   = 0        nlwcld   = 0
354        imstturb = 0        imstturb = 0
# Line 549  cfpp$ expand (b10kdis) Line 589  cfpp$ expand (b10kdis)
589  c---- input parameters ------  c---- input parameters ------
590    
591        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
592        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),
593       *     ts(m,ndim)       *     ts(m,ndim)
594        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)
595        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),
596       *     fcld(m,ndim,np)       *     fcld(m,ndim,np)
597        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)
598        logical cldwater,high,trace        logical cldwater,high,trace
599    
600  c---- output parameters ------  c---- output parameters ------
601    
602        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),
603       *     st4(m,ndim)       *     st4(m,ndim)
604    
605  c---- static data -----  c---- static data -----
606    
607        real cb(5,10)        _RL cb(5,10)
608        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)
609        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)
610        integer ne(9),mw(9)        integer ne(9),mw(9)
611    
612  c---- temporary arrays -----  c---- temporary arrays -----
613    
614        real pa(m,n,np),dt(m,n,np)        _RL pa(m,n,np),dt(m,n,np)
615        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)
616        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)
617        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)
618        real dn2o(m,n,np),dch4(m,n,np)        _RL dn2o(m,n,np),dch4(m,n,np)
619        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)
620        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)
621        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)
622        real tf11(m,n),tf12(m,n),tf22(m,n)        _RL tf11(m,n),tf12(m,n),tf22(m,n)
623        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)
624        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)
625        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)
626        real clr(m,n,0:np+1),fclr(m,n)        _RL clr(m,n,0:np+1),fclr(m,n)
627        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)
628        real clrlw(m,n),clrmd(m,n),clrhi(m,n)        _RL clrlw(m,n),clrmd(m,n),clrhi(m,n)
629        real cwp(m,n,np,3)        _RL cwp(m,n,np,3)
630        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)
631        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)
632        real rflx(m,n,np+1),rflc(m,n,np+1)        _RL rflx(m,n,np+1),rflc(m,n,np+1)
633    
634        logical oznbnd,co2bnd,h2otbl,conbnd,n2obnd        logical oznbnd,co2bnd,h2otbl,conbnd,n2obnd
635        logical ch4bnd,combnd,f11bnd,f12bnd,f22bnd,b10bnd        logical ch4bnd,combnd,f11bnd,f12bnd,f22bnd,b10bnd
636    
637        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)
638        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)
639        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)
640        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)
641        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)
642    
643        real dp,xx,p1,dwe,dpe,a1,b1,fk1,a2,b2,fk2        _RL dp,xx,p1,dwe,dpe,a1,b1,fk1,a2,b2,fk2
644        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
645    
646  c-----the following coefficients (equivalent to table 2 of  c-----the following coefficients (equivalent to table 2 of
647  c     chou and suarez, 1995) are for computing spectrally  c     chou and suarez, 1995) are for computing spectrally
# Line 774  c     o3 (band 5), and h2o (bands 1, 2, Line 814  c     o3 (band 5), and h2o (bands 1, 2,
814  #include "co2-tran3.h"  #include "co2-tran3.h"
815  #include "o3-tran3.h"  #include "o3-tran3.h"
816    
817        save c1,c2,c3,o1,o2,o3  c     save c1,c2,c3,o1,o2,o3
818        save h11,h12,h13,h21,h22,h23,h81,h82,h83  c     save h11,h12,h13,h21,h22,h23,h81,h82,h83
819    
820        if (first) then        if (first) then
821    
# Line 1222  c-----initialize fluxes Line 1262  c-----initialize fluxes
1262         enddo         enddo
1263        enddo        enddo
1264    
   
1265        do 2000 k1=1,np        do 2000 k1=1,np
1266    
1267  c-----initialize fclr, th2o, tcon, tco2, and tranal  c-----initialize fclr, th2o, tcon, tco2, and tranal
# Line 1403  c-----compute water vapor transmittance Line 1442  c-----compute water vapor transmittance
1442            if (ib.eq.1) then            if (ib.eq.1) then
1443             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,
1444       *                 w1,p1,dwe,dpe,h11,h12,h13,trant)       *                 w1,p1,dwe,dpe,h11,h12,h13,trant)
   
1445            endif            endif
1446            if (ib.eq.2) then            if (ib.eq.2) then
1447             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 1438  c-----compute co2 transmittance using ta Line 1476  c-----compute co2 transmittance using ta
1476            dpe=0.2            dpe=0.2
1477            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,
1478       *                w1,p1,dwe,dpe,c1,c2,c3,trant)       *                w1,p1,dwe,dpe,c1,c2,c3,trant)
1479    
1480         else         else
1481    
1482  c-----compute co2 transmittance using k-distribution method  c-----compute co2 transmittance using k-distribution method
# Line 1456  c-----All use table look-up to compute o Line 1495  c-----All use table look-up to compute o
1495            dpe=0.2            dpe=0.2
1496            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,
1497       *                w1,p1,dwe,dpe,o1,o2,o3,trant)       *                w1,p1,dwe,dpe,o1,o2,o3,trant)
1498    
1499        endif        endif
1500    
1501  c***** for trace gases *****  c***** for trace gases *****
# Line 1715  c*************************************** Line 1755  c***************************************
1755    
1756  c---- input parameters -----  c---- input parameters -----
1757    
1758        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)
1759    
1760  c---- output parameters -----  c---- output parameters -----
1761    
1762        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)
1763    
1764  c*********************************************************************  c*********************************************************************
1765          do j=1,n          do j=1,n
# Line 1770  c*************************************** Line 1810  c***************************************
1810    
1811  c---- input parameters ------  c---- input parameters ------
1812    
1813        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)
1814    
1815  c---- output parameters -----  c---- output parameters -----
1816    
1817        real h2oexp(m,n,np,6)        _RL h2oexp(m,n,np,6)
1818    
1819  c---- static data -----  c---- static data -----
1820    
1821        integer mw(9)        integer mw(9)
1822        real xkw(9),aw(9),bw(9),pm(9)        _RL xkw(9),aw(9),bw(9),pm(9)
1823    
1824  c---- temporary arrays -----  c---- temporary arrays -----
1825    
1826        real xh,xh1        _RL xh,xh1
1827    
1828  c**********************************************************************  c**********************************************************************
1829  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 1886  c*************************************** Line 1926  c***************************************
1926    
1927  c---- input parameters ------  c---- input parameters ------
1928    
1929        real dcont(m,n,np)        _RL dcont(m,n,np)
1930    
1931  c---- updated parameters -----  c---- updated parameters -----
1932    
1933        real conexp(m,n,np,3)        _RL conexp(m,n,np,3)
1934    
1935  c---- static data -----  c---- static data -----
1936    
1937        real xke(9)        _RL xke(9)
1938    
1939  c**********************************************************************  c**********************************************************************
1940    
# Line 1947  c*************************************** Line 1987  c***************************************
1987    
1988  c---- input parameters -----  c---- input parameters -----
1989    
1990        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)
1991    
1992  c---- output parameters -----  c---- output parameters -----
1993    
1994        real co2exp(m,n,np,6,2)        _RL co2exp(m,n,np,6,2)
1995    
1996  c---- temporary arrays -----  c---- temporary arrays -----
1997    
1998        real xc        _RL xc
1999    
2000  c**********************************************************************  c**********************************************************************
2001    
# Line 2049  c*************************************** Line 2089  c***************************************
2089    
2090  c---- input parameters -----  c---- input parameters -----
2091    
2092        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)
2093    
2094  c---- output parameters -----  c---- output parameters -----
2095    
2096        real n2oexp(m,n,np,4)        _RL n2oexp(m,n,np,4)
2097    
2098  c---- temporary arrays -----  c---- temporary arrays -----
2099    
2100        real xc,xc1,xc2        _RL xc,xc1,xc2
2101    
2102  c**********************************************************************  c**********************************************************************
2103    
# Line 2125  c*************************************** Line 2165  c***************************************
2165    
2166  c---- input parameters -----  c---- input parameters -----
2167    
2168        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)
2169    
2170  c---- output parameters -----  c---- output parameters -----
2171    
2172        real ch4exp(m,n,np,4)        _RL ch4exp(m,n,np,4)
2173    
2174  c---- temporary arrays -----  c---- temporary arrays -----
2175    
2176        real xc        _RL xc
2177    
2178  c**********************************************************************  c**********************************************************************
2179    
# Line 2197  c*************************************** Line 2237  c***************************************
2237    
2238  c---- input parameters -----  c---- input parameters -----
2239    
2240        real dcom(m,n,np),dt(m,n,np)        _RL dcom(m,n,np),dt(m,n,np)
2241    
2242  c---- output parameters -----  c---- output parameters -----
2243    
2244        real comexp(m,n,np,2)        _RL comexp(m,n,np,2)
2245    
2246  c---- temporary arrays -----  c---- temporary arrays -----
2247    
2248        real xc,xc1,xc2        _RL xc,xc1,xc2
2249    
2250  c**********************************************************************  c**********************************************************************
2251    
# Line 2274  c*************************************** Line 2314  c***************************************
2314    
2315  c---- input parameters -----  c---- input parameters -----
2316    
2317        real dcfc(m,n,np),dt(m,n,np)        _RL dcfc(m,n,np),dt(m,n,np)
2318    
2319  c---- output parameters -----  c---- output parameters -----
2320    
2321        real cfcexp(m,n,np)        _RL cfcexp(m,n,np)
2322    
2323  c---- static data -----  c---- static data -----
2324    
2325        real a1,b1,fk1,a2,b2,fk2        _RL a1,b1,fk1,a2,b2,fk2
2326    
2327  c---- temporary arrays -----  c---- temporary arrays -----
2328    
2329        real xf        _RL xf
2330    
2331  c**********************************************************************  c**********************************************************************
2332    
# Line 2336  c*************************************** Line 2376  c***************************************
2376    
2377  c---- input parameters -----  c---- input parameters -----
2378    
2379        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)
2380        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)
2381    
2382  c---- output parameters -----  c---- output parameters -----
2383    
2384        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)
2385       *    ,n2oexp(m,n,np,4)       *    ,n2oexp(m,n,np,4)
2386    
2387  c---- temporary arrays -----  c---- temporary arrays -----
2388    
2389        real xx,xx1,xx2,xx3        _RL xx,xx1,xx2,xx3
2390    
2391  c**********************************************************************  c**********************************************************************
2392    
# Line 2487  c*************************************** Line 2527  c***************************************
2527    
2528  c---- input parameters -----  c---- input parameters -----
2529    
2530        real w1,p1,dwe,dpe        _RL w1,p1,dwe,dpe
2531        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)
2532        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)
2533    
2534  c---- update parameter -----  c---- update parameter -----
2535    
2536        real tran(m,n)        _RL tran(m,n)
2537    
2538  c---- temporary variables -----  c---- temporary variables -----
2539    
2540        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
2541        integer iw,ip,nn        integer iw,ip,nn
2542    
2543  c**********************************************************************  c**********************************************************************
# Line 2595  c*************************************** Line 2635  c***************************************
2635    
2636  c---- input parameters ------  c---- input parameters ------
2637    
2638        real conexp(m,n,np,3),h2oexp(m,n,np,6)        _RL conexp(m,n,np,3),h2oexp(m,n,np,6)
2639        integer ne(9)        integer ne(9)
2640        real  fkw(6,9),gkw(6,3)        _RL  fkw(6,9),gkw(6,3)
2641    
2642  c---- updated parameters -----  c---- updated parameters -----
2643    
2644        real th2o(m,n,6),tcon(m,n,3),tran(m,n)        _RL th2o(m,n,6),tcon(m,n,3),tran(m,n)
2645    
2646  c---- temporary arrays -----  c---- temporary arrays -----
2647    
2648        real trnth2o        _RL trnth2o
2649    
2650  c-----tco2 are the six exp factors between levels k1 and k2  c-----tco2 are the six exp factors between levels k1 and k2
2651  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 2729  c*************************************** Line 2769  c***************************************
2769    
2770  c---- input parameters -----  c---- input parameters -----
2771    
2772        real co2exp(m,n,np,6,2)        _RL co2exp(m,n,np,6,2)
2773    
2774  c---- updated parameters -----  c---- updated parameters -----
2775    
2776        real tco2(m,n,6,2),tran(m,n)        _RL tco2(m,n,6,2),tran(m,n)
2777    
2778  c---- temporary arrays -----  c---- temporary arrays -----
2779    
2780        real xc        _RL xc
2781    
2782  c-----tco2 is the 6 exp factors between levels k1 and k2.  c-----tco2 is the 6 exp factors between levels k1 and k2.
2783  c     xc is the total co2 transmittance given by eq. (53).  c     xc is the total co2 transmittance given by eq. (53).
# Line 2818  c*************************************** Line 2858  c***************************************
2858    
2859  c---- input parameters -----  c---- input parameters -----
2860    
2861        real n2oexp(m,n,np,4)        _RL n2oexp(m,n,np,4)
2862    
2863  c---- updated parameters -----  c---- updated parameters -----
2864    
2865        real tn2o(m,n,4),tran(m,n)        _RL tn2o(m,n,4),tran(m,n)
2866    
2867  c---- temporary arrays -----  c---- temporary arrays -----
2868    
2869        real xc        _RL xc
2870    
2871  c-----tn2o is the 2 exp factors between levels k1 and k2.  c-----tn2o is the 2 exp factors between levels k1 and k2.
2872  c     xc is the total n2o transmittance  c     xc is the total n2o transmittance
# Line 2895  c*************************************** Line 2935  c***************************************
2935    
2936  c---- input parameters -----  c---- input parameters -----
2937    
2938        real ch4exp(m,n,np,4)        _RL ch4exp(m,n,np,4)
2939    
2940  c---- updated parameters -----  c---- updated parameters -----
2941    
2942        real tch4(m,n,4),tran(m,n)        _RL tch4(m,n,4),tran(m,n)
2943    
2944  c---- temporary arrays -----  c---- temporary arrays -----
2945    
2946        real xc        _RL xc
2947    
2948  c-----tch4 is the 2 exp factors between levels k1 and k2.  c-----tch4 is the 2 exp factors between levels k1 and k2.
2949  c     xc is the total ch4 transmittance  c     xc is the total ch4 transmittance
# Line 2969  c*************************************** Line 3009  c***************************************
3009    
3010  c---- input parameters -----  c---- input parameters -----
3011    
3012        real comexp(m,n,np,2)        _RL comexp(m,n,np,2)
3013    
3014  c---- updated parameters -----  c---- updated parameters -----
3015    
3016        real tcom(m,n,2),tran(m,n)        _RL tcom(m,n,2),tran(m,n)
3017    
3018  c---- temporary arrays -----  c---- temporary arrays -----
3019    
3020        real xc        _RL xc
3021    
3022  c-----tcom is the 2 exp factors between levels k1 and k2.  c-----tcom is the 2 exp factors between levels k1 and k2.
3023  c     xc is the total co2-minor transmittance  c     xc is the total co2-minor transmittance
# Line 3037  c*************************************** Line 3077  c***************************************
3077    
3078  c---- input parameters -----  c---- input parameters -----
3079    
3080        real cfcexp(m,n,np)        _RL cfcexp(m,n,np)
3081    
3082  c---- updated parameters -----  c---- updated parameters -----
3083    
3084        real tcfc(m,n),tran(m,n)        _RL tcfc(m,n),tran(m,n)
3085    
3086  c-----tcfc is the exp factors between levels k1 and k2.  c-----tcfc is the exp factors between levels k1 and k2.
3087    
# Line 3093  c*************************************** Line 3133  c***************************************
3133    
3134  c---- input parameters -----  c---- input parameters -----
3135    
3136        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)
3137       *    ,n2oexp(m,n,np,4)       *    ,n2oexp(m,n,np,4)
3138    
3139  c---- updated parameters -----  c---- updated parameters -----
3140    
3141        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)
3142       *    ,tran(m,n)       *    ,tran(m,n)
3143    
3144  c---- temporary arrays -----  c---- temporary arrays -----
3145    
3146        real xx        _RL xx
3147    
3148  c-----initialize tran  c-----initialize tran
3149    
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22