/[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.8 by molod, Tue Jul 13 23:44:43 2004 UTC revision 1.23 by molod, Sat May 21 23:50:13 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  #include "PACKAGES_CONFIG.h"        subroutine lwrio (nymd,nhms,bi,bj,myid,istrip,npcs,
6        subroutine lwrio (nymd,nhms,bi,bj,istrip,npcs,low_level,mid_level,       .                  low_level,mid_level,
7         .                  im,jm,lm,
8       .                  pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,       .                  pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,
9       .                  co2,cfc11,cfc12,cfc22,methane,n2o,emissivity,       .                  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 "SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #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        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        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)
24        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)
25        real tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm)        _RL co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)    
26        real co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)            _RL emissivity(im,jm,10)
27        real emissivity(im,jm,10)        _RL tgz(im,jm),radlwg(im,jm),st4(im,jm),dst4(im,jm)    
28        real tgz(im,jm),radlwg(im,jm),st4(im,jm),dst4(im,jm)            _RL dtradlw(im,jm,lm),dlwdtg (im,jm,lm)
29        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)      
30        integer nlwcld,nlwlz        integer nlwcld,nlwlz
31        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)
32        logical lpnt        logical lpnt
33        integer imstturb        integer imstturb
34        real qliqave(im,jm,lm),fccave(im,jm,lm)        _RL qliqave(im,jm,lm),fccave(im,jm,lm)
35        integer landtype(im,jm)        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
40    
41        real cldtot (im,jm,lm)        _RL cldtot (im,jm,lm)
42        real cldmxo (im,jm,lm)        _RL cldmxo (im,jm,lm)
43    
44        real pl(istrip,lm)        _RL pl(istrip,lm)
45        real pk(istrip,lm)        _RL pk(istrip,lm)
46        real pke(istrip,lm)        _RL pke(istrip,lm)
47        real ple(istrip,lm+1)        _RL ple(istrip,lm+1)
48    
49        real ADELPL(ISTRIP,lm)        _RL ADELPL(ISTRIP,lm)
50        real dtrad(istrip,lm),dtradc(istrip,lm)        _RL dtrad(istrip,lm),dtradc(istrip,lm)
51        real OZL(ISTRIP,lm),TZL(ISTRIP,lm)        _RL OZL(ISTRIP,lm),TZL(ISTRIP,lm)
52        real SHZL(ISTRIP,lm),CLRO(ISTRIP,lm)        _RL SHZL(ISTRIP,lm),CLRO(ISTRIP,lm)
53        real CLMO(ISTRIP,lm)        _RL CLMO(ISTRIP,lm)
54        real flx(ISTRIP,lm+1),flxclr(ISTRIP,lm+1)        _RL flx(ISTRIP,lm+1),flxclr(ISTRIP,lm+1)
55        real cldlz(istrip,lm)        _RL cldlz(istrip,lm)
56        real dfdts(istrip,lm+1),dtdtg(istrip,lm)        _RL dfdts(istrip,lm+1),dtdtg(istrip,lm)
57    
58        real emiss(istrip,10)        _RL emiss(istrip,10)
59        real taual(istrip,lm,10)        _RL taual(istrip,lm,10)
60        real ssaal(istrip,lm,10)        _RL ssaal(istrip,lm,10)
61        real asyal(istrip,lm,10)        _RL asyal(istrip,lm,10)
62        real cwc(istrip,lm,3)        _RL cwc(istrip,lm,3)
63        real reff(istrip,lm,3)        _RL reff(istrip,lm,3)
64        real tauc(istrip,lm,3)        _RL tauc(istrip,lm,3)
65    
66        real SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP)        _RL SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP)
67        integer lwi(istrip)        integer lwi(istrip)
68    
69        real getcon,secday,convrt,pcheck        _RL tmpstrip(istrip,lm)
70          _RL tmpimjm(im,jm,lm)
71          _RL tempor1(im,jm),tempor2(im,jm)
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        logical high,  trace, cldwater
81        data high /.true./  c     data high /.true./
82        data trace /.true./  c     data trace /.true./
83          data high /.false./
84          data trace /.false./
85        data cldwater /.false./        data cldwater /.false./
86    
87  C **********************************************************************  C **********************************************************************
# Line 135  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 150  C -------------- Line 157  C --------------
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 213  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 241  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 254  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 269  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 551  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 776  c     o3 (band 5), and h2o (bands 1, 2, Line 790  c     o3 (band 5), and h2o (bands 1, 2,
790  #include "co2-tran3.h"  #include "co2-tran3.h"
791  #include "o3-tran3.h"  #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 1224  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 1405  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 1440  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 1458  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 1717  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 1772  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 1888  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 1949  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 2051  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 2127  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 2199  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 2276  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 2338  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 2489  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 2597  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 2731  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 2820  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 2897  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 2971  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 3039  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 3095  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.8  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22