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

Diff of /MITgcm/pkg/fizhi/fizhi_moist.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:18:41 2004 UTC revision 1.8 by molod, Tue Jul 13 23:44:43 2004 UTC
# Line 13  C $Name$ Line 13  C $Name$
13       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
14       .   lpnt,myid)       .   lpnt,myid)
15    
16           implicit none
17    
18  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
19    #include "SIZE.h"
20    #include "diagnostics_SIZE.h"
21  #include "diagnostics.h"  #include "diagnostics.h"
22  #endif  #endif
23    
24  c Input Variables  c Input Variables
25  c ---------------  c ---------------
26          integer im,jm,lm
27        integer ndmoist,istrip,npcs        integer ndmoist,istrip,npcs
28          integer bi,bj,ntracer,ptracer        
29        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup
30        real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)        real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)
31        real pkht(im,jm,lm+1),pkl(im,jm,lm)        real pkht(im,jm,lm+1),pkl(im,jm,lm)
32        real tz(im,jm,lm),qz(im,jm,lm,ntracer)              real tz(im,jm,lm),qz(im,jm,lm,ntracer)      
       integer bi,bj,ntracer,ptracer          
33        real qqz(im,jm,lm)        real qqz(im,jm,lm)
34        real dumoist(im,jm,lm),dvmoist(im,jm,lm)        real dumoist(im,jm,lm),dvmoist(im,jm,lm)
35        real dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)        real dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)
       integer im,jm,lm  
36        real ptop        real ptop
37        integer iras        integer iras
38        real rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)        real rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)
# Line 53  c --------------- Line 57  c ---------------
57        real   srcld(istrip,lm)        real   srcld(istrip,lm)
58    
59        real plev        real plev
60        real cldnow,cldlsp_mem,cldras_mem,cldras,watnow,watmin,cldmin        real cldnow,cldlsp_mem,cldlsp,cldras_mem,cldras
61          real watnow,watmin,cldmin
62        real cldprs(im,jm),cldtmp(im,jm)        real cldprs(im,jm),cldtmp(im,jm)
63        real cldhi (im,jm),cldlow(im,jm)        real cldhi (im,jm),cldlow(im,jm)
64        real cldmid(im,jm),totcld(im,jm)        real cldmid(im,jm),totcld(im,jm)
# Line 241  c -------------------------------------- Line 246  c --------------------------------------
246         levgather(index) = levpbl(pblindex(index),1)         levgather(index) = levpbl(pblindex(index),1)
247          pigather(index) =     pz(pblindex(index),1)          pigather(index) =     pz(pblindex(index),1)
248          pkegather(index,lm+1) = pkht(pblindex(index),1,lm+1)          pkegather(index,lm+1) = pkht(pblindex(index),1,lm+1)
249          plegather(index,lm+1) = ple(pblindex(index),1,lm+1)          plegather(index,lm+1) = plze(pblindex(index),1,lm+1)
250        enddo        enddo
251    
252        do L = 1,lm        do L = 1,lm
# Line 771  C ************************************** Line 776  C **************************************
776  C                          BUMP DIAGNOSTICS  C                          BUMP DIAGNOSTICS
777  C **********************************************************************  C **********************************************************************
778    
 c Clear-Sky (Above 400mb) Temperature  
 c -----------------------------------  
       if( itmpuclr.ne.0 .or. isphuclr.ne.0 ) then  
       do j = 1,jm  
       do i = 1,im  
       totcld(i,j) = 0.0  
       enddo  
       enddo  
       do L = 1,midlevel  
       do j = 1,jm  
       do i = 1,im  
        if(cldls(i,j,L).ne.0.0.or.cpen(i,j,L).ne.0.0)totcld(i,j) = 1.0  
       enddo  
       enddo  
       enddo  
       do L = 1,lm  
        if( itmpuclr.ne.0 ) then  
         do i = 1,im*jm  
         if( totcld(i,1).eq.0.0 ) then  
          qdiag(i,1,itmpuclr +L-1,bi,bj) =  
      .         qdiag(i,1,itmpuclr +L-1,bi,bj) + tz(i,1,L)*pkzgather(i,L)  
          qdiag(i,1,itmpuclrc+L-1,bi,bj) =  
      .                            qdiag(i,1,itmpuclrc+L-1,bi,bj)+1.0  
         endif  
         enddo  
        endif  
   
        if( isphuclr.ne.0 ) then  
         do i = 1,im*jm  
         if( totcld(i,1).eq.0.0 ) then  
          qdiag(i,1,isphuclr +L-1,bi,bj) =  
      .              qdiag(i,1,isphuclr +L-1,bi,bj) + qz(i,1,L,1)*1000.0  
          qdiag(i,1,isphuclrc+L-1,bi,bj) =  
      .                      qdiag(i,1,isphuclrc+L-1,bi,bj) + 1.0  
         endif  
         enddo  
        endif  
       enddo  
       endif  
   
779  c Sub-Cloud Layer  c Sub-Cloud Layer
780  c -------------------------  c -------------------------
781        if( ipsubcld.ne.0 ) then        if( ipsubcld.ne.0 ) then
# Line 1102  C********************* SUBROUTINE  RAS Line 1067  C********************* SUBROUTINE  RAS
1067  C********************** 16 MARCH   1988 ******************************  C********************** 16 MARCH   1988 ******************************
1068  C*********************************************************************  C*********************************************************************
1069  C  C
1070        PARAMETER (KRMIN=01)        implicit none
1071        PARAMETER (ICM=1000)  
       PARAMETER (CMB2PA=100.0)  
       PARAMETER (rknob = 10.)  
 C  
1072        integer ntracer        integer ntracer
1073        integer nltop,nlayr        integer nltop,nlayr
1074        DIMENSION UOI(len,nlayr,ntracer),   POI(len,K)        real UOI(len,nlayr,ntracer),   POI(len,K)
1075        DIMENSION QOI(len,K), PRS(len,K+1), PRJ(len,K+1)        real QOI(len,K), PRS(len,K+1), PRJ(len,K+1)
1076        dimension rnd(ncrnd)        real rnd(ncrnd)
1077  C  C
1078        DIMENSION RAINS(len,K), CLN(len,K), CLF(len,K)        real RAINS(len,K), CLN(len,K), CLF(len,K)
1079        DIMENSION cldmas(len,K), detrain(len,K)        real cldmas(len,K), detrain(len,K)
1080        DIMENSION TCU(len,K), QCU(len,K)        real TCU(len,K), QCU(len,K)
1081        real ucu(len,K,ntracer)        real ucu(len,K,ntracer)
1082        DIMENSION ALF(len,K), BET(len,K), GAM(len,K)        real ALF(len,K), BET(len,K), GAM(len,K)
1083       *,         ETA(len,K), HOI(len,K)       *,         ETA(len,K), HOI(len,K)
1084       *,         PRH(len,K), PRI(len,K)       *,         PRH(len,K), PRI(len,K)
1085        DIMENSION HST(len,K), QOL(len,K), GMH(len,K)        real HST(len,K), QOL(len,K), GMH(len,K)
1086    
1087        DIMENSION TX1(len), TX2(len), TX3(len), TX4(len), TX5(len)        real TX1(len), TX2(len), TX3(len), TX4(len), TX5(len)
1088       *,         TX6(len), TX7(len), TX8(len), TX9(len)       *,         TX6(len), TX7(len), TX8(len), TX9(len)
1089       *,         TX11(len), TX12(len), TX13(len), TX14(len,ntracer)       *,         TX11(len), TX12(len), TX13(len), TX14(len,ntracer)
1090       *,         TX15(len), TX16(len)       *,         TX15(len), TX16(len)
1091       *,         WFN(len), IA1(len), IA2(len), IA3(len)       *,         WFN(len), IA1(len), IA2(len), IA3(len)
1092        DIMENSION cloudn(len), pcu(len)        real cloudn(len), pcu(len)
1093    
1094        real rhfrac(len),rasmax        real rhfrac(len),rasmax
1095    
1096        DIMENSION IC(ICM),   IRND(icm)        integer IC(ICM),   IRND(icm)
1097        dimension cmass(len,K)        real cmass(len,K)
1098        LOGICAL SETRAS        LOGICAL SETRAS
1099    
1100           do L = 1,k        integer krmin,icm
1101           do I = 1,LENC        real rknob, cmb2pa
1102           rains(i,l) = 0.        PARAMETER (KRMIN=01)
1103           enddo        PARAMETER (ICM=1000)
1104           enddo        PARAMETER (CMB2PA=100.0)
1105          PARAMETER (rknob = 10.)
1106    C
1107          integer i,L,nc
1108          integer km1,kp1,kprv,kcr,kfx,ncmx
1109          real p00, crtmsf, frac, rasblf
1110    
1111          do L = 1,k
1112          do I = 1,LENC
1113           rains(i,l) = 0.
1114          enddo
1115          enddo
1116    
1117        p00 = 1000.        p00 = 1000.
1118        crtmsf = 0.        crtmsf = 0.
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22