/[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.19 by molod, Sun Aug 29 19:46:19 2004 UTC revision 1.23 by molod, Sat May 21 23:50:13 2005 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "FIZHI_OPTIONS.h"  #include "FIZHI_OPTIONS.h"
5        subroutine lwrio (nymd,nhms,bi,bj,istrip,npcs,low_level,mid_level,        subroutine lwrio (nymd,nhms,bi,bj,myid,istrip,npcs,
6         .                  low_level,mid_level,
7       .                  im,jm,lm,       .                  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,
# Line 12  C $Name$ Line 13  C $Name$
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        _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)
# Line 72  c --------------- Line 68  c ---------------
68    
69        _RL tmpstrip(istrip,lm)        _RL tmpstrip(istrip,lm)
70        _RL tmpimjm(im,jm,lm)        _RL tmpimjm(im,jm,lm)
71        _RL tempor(im,jm)        _RL tempor1(im,jm),tempor2(im,jm)
72    
73        _RL getcon,secday,convrt        _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  c     data high /.true./  c     data high /.true./
# Line 250  C ************************************** Line 251  C **************************************
251  C ****            PASTE AND BUMP SOME DIAGNOSTICS                   ****  C ****            PASTE AND BUMP SOME DIAGNOSTICS                   ****
252  C **********************************************************************  C **********************************************************************
253    
254        CALL PASTE(flx(1,1),tempor,ISTRIP,im*jm,1,NN)        CALL PASTE(flx(1,1),tempor1,ISTRIP,im*jm,1,NN)
255          CALL PASTE(flxclr(1,1),tempor2,ISTRIP,im*jm,1,NN)
 c     IF(IOLR.GT.0)CALL PSTBMP(flx(1,1),QDIAG(1,1,IOLR,bi,bj),ISTRIP,  
 c    .                                                      im*jm, 1,NN)  
 c     IF(IOLRCLR.GT.0)CALL PSTBMP(flxclr(1,1),QDIAG(1,1,IOLRCLR,bi,bj),  
 c    .                                                ISTRIP,im*jm,1,NN)  
 c     IF(IOZLW.GT.0)CALL PSTBMP(OZL(1,1),QDIAG(1,1,IOZLW,bi,bj),ISTRIP,  
 c    .                                                      im*jm,lm,NN)  
256    
257  C **********************************************************************  C **********************************************************************
258  C ****                 TENDENCY UPDATES                             ****  C ****                 TENDENCY UPDATES                             ****
# Line 281  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        enddo  
295        endif         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    
       if (iudiag4.ne.0) then  
       do L = 1,lm  
       do j = 1,jm  
       do i = 1,im  
       qdiag(i,j,iudiag4+L-1,bi,bj) = qdiag(i,j,iudiag4+L-1,bi,bj) +  
      .  tmpimjm(i,j,L)  
       enddo  
       enddo  
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 (iolr.ne.0) then        if(diagnostics_is_on('OLRCLR  ',myid) ) then
320        do j = 1,jm         call diagnostics_fill(tempor2,'OLRCLR  ',0,1,3,bi,bj,myid)
       do i = 1,im  
       qdiag(i,j,iolr,bi,bj) = qdiag(i,j,iolr,bi,bj) + tempor(i,j)  
       enddo  
       enddo  
321        endif        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    
 #ifdef ALLOW_DIAGNOSTICS  
       if ( (bi.eq.1) .and. (bj.eq.1) ) then  
       ntlw     = ntlw     + 1  
       nshrad   = nshrad   + 1  
       nozlw    = nozlw    + 1  
       ntgrlw   = ntgrlw   + 1  
       nolr     = nolr     + 1  
       nolrclr  = nolrclr  + 1  
   
       nudiag4  = nudiag4  + 1  
       endif  
 #endif  
   
328        nlwlz    = 0        nlwlz    = 0
329        nlwcld   = 0        nlwcld   = 0
330        imstturb = 0        imstturb = 0
Legend:
Removed from v.1.19  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22