/[MITgcm]/MITgcm/pkg/aim/phy_vdifsc.F
ViewVC logotype

Diff of /MITgcm/pkg/aim/phy_vdifsc.F

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

revision 1.2 by adcroft, Fri Feb 2 21:36:29 2001 UTC revision 1.6 by jmc, Fri Sep 27 20:05:11 2002 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "AIM_OPTIONS.h"
5    
6  cch      SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,  cch      SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
7        SUBROUTINE VDIFSC (UA,VA,Ta,RH,QA,QSAT,        SUBROUTINE VDIFSC (UA,VA,Ta,RH,QA,QSAT,
8       &                   UTENVD,VTENVD,TTENVD,QTENVD)       &                   UTENVD,VTENVD,TTENVD,QTENVD,
9         &                   myThid)
10  C-  C-
11  C--   SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,  C--   SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
12  C--  &                   UTENVD,VTENVD,TTENVD,QTENVD)  C--  &                   UTENVD,VTENVD,TTENVD,QTENVD)
# Line 22  C--            TTENVD = temperature tend Line 25  C--            TTENVD = temperature tend
25  C--            QTENVD = sp. humidity tendency [g/(kg s)] (3-dim)  C--            QTENVD = sp. humidity tendency [g/(kg s)] (3-dim)
26  C-  C-
27    
28          IMPLICIT NONE
29    
30        IMPLICIT rEAL*8 (A-H,O-Z)  C     Resolution parameters
31    
32    C-- size for MITgcm & Physics package :
33    #include "AIM_SIZE.h"
34    
35  C     Resolution parameters  #include "EEPARAMS.h"
36    
37    #include "AIM_GRID.h"
38    
 #include "atparam.h"  
 #include "atparam1.h"  
 #include "Lev_def.h"  
 C  
       PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )  
 C  
39  C     Physical constants + functions of sigma and latitude  C     Physical constants + functions of sigma and latitude
40  C  C
41  #include "com_physcon.h"  #include "com_physcon.h"
# Line 41  C Line 43  C
43  C     Vertical diffusion constants  C     Vertical diffusion constants
44  C  C
45  #include "com_vdicon.h"  #include "com_vdicon.h"
46  C  
47        REAL UA(NGP,NLEV), VA(NGP,NLEV), SE(NGP,NLEV),  C-- Routine arguments:
48          INTEGER  myThid
49    c     REAL UA(NGP,NLEV), VA(NGP,NLEV), SE(NGP,NLEV),
50          _RL UA(NGP,NLEV), VA(NGP,NLEV), Ta(NGP,NLEV),
51       &     RH(NGP,NLEV), QA(NGP,NLEV), QSAT(NGP,NLEV)       &     RH(NGP,NLEV), QA(NGP,NLEV), QSAT(NGP,NLEV)
52  C  C
53        REAL UTENVD(NGP,NLEV), VTENVD(NGP,NLEV),        _RL UTENVD(NGP,NLEV), VTENVD(NGP,NLEV),
54       &     TTENVD(NGP,NLEV), QTENVD(NGP,NLEV)       &     TTENVD(NGP,NLEV), QTENVD(NGP,NLEV)
55  C  
56    #ifdef ALLOW_AIM
57    
58    C-- Local variables:
59        INTEGER NL1(NGP)        INTEGER NL1(NGP)
60        REAL RTST(NGP)        _RL RTST(NGP)
61        REAL RNL1(NGP)        _RL RNL1(NGP)
62  C  C
63        REAL Th(NGP,NLEV), Ta(NGP,NLEV)        _RL Th(NGP,NLEV)
64        REAL dThdp        _RL dThdp
65        REAL stab(NGP)        _RL stab(NGP)
66        REAL AUX(NGP)  c     REAL AUX(NGP)
67        REAL Prefw(NLEV), Prefs(NLEV)        _RL Prefw(NLEV), Prefs(NLEV)
68        DATA Prefs / 75., 250., 500., 775., 950./        DATA Prefs / 75., 250., 500., 775., 950./
69        DATA Prefw / 0., 150., 350., 650., 900./        DATA Prefw / 0., 150., 350., 650., 900./
70        REAL Pground        _RL Pground
71        DATA pground /1000./        DATA pground /1000./
72  Cchdbg  Cchdbg
73        REAL xindconv1  c     REAL xindconv1
74        SAVE xindconv1  c     SAVE xindconv1
75        REAL xindconv  c     REAL xindconv
76        SAVE xindconv  c     SAVE xindconv
77        INTEGER npas  c     INTEGER npas
78        SAVE npas  c     SAVE npas
79        LOGICAL ifirst  c     LOGICAL ifirst
80        DATA ifirst /.TRUE./        c     DATA ifirst /.TRUE./      
81        SAVE ifirst  c     SAVE ifirst
82  C        INTEGER J,K
83    
84    C- jmc: declare all local variables:
85          _RL RTVD, RTSQ, DMSE, QEQL
86    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
87    
88  C--   1. Initalization  C--   1. Initalization
89  C  C
90        DO K=1,NLEV        DO K=1,NLEV
# Line 82  C Line 95  C
95            QTENVD(J,K) = 0.            QTENVD(J,K) = 0.
96          ENDDO          ENDDO
97        ENDDO        ENDDO
98    
99  c  c
100  C  C
101  C *****************************************  C *****************************************
102  C *****************************************  C *****************************************
103  Cchdbg  Cchdbg
104        if(ifirst) then  C     if(ifirst) then
105          xindconv=0.  C       xindconv=0.
106          xindconv1=0.  C       xindconv1=0.
107          npas=0  C       npas=0
108          ifirst=.FALSE.  C       ifirst=.FALSE.
109        endif  C     endif
110        npas = npas +1  C     npas = npas +1
111  Cchdbg  Cchdbg
112  C ******************************************  C ******************************************
113  C *****************************************  C *****************************************
# Line 101  C Line 115  C
115  C--   2. Vertical diffusion and shallow convection  C--   2. Vertical diffusion and shallow convection
116  C  C
117        DO J=1,NGP        DO J=1,NGP
118          NL1(J)=NLEVxy(J)-1          NL1(J)=NLEVxy(J,myThid)-1
119        ENDDO        ENDDO
120  C  C
121        RTVD = -1./(3600.*TRVDI)        RTVD = -1./(3600.*TRVDI)
122        RTSQ = -1./(3600.*TRSHC)        RTSQ = -1./(3600.*TRSHC)
123  C  C
124        DO J=1,NGP        DO J=1,NGP
125         IF ( NLEVxy(J) .GT. 0 ) THEN         IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
126          RTST(J) = RTSQ*DSIG(NL1(J))/((DSIG(NLEVxy(J))+DSIG(NL1(J)))*CP)          RTST(J) = RTSQ*DSIG(NL1(J))
127          RNL1(J) = -DSIG(NLEVxy(J))/DSIG(NL1(J))       &          /((DSIG(NLEVxy(J,myThid))+DSIG(NL1(J)))*CP)
128            RNL1(J) = -DSIG(NLEVxy(J,myThid))/DSIG(NL1(J))
129         ENDIF         ENDIF
130        ENDDO        ENDDO
131    
132  C  C
133  C  C
134  C New writing of the Conditional stability  C New writing of the Conditional stability
135  C ----------------------------------------  C ----------------------------------------
136        DO J=1,NGP        DO J=1,NGP
137         IF ( NLEVxy(J) .GT. 0 ) THEN         IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
138          DO k=NL1(J),NLEVxy(J)          DO k=NL1(J),NLEVxy(J,myThid)
139           Th(J,K)=Ta(J,K)*(Pground/Prefs(k))**(RD/CP)           Th(J,K)=Ta(J,K)*(Pground/Prefs(k))**(RD/CP)
140          ENDDO          ENDDO
141         ENDIF         ENDIF
142        ENDDO        ENDDO
143  C  C
144        DO J=1,NGP        DO J=1,NGP
145         IF ( NLEVxy(J) .GT. 0 ) THEN         stab(J)=0.
146          dThdp=(Th(J,NL1(J))-Th(J,NLEVxy(J)))         IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
147       &              *((Prefw(NLEVxy(J))/Pground)**(RD/CP))*CP          dThdp=(Th(J,NL1(J))-Th(J,NLEVxy(J,myThid)))
148          stab(J)=dThdp+ALHC*(QSAT(J,NL1(J))-QSAT(J,NLEVxy(J)))       &              *((Prefw(NLEVxy(J,myThid))/Pground)**(RD/CP))*CP
149            stab(J)=dThdp+ALHC*(QSAT(J,NL1(J))-QSAT(J,NLEVxy(J,myThid)))
150         ENDIF         ENDIF
151        ENDDO        ENDDO
152   121  continue   121  continue
153  C  C
154        DO J=1,NGP        DO J=1,NGP
155  C  C
156  cch        DMSE = (SE(J,NLEVxy(J))-SE(J,NL1(J)))+  cch        DMSE = (SE(J,NLEVxy(J,myThid))-SE(J,NL1(J)))+
157  cch     &                ALHC*(QA(J,NLEVxy(J))-QSAT(J,NL1(J)))  cch     &                ALHC*(QA(J,NLEVxy(J,myThid))-QSAT(J,NL1(J)))
158         DMSE = - stab(J)         DMSE = - stab(J)
159         IF ( NLEVxy(J) .GT. 0 ) THEN         IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
160          QEQL = MIN(QA(J,NLEVxy(J)),RH(J,NL1(J))*QSAT(J,NLEVxy(J)))          QEQL = MIN( QA(J,NLEVxy(J,myThid)),
161  cchdbg        QEQL = MIN(QA(J,NLEVxy(J)),QA(J,NL1(J)))       &              RH(J,NL1(J))*QSAT(J,NLEVxy(J,myThid)) )
162    cchdbg        QEQL = MIN(QA(J,NLEVxy(J,myThid)),QA(J,NL1(J)))
163         ENDIF         ENDIF
164  C  C
165          IF (DMSE.GE.0.0) THEN          IF (DMSE.GE.0.0) THEN
# Line 149  C Line 167  C
167  C ***************************************************  C ***************************************************
168  C ***************************************************  C ***************************************************
169  C chdbg  C chdbg
170            if(J.ge.6336 .and. J.eq.6348) then  C         if(J.ge.6336 .and. J.eq.6348) then
171               xindconv=xindconv+1./13.  C            xindconv=xindconv+1./13.
172            endif  C         endif
173            if(J.ge.4160 .and. J.eq.4172) then  C         if(J.ge.4160 .and. J.eq.4172) then
174               xindconv1=xindconv1+1./13.  C            xindconv1=xindconv1+1./13.
175            endif  C         endif
176            if(npas.eq.960 .and. J.eq.1) then  C         if(npas.eq.960 .and. J.eq.1) then
177              write(0,*) 'xindconv=',xindconv  C           write(0,*) 'xindconv=',xindconv
178              write(0,*) 'xindconv1=',xindconv1  C           write(0,*) 'xindconv1=',xindconv1
179            endif  C         endif
180  Cchdbg  Cchdbg
181  C ****************************************************  C ****************************************************
182  C ****************************************************  C ****************************************************
183  C  C
184  C         2.1 Shallow convection  C         2.1 Shallow convection
185  C  C
186            IF ( NLEVxy(J) .GT. 0 ) THEN            IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
187             TTENVD(J,NLEVxy(J)) = RTST(J)*DMSE             TTENVD(J,NLEVxy(J,myThid)) = RTST(J)*DMSE
188             TTENVD(J,NL1(J))  = RNL1(J)*TTENVD(J,NLEVxy(J))             TTENVD(J,NL1(J))  = RNL1(J)*TTENVD(J,NLEVxy(J,myThid))
189             QTENVD(J,NLEVxy(J)) = RTSQ*(QA(J,NLEVxy(J))-QEQL)             QTENVD(J,NLEVxy(J,myThid)) =
190             QTENVD(J,NL1(J))  = RNL1(J)*QTENVD(J,NLEVxy(J))       &                         RTSQ*(QA(J,NLEVxy(J,myThid))-QEQL)
191               QTENVD(J,NL1(J))  = RNL1(J)*QTENVD(J,NLEVxy(J,myThid))
192            ENDIF            ENDIF
193  C  C
194          ELSE          ELSE
195  C  C
196  C         2.2 Vertical diffusion of moisture  C         2.2 Vertical diffusion of moisture
197    
198            QTENVD(J,NLEVxy(J)) = RTVD*(QA(J,NLEVxy(J))-QEQL)            QTENVD(J,NLEVxy(J,myThid)) =
199            QTENVD(J,NL1(J))  = RNL1(J)*QTENVD(J,NLEVxy(J))       &                        RTVD*(QA(J,NLEVxy(J,myThid))-QEQL)
200              QTENVD(J,NL1(J))  = RNL1(J)*QTENVD(J,NLEVxy(J,myThid))
201  C  C
202          ENDIF          ENDIF
203  C  C
204        ENDDO        ENDDO
205  C  C
206    #endif /* ALLOW_AIM */
207    
208        RETURN        RETURN
209        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22