/[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.21 by molod, Thu Dec 2 19:06:17 2004 UTC revision 1.30 by molod, Wed Mar 9 23:25:18 2005 UTC
# Line 16  C $Name$ Line 16  C $Name$
16    
17  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
18  #include "SIZE.h"  #include "SIZE.h"
19  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
20  #include "diagnostics.h"  #include "DIAGNOSTICS.h"
21  #endif  #endif
22    
23  c Input Variables  c Input Variables
# Line 196  C Threshold for Cloud Liquid Water Memor Line 196  C Threshold for Cloud Liquid Water Memor
196    
197  c Determine Total number of Random Clouds to Check  c Determine Total number of Random Clouds to Check
198  c ---------------------------------------------  c ---------------------------------------------
199  C     ncrnd = (lm-nltop+1)/2        ncrnd = (lm-nltop+1)/2
       ncrnd = 0  
200    
201        if(first .and. myid.eq.1 .and. bi.eq.1 ) then        if(first .and. myid.eq.1 .and. bi.eq.1 ) then
202         print *         print *
# Line 371  C ************************************** Line 370  C **************************************
370         endif         endif
371        enddo        enddo
372    
   
373  C Initiate a do-loop around RAS for the number of different  C Initiate a do-loop around RAS for the number of different
374  C    sub-cloud layer depths in this strip  C    sub-cloud layer depths in this strip
375  C --If all subcloud depths are the same, execute loop once  C --If all subcloud depths are the same, execute loop once
# Line 821  C Remove pi-weighting for u and v tenden Line 819  C Remove pi-weighting for u and v tenden
819        do j = 1,jm        do j = 1,jm
820        do i = 1,im        do i = 1,im
821         dumoist(i,j,L) = dumoist(i,j,L) * tmpimjm(i,j)         dumoist(i,j,L) = dumoist(i,j,L) * tmpimjm(i,j)
822         dumoist(i,j,L) = dumoist(i,j,L) * tmpimjm(i,j)         dvmoist(i,j,L) = dvmoist(i,j,L) * tmpimjm(i,j)
823        enddo        enddo
824        enddo        enddo
825        enddo        enddo
826    
827    
828        endif        endif
829    
830  C **********************************************************************  C **********************************************************************
# Line 887  c ------------------------------- Line 886  c -------------------------------
886        enddo        enddo
887        endif        endif
888    
 c Moist Processes Change in U-Momentum (Cumulus Friction)  
 c ------------------------------------------------------  
       if(iudiag1.gt.0) then  
       do L = 1,lm  
       do j = 1,jm  
       do i = 1,im  
        indgath = (j-1)*im + i  
       qdiag(i,j,iudiag1+L-1,bi,bj) = qdiag(i,j,iudiag1+L-1,bi,bj) +  
      .    dumoist(i,j,L)*sday  
       enddo  
       enddo  
       enddo  
       endif  
   
 c Moist Processes Change in V-Momentum (Cumulus Friction)  
 c ------------------------------------------------------  
       if(iudiag2.gt.0) then  
       do L = 1,lm  
       do j = 1,jm  
       do i = 1,im  
        indgath = (j-1)*im + i  
       qdiag(i,j,iudiag2+L-1,bi,bj) = qdiag(i,j,iudiag2+L-1,bi,bj) +  
      .    dvmoist(i,j,L)*sday  
       enddo  
       enddo  
       enddo  
       endif  
   
889  c Cloud Mass Flux  c Cloud Mass Flux
890  c ---------------  c ---------------
891        if(icldmas.gt.0) then        if(icldmas.gt.0) then
# Line 1158  C ************************************** Line 1129  C **************************************
1129    
1130         ndtls  = ndtls  + 1         ndtls  = ndtls  + 1
1131         ndqls  = ndqls  + 1         ndqls  = ndqls  + 1
1132    
1133           nudiag1  = nudiag1  + 1
1134           nudiag2  = nudiag2  + 1
1135    
1136         endif         endif
1137  #endif  #endif
1138    
# Line 1213  C Local Variables Line 1188  C Local Variables
1188        integer IC(ICM),   IRND(icm)        integer IC(ICM),   IRND(icm)
1189        _RL cmass(lng,K)        _RL cmass(lng,K)
1190        LOGICAL SETRAS        LOGICAL SETRAS
1191          integer ifound
1192          _RL temp
1193          _RL thbef(lng,K)
1194    
1195        integer i,L,nc,ib,nt        integer i,L,nc,ib,nt
1196        integer km1,kp1,kprv,kcr,kfx,ncmx        integer km1,kp1,kprv,kcr,kfx,ncmx
# Line 1231  C The numerator here is the fraction of Line 1209  C The numerator here is the fraction of
1209  C      allowed to entrain into the cloud  C      allowed to entrain into the cloud
1210    
1211  CCC   FRAC = 1./dt  CCC   FRAC = 1./dt
1212    CCC   FRAC = 0.5/dt
1213        FRAC = 0.5/dt        FRAC = 0.5/dt
1214    
1215        KM1    = K  - 1        KM1    = K  - 1
# Line 1241  C Line 1220  C
1220         KPRV  = KM1         KPRV  = KM1
1221  C Removed KRMAX parameter  C Removed KRMAX parameter
1222         KCR   = MIN(KM1,nlayr-2)             KCR   = MIN(KM1,nlayr-2)    
1223  CCC    KFX   = KM1 - KCR         KFX   = KM1 - KCR
        KFX   = KM1  
1224         NCMX  = KFX + NCRND         NCMX  = KFX + NCRND
1225  C  C
1226         IF (KFX .GT. 0) THEN         IF (KFX .GT. 0) THEN
# Line 1322  c ***************************** Line 1300  c *****************************
1300    
1301        DO L=IB,K        DO L=IB,K
1302         DO I=1,LENC         DO I=1,LENC
1303            thbef(I,L) = POI(I,L)
1304          POI(I,L) = POI(I,L) + TCU(I,L) * DT * rhfrac(i)          POI(I,L) = POI(I,L) + TCU(I,L) * DT * rhfrac(i)
1305          QOI(I,L) = QOI(I,L) + QCU(I,L) * DT * rhfrac(i)          QOI(I,L) = QOI(I,L) + QCU(I,L) * DT * rhfrac(i)
1306         ENDDO         ENDDO
# Line 1337  c ***************************** Line 1316  c *****************************
1316         rains(I,ib) = rains(I,ib) + PCU(I)*dt * rhfrac(i)         rains(I,ib) = rains(I,ib) + PCU(I)*dt * rhfrac(i)
1317        ENDDO        ENDDO
1318    
1319          do i = 1,lenc
1320           ifound = 0
1321           do L = 1,k
1322            if(tcu(i,L).ne.0.)ifound = ifound + 1
1323           enddo
1324           if(ifound.ne.0) then
1325    c       print *,i,' made a cloud detraining at ',ib
1326            do L = 1,k
1327             temp = TCU(I,L) * DT * rhfrac(i)
1328    c        write(6,122)L,thbef(i,L),poi(i,L),temp
1329            enddo
1330           endif
1331          enddo
1332    
1333    100 CONTINUE    100 CONTINUE
1334    
1335     122  format(' ',i3,' TH B ',e10.3,' TH A ',e10.3,' DTH ',e10.3)
1336    
1337  c Fill Convective Cloud Fractions based on 3-D Rain Amounts  c Fill Convective Cloud Fractions based on 3-D Rain Amounts
1338  c ---------------------------------------------------------  c ---------------------------------------------------------
# Line 1354  c -------------------------------------- Line 1349  c --------------------------------------
1349        implicit none        implicit none
1350        integer n,iras,nrnd,myid        integer n,iras,nrnd,myid
1351        _RL random_numbx        _RL random_numbx
1352        _RL rnd(nrnd)  c     _RL rnd(nrnd)
1353          _RL rnd(*)
1354        integer irm        integer irm
1355        parameter (irm = 1000)        parameter (irm = 1000)
1356        _RL random(irm)        _RL random(irm)
1357        integer i,mcheck,numrand,iseed,indx        integer i,mcheck,iseed,indx
1358        logical first        logical first
1359        data    first /.true./        data    first /.true./
1360        integer iras0        integer iras0
1361        data    iras0 /0/        data    iras0 /0/
1362        save random, iras0        save random, iras0
1363    
1364        if(nrnd.eq.0.)then        if(nrnd.eq.0)then
1365         do i = 1,nrnd         do i = 1,nrnd
1366          rnd(i) = 0          rnd(i) = 0
1367         enddo         enddo
# Line 1375  c -------------------------------------- Line 1371  c --------------------------------------
1371    
1372        mcheck = mod(iras-1,irm/nrnd)        mcheck = mod(iras-1,irm/nrnd)
1373    
1374    c     print *,' RNDCLOUD: first ',first,' iras ',iras,' iras0 ',iras0
1375    c     print *,' RNDCLOUD: irm,nrnd,mcheck=',irm,nrnd,mcheck
1376    
1377          if ( iras.eq.iras0 ) then
1378    C-    Not the 1rst tile: we are all set (already done for the 1rst tile):
1379    c -----------------------------------------------------------------------
1380              indx = (iras-1)*nrnd
1381    
1382  c First Time In From a Continuing RESTART (IRAS.GT.1) or Reading a New RESTART  c First Time In From a Continuing RESTART (IRAS.GT.1) or Reading a New RESTART
1383    c   -- or --
1384    c Multiple Time In But have Used Up all 1000 numbers (MCHECK.EQ.0)
1385  c ----------------------------------------------------------------------------  c ----------------------------------------------------------------------------
1386        if( first.and.(iras.gt.1) .or. iras.ne.iras0+1 )then        elseif ( first.and.(iras.gt.1) .or. mcheck.eq.0 ) then
1387         print *,' first ',first,' iras ',iras,' iras0 ',iras0         iseed = (iras-1-mcheck)*nrnd
        if( myid.eq.1 ) print *, 'Recreating Rand Numb Array in RNDCLOUD'  
        if( myid.eq.1 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0  
        numrand = mod(iras,irm/nrnd) * nrnd  
        iseed   = iras * nrnd - numrand  
1388         call random_seedx(iseed)         call random_seedx(iseed)
1389         do i = 1,irm         do i = 1,irm
1390          random(i) = random_numbx(iseed)          random(i) = random_numbx(iseed)
1391         enddo         enddo
1392         indx = (iras-1)*nrnd         indx = (iras-1)*nrnd
1393    
1394  c Multiple Time In But have Used Up all 1000 numbers (MCHECK.EQ.0)         if( myid.eq.1 ) print *, 'Creating Rand Numb Array in RNDCLOUD'
1395  c ----------------------------------------------------------------       &                        ,', iseed=', iseed
1396        else if (mcheck.eq.0) then         if( myid.eq.1 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0,
1397            iseed = (iras-1)*nrnd       &    ' indx: ', mod(indx,irm)
           call random_seedx(iseed)  
           do i = 1,irm  
            random(i) = random_numbx(iseed)  
           enddo  
           indx = iseed  
1398    
1399  c Multiple Time In But have NOT Used Up all 1000 numbers (MCHECK.NE.0)  c Multiple Time In But have NOT Used Up all 1000 numbers (MCHECK.NE.0)
1400  c --------------------------------------------------------------------  c --------------------------------------------------------------------
# Line 1406  c -------------------------------------- Line 1403  c --------------------------------------
1403        endif        endif
1404    
1405            indx = mod(indx,irm)            indx = mod(indx,irm)
1406        if( indx+nrnd.gt.1000 ) indx=1000-nrnd        if( indx+nrnd.gt.irm ) then
1407    c       if( myid.eq.1 .AND. iras.ne.iras0 ) print *,
1408    c    &   'reach end of Rand Numb Array in RNDCLOUD',indx,irm-nrnd
1409            indx=irm-nrnd
1410          endif
1411    
1412        do n = 1,nrnd        do n = 1,nrnd
1413         rnd(n) = random(indx+n)         rnd(n) = random(indx+n)
1414        enddo        enddo
# Line 1415  c -------------------------------------- Line 1416  c --------------------------------------
1416   100  continue   100  continue
1417        first = .false.        first = .false.
1418        iras0 = iras        iras0 = iras
1419    
1420        return        return
1421        end        end
1422        function random_numbx(iseed)        function random_numbx(iseed)
# Line 1422  c -------------------------------------- Line 1424  c --------------------------------------
1424        integer iseed        integer iseed
1425        real *8 seed,port_rand        real *8 seed,port_rand
1426        _RL random_numbx        _RL random_numbx
       random_numbx = 0  
1427  #ifdef CRAY  #ifdef CRAY
1428        _RL ranf        _RL ranf
1429        random_numbx = ranf()        random_numbx = ranf()
# Line 1430  c -------------------------------------- Line 1431  c --------------------------------------
1431  #ifdef SGI  #ifdef SGI
1432        _RL rand        _RL rand
1433        random_numbx = rand()        random_numbx = rand()
1434  #endif  #else
1435          seed = -1.d0
1436        random_numbx = port_rand(seed)        random_numbx = port_rand(seed)
1437  #endif  #endif
1438    #endif
1439        return        return
1440        end        end
1441        subroutine random_seedx (iseed)        subroutine random_seedx (iseed)
1442        implicit none        implicit none
1443        integer  iseed        integer  iseed
1444          real *8 port_rand
1445  #ifdef CRAY  #ifdef CRAY
1446        call ranset (iseed)        call ranset (iseed)
1447  #endif  #else
1448  #ifdef SGI  #ifdef SGI
1449        integer*4   seed        integer*4   seed
1450                    seed = iseed                    seed = iseed
1451        call srand (seed)        call srand (seed)
1452    #else
1453          real*8 tmpRdN
1454          real*8 seed
1455          seed = iseed
1456          tmpRdN = port_rand(seed)
1457    #endif
1458  #endif  #endif
1459        return        return
1460        end        end
# Line 1591  C Argument List declarations Line 1601  C Argument List declarations
1601        _RL POI(lng,K),QOI(lng,K),PRS(lng,K+1),PRJ(lng,K+1)        _RL POI(lng,K),QOI(lng,K),PRS(lng,K+1),PRJ(lng,K+1)
1602        _RL uoi(lng,nlayr,ntracedim)        _RL uoi(lng,nlayr,ntracedim)
1603        _RL PCU(LENC), CLN(lng)        _RL PCU(LENC), CLN(lng)
1604        _RL TCU(lng,K),  QCU(lng,K),  ucu(lng,k,ntracedim), CMASS(lng,K)        _RL TCU(lng,K),QCU(lng,K),ucu(lng,k,ntracedim),CMASS(lng,K)
1605        _RL ALF(lng,K), BET(lng,K),  GAM(lng,K), PRH(lng,K), PRI(lng,K)        _RL ALF(lng,K), BET(lng,K),  GAM(lng,K), PRH(lng,K), PRI(lng,K)
1606        _RL HOL(LENC,K), ETA(LENC,K), HST(LENC,K), QOL(LENC,K)        _RL HOL(LENC,K), ETA(LENC,K), HST(LENC,K), QOL(LENC,K)
1607        _RL GMH(LENC,K)        _RL GMH(LENC,K)
# Line 2174  c ----------------------------------- Line 2184  c -----------------------------------
2184        II = I1(I)        II = I1(I)
2185        ucu(II,L,nt) = TX3(I)        ucu(II,L,nt) = TX3(I)
2186   1020 CONTINUE   1020 CONTINUE
2187    
2188        DO 1030 I=1,LENB        DO 1030 I=1,LENB
2189        II = I1(I)        II = I1(I)
2190        IF (TX6(I) .GE. 1.0) THEN        IF (TX6(I) .GE. 1.0) THEN
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.30
  ViewVC Help
Powered by ViewVC 1.1.22