/[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.3 by molod, Thu Jun 24 19:57:02 2004 UTC revision 1.4 by molod, Wed Jul 7 19:33:48 2004 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5        subroutine moistio (ndmoist,istrip,npcs,pz,tz,qz,bi,bj,        subroutine moistio (ndmoist,istrip,npcs,pz,tz,qz,bi,bj,
6       .   ntracer,ptracer,       .   ntracer,ptracer,
7         .   lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup,
8       .   pkht,qqz,dumoist,dvmoist,dtmoist,dqmoist,       .   pkht,qqz,dumoist,dvmoist,dtmoist,dqmoist,
9       .   im,jm,lm,sige,sig,dsig,ptop,       .   im,jm,lm,ptop,
10       .   iras,rainlsp,rainconv,snowfall,       .   iras,rainlsp,rainconv,snowfall,
11       .   nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,       .   nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
12       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
# Line 18  C $Name$ Line 19  C $Name$
19  c Input Variables  c Input Variables
20  c ---------------  c ---------------
21        integer ndmoist,istrip,npcs,myid,bi,bj        integer ndmoist,istrip,npcs,myid,bi,bj
22          integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup
23    
24        integer im,jm,lm                        integer im,jm,lm                
25        real  ptop                              real  ptop                      
       real  sige(lm+1)                  
       real   sig(lm)                    
       real  dsig(lm)                    
26    
27        integer ntracer,ptracer                integer ntracer,ptracer        
28    
# Line 61  c --------------- Line 60  c ---------------
60    
61  c Local Variables  c Local Variables
62  c ---------------  c ---------------
63        integer    ncrnd,nsecf,nsubmax        integer    ncrnd,nsecf
64    
65        real       fracqq, rh,temp1,temp2,dum        real       fracqq, rh,temp1,temp2,dum
66        integer    snowcrit, lup        integer    snowcrit
67        parameter (fracqq = 0.1)        parameter (fracqq = 0.1)
68    
69        real   cldsr(im,jm,lm)        real   cldsr(im,jm,lm)
# Line 75  c --------------- Line 74  c ---------------
74        real cldprs(im,jm),cldtmp(im,jm)        real cldprs(im,jm),cldtmp(im,jm)
75        real cldhi (im,jm),cldlow(im,jm)        real cldhi (im,jm),cldlow(im,jm)
76        real cldmid(im,jm),totcld(im,jm)        real cldmid(im,jm),totcld(im,jm)
       integer midlevel,lowlevel  
77    
78        real   CLDLS(im,jm,lm)  , CPEN(im,jm,lm)        real   CLDLS(im,jm,lm)  , CPEN(im,jm,lm)
79        real    tmpimjm(im,jm)        real    tmpimjm(im,jm)
# Line 149  c --------------- Line 147  c ---------------
147        real rnd(lm/2)        real rnd(lm/2)
148        DATA      FIRST /.TRUE./        DATA      FIRST /.TRUE./
149    
150        integer imstp,nltop,nsubcl,nlras,nsubmin        integer imstp,nsubcl,nlras
151        integer i,j,iloop,index,l,nn,num,numdeps,nt        integer i,j,iloop,index,l,nn,num,numdeps,nt
152        real tmstp,tminv,sday,grav,alhl,cp,elocp,gamfac        real tmstp,tminv,sday,grav,alhl,cp,elocp,gamfac
153        real rkappa,p0kappa,p0kinv,ptopkap,pcheck        real rkappa,p0kappa,p0kinv,ptopkap,pcheck
# Line 192  C Threshold for Cloud Liquid Water Memor Line 190  C Threshold for Cloud Liquid Water Memor
190        tice     = getcon('FREEZING-POINT')        tice     = getcon('FREEZING-POINT')
191        PI       = 4.*atan(1.)        PI       = 4.*atan(1.)
192    
193  c Determine Upper  Level for Cumulus Convection  c Determine Total number of Random Clouds to Check
 c and Total number of Random Clouds to Check  
194  c ---------------------------------------------  c ---------------------------------------------
   
       NLTOP = 1  
       DO L=1,lm  
        PCHECK = (1000.-ptop)*SIG(L) + PTOP  
        IF (PCHECK.GE.10.) THEN  
         NLTOP = L  
         GO TO 2  
        ENDIF  
       ENDDO  
  2    CONTINUE  
195        ncrnd = (lm-nltop+1)/2        ncrnd = (lm-nltop+1)/2
196    
 c Determine Minimum Number of Levels in Sub-Cloud (50 mb) Layer  
 c -------------------------------------------------------------  
       nsubmin = lm  
       nsubmax = 1  
       DO L=lm-1,1,-1  
           PCHECK = (1000.-ptop)*SIG(L) + PTOP  
       IF( PCHECK.GE.950.0 ) nsubmin = L  
       IF( PCHECK.GE.750.0 ) nsubmax = L  
       ENDDO  
   
197        if(first .and. myid.eq.0) then        if(first .and. myid.eq.0) then
198         print *         print *
199         print *,'Top Level Allowed for Convection : ',nltop,         print *,'Top Level Allowed for Convection : ',nltop
200       .                    ' (',(1000.-ptop)*SIG(nltop) + PTOP,' mb)'         print *,'          Highest Sub-Cloud Level: ',nsubmax
201         print *,'          Highest Sub-Cloud Level: ',nsubmax,         print *,'          Lowest  Sub-Cloud Level: ',nsubmin
      .                    ' (',(1000.-ptop)*SIG(nsubmax) + PTOP,' mb)'  
        print *,'          Lowest  Sub-Cloud Level: ',nsubmin,  
      .                    ' (',(1000.-ptop)*SIG(nsubmin) + PTOP,' mb)'  
202         print *,'    Total Number of Random Clouds: ',ncrnd         print *,'    Total Number of Random Clouds: ',ncrnd
203         print *         print *
204         first = .false.         first = .false.
# Line 286  c -------------------------------------- Line 260  c --------------------------------------
260           thgather(index,L) =   tz(pblindex(index),1,L)           thgather(index,L) =   tz(pblindex(index),1,L)
261           shgather(index,L) =   qz(pblindex(index),1,L,1)           shgather(index,L) =   qz(pblindex(index),1,L,1)
262          pkegather(index,L) = pkht(pblindex(index),1,L)          pkegather(index,L) = pkht(pblindex(index),1,L)
263            pkzgather(index,L) = pkl (pblindex(index),1,L)
264         enddo         enddo
265        enddo        enddo
266        do nt = 1,ntracer-ptracer        do nt = 1,ntracer-ptracer
# Line 296  c -------------------------------------- Line 271  c --------------------------------------
271        enddo        enddo
272        enddo        enddo
273    
       call pkappa(pigather,pkegather,pkzgather,ptop,sige,dsig,im,jm,lm)  
   
274  c bump the counter for number of calls to convection  c bump the counter for number of calls to convection
275  c --------------------------------------------------  c --------------------------------------------------
276                          iras = iras + 1                          iras = iras + 1
# Line 729  c  snow algorthm: Line 702  c  snow algorthm:
702  c  if temperature profile from the surface level to 700 mb  c  if temperature profile from the surface level to 700 mb
703  c  uniformaly c  below zero, then precipitation (total) is  c  uniformaly c  below zero, then precipitation (total) is
704  c  snowfall.  Else there is no snow.  c  snowfall.  Else there is no snow.
 c  For version of level 70, the sigma level corresponding  
 c  to 700mb (assume the surface pressure is 1000mb) is  
 c  the 13th level from the surface  
 c   Runhua Yang Aug. 24 98  
 c  added pcheck for 700mb - sharon sept 18, 1998  
705  c-------------------------------------------------------  c-------------------------------------------------------
706    
         pup = 700.  
         do L = lm, 1, -1  
           pcheck = (1000.-ptop)*sig(L) + ptop  
           if (pcheck .ge. pup) then  
             lup = L  
           endif  
         enddo  
707          do i = 1,istrip          do i = 1,istrip
708            snowcrit=0            snowcrit=0
709            do l=lup,lm            do l=lup,lm
# Line 826  C ************************************** Line 787  C **************************************
787  C                          BUMP DIAGNOSTICS  C                          BUMP DIAGNOSTICS
788  C **********************************************************************  C **********************************************************************
789    
 c Determine Level Indices for Low-Mid-High Cloud Regions  
 c ------------------------------------------------------  
       lowlevel = lm  
       midlevel = lm  
       do L = lm-1,1,-1  
       pcheck = (1000.-ptop)*sig(l) + ptop  
       if (pcheck.gt.700.0) lowlevel = L  
       if (pcheck.gt.400.0) midlevel = L  
       enddo  
   
   
790  c Clear-Sky (Above 400mb) Temperature  c Clear-Sky (Above 400mb) Temperature
791  c -----------------------------------  c -----------------------------------
792        if( itmpuclr.ne.0 .or. isphuclr.ne.0 ) then        if( itmpuclr.ne.0 .or. isphuclr.ne.0 ) then
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22