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

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

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

revision 1.22 by molod, Tue Dec 14 19:56:45 2004 UTC revision 1.23 by molod, Sat May 21 23:50:13 2005 UTC
# Line 12  C $Name$ Line 12  C $Name$
12       .        lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons)       .        lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons)
13    
14        implicit none        implicit none
 #ifdef ALLOW_DIAGNOSTICS  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
 #endif  
15    
16  c Input Variables  c Input Variables
17  c ---------------  c ---------------
# Line 94  c --------------- Line 89  c ---------------
89        _RL tauc   (istrip,lm,2)        _RL tauc   (istrip,lm,2)
90        _RL taua   (istrip,lm)        _RL taua   (istrip,lm)
91        _RL tstrip (istrip)        _RL tstrip (istrip)
92    #ifdef ALLOW_DIAGNOSTICS
93          logical  diagnostics_is_on
94          external diagnostics_is_on
95          _RL tmpdiag(im,jm),tmpdiag2(im,jm)
96    #endif
97    
98        logical first        logical first
99        data first /.true./        data first /.true./
# Line 218  c -------------------------------------- Line 218  c --------------------------------------
218        enddo        enddo
219        enddo        enddo
220    
221    #ifdef ALLOW_DIAGNOSTICS
222    
223  c Compute Cloud Diagnostics  c Compute Cloud Diagnostics
224  c -------------------------  c -------------------------
225        if(icldfrc.gt.0) then        if(diagnostics_is_on('CLDFRC  ',myid) ) then
226        do j=1,jm         call diagnostics_fill(totcld,'CLDFRC  ',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,icldfrc,bi,bj) =  qdiag(i,j,icldfrc,bi,bj) + totcld(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) ncldfrc = ncldfrc + 1  
227        endif        endif
228    
229        if( icldras.gt.0 ) then        if(diagnostics_is_on('CLDRAS  ',myid) ) then
230        do L=1,lm         do L=1,lm
231        do j=1,jm         do j=1,jm
232        do i=1,im         do i=1,im
233        qdiag(i,j,icldras+L-1,bi,bj) = qdiag(i,j,icldras+L-1,bi,bj) +          tmpdiag(i,j) = cswmo(i,j,L)
234       .                                                     cswmo(i,j,L)         enddo
235        enddo         enddo
236        enddo         call diagnostics_fill(tmpdiag,'CLDRAS  ',L,1,3,bi,bj,myid)
237        enddo        enddo
       if ( (bi.eq.1) .and. (bj.eq.1) ) ncldras = ncldras + 1  
238        endif        endif
239    
240        if( icldtot.gt.0 ) then        if(diagnostics_is_on('CLDTOT  ',myid) ) then
241        do L=1,lm         do L=1,lm
242        do j=1,jm         do j=1,jm
243        do i=1,im         do i=1,im
244        qdiag(i,j,icldtot+L-1,bi,bj) = qdiag(i,j,icldtot+L-1,bi,bj) +          tmpdiag(i,j) = cldtot(i,j,L)
245       .                                                     cldtot(i,j,L)         enddo
246        enddo         enddo
247        enddo         call diagnostics_fill(tmpdiag,'CLDTOT  ',L,1,3,bi,bj,myid)
248        enddo        enddo
       if ( (bi.eq.1) .and. (bj.eq.1) ) ncldtot = ncldtot + 1  
249        endif        endif
250    
251        if( icldlow.gt.0 ) then        if(diagnostics_is_on('CLDLOW  ',myid) ) then
252        do j=1,jm         call diagnostics_fill(cldlow,'CLDLOW  ',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,icldlow,bi,bj) = qdiag(i,j,icldlow,bi,bj) + cldlow(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) ncldlow = ncldlow + 1  
253        endif        endif
254    
255        if( icldmid.gt.0 ) then        if(diagnostics_is_on('CLDMID  ',myid) ) then
256        do j=1,jm         call diagnostics_fill(cldmid,'CLDMID  ',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,icldmid,bi,bj) = qdiag(i,j,icldmid,bi,bj) + cldmid(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) ncldmid = ncldmid + 1  
257        endif        endif
258    
259        if( icldhi.gt.0 ) then        if(diagnostics_is_on('CLDHI   ',myid) ) then
260        do j=1,jm         call diagnostics_fill(cldhi,'CLDHI   ',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,icldhi,bi,bj) = qdiag(i,j,icldhi,bi,bj) + cldhi(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) ncldhi = ncldhi + 1  
261        endif        endif
262    
263        if( ilzrad.gt.0 ) then        if(diagnostics_is_on('LZRAD   ',myid) ) then
264        do L=1,lm         do L=1,lm
265        do j=1,jm         do j=1,jm
266        do i=1,im         do i=1,im
267        qdiag(i,j,ilzrad+L-1,bi,bj) = qdiag(i,j,ilzrad+L-1,bi,bj) +          tmpdiag(i,j) = swlz(i,j,L) * 1.0e6
268       .                                                     swlz(i,j,L)*1.0e6         enddo
269        enddo         enddo
270        enddo         call diagnostics_fill(tmpdiag,'LZRAD   ',L,1,3,bi,bj,myid)
271        enddo         enddo
       if ( (bi.eq.1) .and. (bj.eq.1) ) nlzrad = nlzrad + 1  
272        endif        endif
273    
274  c Albedo Diagnostics  c Albedo Diagnostics
275  c ------------------  c ------------------
276        if( ialbvisdr.gt.0 ) then        if(diagnostics_is_on('ALBVISDR',myid) ) then
277        do j=1,jm         call diagnostics_fill(albvisdr,'ALBVISDR',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,ialbvisdr,bi,bj) = qdiag(i,j,ialbvisdr,bi,bj) +  
      .                                                     albvisdr(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) nalbvisdr = nalbvisdr + 1  
278        endif        endif
279    
280        if( ialbvisdf.gt.0 ) then        if(diagnostics_is_on('ALBVISDF',myid) ) then
281        do j=1,jm         call diagnostics_fill(albvisdf,'ALBVISDF',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,ialbvisdf,bi,bj) = qdiag(i,j,ialbvisdf,bi,bj) +  
      .                                                     albvisdf(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) nalbvisdf = nalbvisdf + 1  
282        endif        endif
283    
284        if( ialbnirdr.gt.0 ) then        if(diagnostics_is_on('ALBNIRDR',myid) ) then
285        do j=1,jm         call diagnostics_fill(albnirdr,'ALBNIRDR',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,ialbnirdr,bi,bj) = qdiag(i,j,ialbnirdr,bi,bj) +  
      .                                                     albnirdr(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) nalbnirdr = nalbnirdr + 1  
286        endif        endif
287    
288        if( ialbnirdf.gt.0 ) then        if(diagnostics_is_on('ALBNIRDF',myid) ) then
289        do j=1,jm         call diagnostics_fill(albnirdf,'ALBNIRDF',0,1,3,bi,bj,myid)
       do i=1,im  
       qdiag(i,j,ialbnirdf,bi,bj) = qdiag(i,j,ialbnirdf,bi,bj) +  
      .                                                     albnirdf(i,j)  
       enddo  
       enddo  
       if ( (bi.eq.1) .and. (bj.eq.1) ) nalbnirdf = nalbnirdf + 1  
290        endif        endif
291    
292    #endif
293    
294  C Compute Optical Thicknesses and Diagnostics  C Compute Optical Thicknesses and Diagnostics
295  C -------------------------------------------  C -------------------------------------------
296        call opthk(tdry,plz,plze,swlz,cldtot,cldmxo,landtype,im,jm,lm,        call opthk(tdry,plz,plze,swlz,cldtot,cldmxo,landtype,im,jm,lm,
# Line 347  C -------------------------------------- Line 304  C --------------------------------------
304        enddo        enddo
305        enddo        enddo
306    
307        if( itauave.gt.0 ) then  #ifdef ALLOW_DIAGNOSTICS
308        do L=1,lm        if(diagnostics_is_on('TAUAVE  ',myid) ) then
309        do j=1,jm         do L=1,lm
310        do i=1,im         do j=1,jm
311        qdiag(i,j,itauave+L-1,bi,bj) = qdiag(i,j,itauave+L-1,bi,bj) +         do i=1,im
312       .                        tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))          tmpdiag(i,j) = tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))
313        enddo         enddo
314        enddo         enddo
315           call diagnostics_fill(tmpdiag,'TAUAVE  ',L,1,3,bi,bj,myid)
316        enddo        enddo
       if ( (bi.eq.1) .and. (bj.eq.1) ) ntauave = ntauave + 1  
317        endif        endif
318    
319        if( itaucld.gt.0 ) then        if(diagnostics_is_on('TAUCLD  ',myid) .and.
320        do L=1,lm       .                 diagnostics_is_on('TAUCLDC ',myid) ) then
321        do j=1,jm         do L=1,lm
322        do i=1,im         do j=1,jm
323         if( cldtot(i,j,L).ne.0.0 ) then         do i=1,im
324          qdiag(i,j,itaucld +L-1,bi,bj) = qdiag(i,j,itaucld +L-1,bi,bj) +          if( cldtot(i,j,L).ne.0.0 ) then
325       .                        tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))          tmpdiag(i,j) = tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))
326          qdiag(i,j,itaucldc+L-1,bi,bj) =          tmpdiag2(i,j) = 1.
327       .                             qdiag(i,j,itaucldc+L-1,bi,bj) + 1.0          else
328         endif          tmpdiag(i,j) = 0.
329        enddo          tmpdiag2(i,j) = 0.
330        enddo          endif
331           enddo
332           enddo
333           call diagnostics_fill(tmpdiag,'TAUCLD  ',L,1,3,bi,bj,myid)
334           call diagnostics_fill(tmpdiag,'TAUCLDC ',L,1,3,bi,bj,myid)
335        enddo        enddo
336        endif        endif
337    
338  c Compute Low, Mid, and High Cloud Optical Depth Diagnostics  c Compute Low, Mid, and High Cloud Optical Depth Diagnostics
339  c ----------------------------------------------------------  c ----------------------------------------------------------
340        if( itaulow.ne.0 ) then        if(diagnostics_is_on('TAULOW  ',myid) .and.
341         .                 diagnostics_is_on('TAULOWC ',myid) ) then
342         do j = 1,jm         do j = 1,jm
343         do i = 1,im         do i = 1,im
344            taulow(i,j) =  0.0
345          if( cldlow(i,j).ne.0.0 ) then          if( cldlow(i,j).ne.0.0 ) then
          taulow(i,j) =  0.0  
346           do L = low_level,lm           do L = low_level,lm
347            taulow(i,j) = taulow(i,j) + tau(i,j,L)            taulow(i,j) = taulow(i,j) + tau(i,j,L)
348           enddo           enddo
349           qdiag(i,j,itaulow,bi,bj ) = qdiag(i,j,itaulow,bi,bj ) +           tmpdiag2(i,j) = 1.
350       .                                                    taulow(i,j)          else
351           qdiag(i,j,itaulowc,bi,bj) = qdiag(i,j,itaulowc,bi,bj) + 1.0           tmpdiag(i,j) = 0.
352          endif          endif
353         enddo         enddo
354         enddo         enddo
355           call diagnostics_fill(taulow,'TAULOW  ',0,1,3,bi,bj,myid)
356           call diagnostics_fill(tmpdiag2,'TAULOWC ',0,1,3,bi,bj,myid)
357        endif        endif
358    
359        if( itaumid.ne.0 ) then        if(diagnostics_is_on('TAUMID  ',myid) .and.
360         .                 diagnostics_is_on('TAUMIDC ',myid) ) then
361         do j = 1,jm         do j = 1,jm
362         do i = 1,im         do i = 1,im
363            taumid(i,j) =  0.0
364          if( cldmid(i,j).ne.0.0 ) then          if( cldmid(i,j).ne.0.0 ) then
          taumid(i,j) =  0.0  
365           do L = mid_level,low_level+1           do L = mid_level,low_level+1
366            taumid(i,j) = taumid(i,j) + tau(i,j,L)            taumid(i,j) = taumid(i,j) + tau(i,j,L)
367           enddo           enddo
368           qdiag(i,j,itaumid,bi,bj ) = qdiag(i,j,itaumid,bi,bj ) +           tmpdiag2(i,j) = 1.
369       .                                                    taumid(i,j)          else
370           qdiag(i,j,itaumidc,bi,bj) = qdiag(i,j,itaumidc,bi,bj) + 1.0           tmpdiag(i,j) = 0.
371          endif          endif
372         enddo         enddo
373         enddo         enddo
374           call diagnostics_fill(taumid,'TAUMID  ',0,1,3,bi,bj,myid)
375           call diagnostics_fill(tmpdiag2,'TAUMIDC ',0,1,3,bi,bj,myid)
376        endif        endif
377    
378        if( itauhi.ne.0 ) then        if(diagnostics_is_on('TAUHI   ',myid) .and.
379         .                 diagnostics_is_on('TAUHIC  ',myid) ) then
380         do j = 1,jm         do j = 1,jm
381         do i = 1,im         do i = 1,im
382            tauhi(i,j) =  0.0
383          if( cldhi(i,j).ne.0.0 ) then          if( cldhi(i,j).ne.0.0 ) then
          tauhi(i,j) =  0.0  
384           do L = 1,mid_level+1           do L = 1,mid_level+1
385            tauhi(i,j) = tauhi(i,j) + tau(i,j,L)            tauhi(i,j) = tauhi(i,j) + tau(i,j,L)
386           enddo           enddo
387           qdiag(i,j,itauhi,bi,bj ) = qdiag(i,j,itauhi,bi,bj ) +           tmpdiag2(i,j) = 1.
388       .                                                   tauhi(i,j)          else
389           qdiag(i,j,itauhic,bi,bj) = qdiag(i,j,itauhic,bi,bj) + 1.0           tmpdiag(i,j) = 0.
390          endif          endif
391         enddo         enddo
392         enddo         enddo
393           call diagnostics_fill(tauhi,'TAUHI   ',0,1,3,bi,bj,myid)
394           call diagnostics_fill(tmpdiag2,'TAUHIC  ',0,1,3,bi,bj,myid)
395        endif        endif
396    #endif
397    
398  C***********************************************************************  C***********************************************************************
399  C ****                     LOOP OVER GLOBAL REGIONS                 ****  C ****                     LOOP OVER GLOBAL REGIONS                 ****
# Line 523  c --------------------- Line 494  c ---------------------
494    
495   1000 CONTINUE   1000 CONTINUE
496    
497    #ifdef ALLOW_DIAGNOSTICS
498    
499  c Mean Albedo Diagnostic  c Mean Albedo Diagnostic
500  c ----------------------  c ----------------------
501        if( ialbedo.gt.0 ) then        if(diagnostics_is_on('ALBEDO  ',myid) .and.
502        do j=1,jm       .                 diagnostics_is_on('ALBEDOC ',myid) ) then
503        do i=1,im         do j=1,jm
504        if( albedo(i,j).ne.undef ) then         do i=1,im
505        qdiag(i,j,ialbedo,bi,bj ) = qdiag(i,j,ialbedo,bi,bj )+albedo(i,j)          if( albedo(i,j).ne.undef ) then
506        qdiag(i,j,ialbedoc,bi,bj) = qdiag(i,j,ialbedoc,bi,bj) + 1.0           tmpdiag(i,j) = albedo(i,j)
507        endif           tmpdiag2(i,j) = 1.
508        enddo          else
509        enddo           tmpdiag(i,j) = 0.
510             tmpdiag2(i,j) = 0.
511            endif
512           enddo
513           enddo
514           call diagnostics_fill(tmpdiag,'ALBEDO  ',0,1,3,bi,bj,myid)
515           call diagnostics_fill(tmpdiag2,'ALBEDOC ',0,1,3,bi,bj,myid)
516        endif        endif
517    #endif
518    
519  C **********************************************************************  C **********************************************************************
520  C ****                 ZERO-OUT OR BUMP COUNTERS                    ****  C ****                 ZERO-OUT OR BUMP COUNTERS                    ****
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22