/[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.15 by molod, Wed Aug 4 22:23:43 2004 UTC revision 1.22 by molod, Mon May 16 18:50:31 2005 UTC
# Line 8  C $Name$ Line 8  C $Name$
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,
11       .                  ptop,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 "SIZE.h"  #include "SIZE.h"
17  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
18  #include "diagnostics.h"  #include "DIAGNOSTICS.h"
19  #endif  #endif
20    
21  c Input Variables  c Input Variables
# Line 23  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        
       _RL  ptop                
26        _RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1)        _RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1)
27        _RL dpres(im,jm,lm),pkht(im,jm,lm+1),pkz(im,jm,lm)        _RL dpres(im,jm,lm),pkht(im,jm,lm+1),pkz(im,jm,lm)
28        _RL tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm)        _RL tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm)
# Line 71  c --------------- Line 70  c ---------------
70        _RL SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP)        _RL SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP)
71        integer lwi(istrip)        integer lwi(istrip)
72    
73          _RL tmpstrip(istrip,lm)
74          _RL tmpimjm(im,jm,lm)
75          _RL tempor1(im,jm),tempor2(im,jm)
76    
77        _RL getcon,secday,convrt        _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 134  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 149  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 212  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 240  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 253  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 298  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 310  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 775  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  c     if (first) then        if (first) then
821    
822  c-----tables co2 and h2o are only used with 'high' option  c-----tables co2 and h2o are only used with 'high' option
823    
# Line 846  c-----always use table look-up for ozone Line 885  c-----always use table look-up for ozone
885           enddo           enddo
886          enddo          enddo
887    
888  c      first=.false.         first=.false.
889    
890  c     endif        endif
891    
892  c-----set the pressure at the top of the model atmosphere  c-----set the pressure at the top of the model atmosphere
893  c     to 1.0e-4 if it is zero  c     to 1.0e-4 if it is zero
# 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 *****
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22