/[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.1 by cnh, Fri Jan 26 00:14:32 2001 UTC revision 1.2 by adcroft, Fri Feb 2 21:36:29 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    C $Name$
3    
4    cch      SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
5          SUBROUTINE VDIFSC (UA,VA,Ta,RH,QA,QSAT,
6         &                   UTENVD,VTENVD,TTENVD,QTENVD)
7    C-
8    C--   SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
9    C--  &                   UTENVD,VTENVD,TTENVD,QTENVD)
10    C-
11    C--   Purpose: Compute tendencies of momentum, energy and moisture
12    C--            due to vertical diffusion and shallow convection
13    C--   Input:   UA     = u-wind                           (3-dim)
14    C--            VA     = v-wind                           (3-dim)
15    C--            SE     = dry static energy                (3-dim)
16    C--            RH     = relative humidity [0-1]          (3-dim)
17    C--            QA     = specific humidity [g/kg]         (3-dim)
18    C--            QSAT   = saturation sp. humidity [g/kg]   (3-dim)
19    C--   Output:  UTENVD = u-wind tendency                  (3-dim)
20    C--            VTENVD = v-wind tendency                  (3-dim)
21    C--            TTENVD = temperature tendency             (3-dim)
22    C--            QTENVD = sp. humidity tendency [g/(kg s)] (3-dim)
23    C-
24    
25    
26          IMPLICIT rEAL*8 (A-H,O-Z)
27    
28    
29    C     Resolution parameters
30    
31    #include "atparam.h"
32    #include "atparam1.h"
33    #include "Lev_def.h"
34    C
35          PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
36    C
37    C     Physical constants + functions of sigma and latitude
38    C
39    #include "com_physcon.h"
40    C
41    C     Vertical diffusion constants
42    C
43    #include "com_vdicon.h"
44    C
45          REAL UA(NGP,NLEV), VA(NGP,NLEV), SE(NGP,NLEV),
46         &     RH(NGP,NLEV), QA(NGP,NLEV), QSAT(NGP,NLEV)
47    C
48          REAL UTENVD(NGP,NLEV), VTENVD(NGP,NLEV),
49         &     TTENVD(NGP,NLEV), QTENVD(NGP,NLEV)
50    C
51          INTEGER NL1(NGP)
52          REAL RTST(NGP)
53          REAL RNL1(NGP)
54    C
55          REAL Th(NGP,NLEV), Ta(NGP,NLEV)
56          REAL dThdp
57          REAL stab(NGP)
58          REAL AUX(NGP)
59          REAL Prefw(NLEV), Prefs(NLEV)
60          DATA Prefs / 75., 250., 500., 775., 950./
61          DATA Prefw / 0., 150., 350., 650., 900./
62          REAL Pground
63          DATA pground /1000./
64    Cchdbg
65          REAL xindconv1
66          SAVE xindconv1
67          REAL xindconv
68          SAVE xindconv
69          INTEGER npas
70          SAVE npas
71          LOGICAL ifirst
72          DATA ifirst /.TRUE./      
73          SAVE ifirst
74    C
75    C--   1. Initalization
76    C
77          DO K=1,NLEV
78            DO J=1,NGP
79              UTENVD(J,K) = 0.
80              VTENVD(J,K) = 0.
81              TTENVD(J,K) = 0.
82              QTENVD(J,K) = 0.
83            ENDDO
84          ENDDO
85    c
86    C
87    C *****************************************
88    C *****************************************
89    Cchdbg
90          if(ifirst) then
91            xindconv=0.
92            xindconv1=0.
93            npas=0
94            ifirst=.FALSE.
95          endif
96          npas = npas +1
97    Cchdbg
98    C ******************************************
99    C *****************************************
100    C
101    C--   2. Vertical diffusion and shallow convection
102    C
103          DO J=1,NGP
104            NL1(J)=NLEVxy(J)-1
105          ENDDO
106    C
107          RTVD = -1./(3600.*TRVDI)
108          RTSQ = -1./(3600.*TRSHC)
109    C
110          DO J=1,NGP
111           IF ( NLEVxy(J) .GT. 0 ) THEN
112            RTST(J) = RTSQ*DSIG(NL1(J))/((DSIG(NLEVxy(J))+DSIG(NL1(J)))*CP)
113            RNL1(J) = -DSIG(NLEVxy(J))/DSIG(NL1(J))
114           ENDIF
115          ENDDO
116    C
117    C
118    C New writing of the Conditional stability
119    C ----------------------------------------
120          DO J=1,NGP
121           IF ( NLEVxy(J) .GT. 0 ) THEN
122            DO k=NL1(J),NLEVxy(J)
123             Th(J,K)=Ta(J,K)*(Pground/Prefs(k))**(RD/CP)
124            ENDDO
125           ENDIF
126          ENDDO
127    C
128          DO J=1,NGP
129           IF ( NLEVxy(J) .GT. 0 ) THEN
130            dThdp=(Th(J,NL1(J))-Th(J,NLEVxy(J)))
131         &              *((Prefw(NLEVxy(J))/Pground)**(RD/CP))*CP
132            stab(J)=dThdp+ALHC*(QSAT(J,NL1(J))-QSAT(J,NLEVxy(J)))
133           ENDIF
134          ENDDO
135     121  continue
136    C
137          DO J=1,NGP
138    C
139    cch        DMSE = (SE(J,NLEVxy(J))-SE(J,NL1(J)))+
140    cch     &                ALHC*(QA(J,NLEVxy(J))-QSAT(J,NL1(J)))
141           DMSE = - stab(J)
142           IF ( NLEVxy(J) .GT. 0 ) THEN
143            QEQL = MIN(QA(J,NLEVxy(J)),RH(J,NL1(J))*QSAT(J,NLEVxy(J)))
144    cchdbg        QEQL = MIN(QA(J,NLEVxy(J)),QA(J,NL1(J)))
145           ENDIF
146    C
147            IF (DMSE.GE.0.0) THEN
148    C
149    C ***************************************************
150    C ***************************************************
151    C chdbg
152              if(J.ge.6336 .and. J.eq.6348) then
153                 xindconv=xindconv+1./13.
154              endif
155              if(J.ge.4160 .and. J.eq.4172) then
156                 xindconv1=xindconv1+1./13.
157              endif
158              if(npas.eq.960 .and. J.eq.1) then
159                write(0,*) 'xindconv=',xindconv
160                write(0,*) 'xindconv1=',xindconv1
161              endif
162    Cchdbg
163    C ****************************************************
164    C ****************************************************
165    C
166    C         2.1 Shallow convection
167    C
168              IF ( NLEVxy(J) .GT. 0 ) THEN
169               TTENVD(J,NLEVxy(J)) = RTST(J)*DMSE
170               TTENVD(J,NL1(J))  = RNL1(J)*TTENVD(J,NLEVxy(J))
171               QTENVD(J,NLEVxy(J)) = RTSQ*(QA(J,NLEVxy(J))-QEQL)
172               QTENVD(J,NL1(J))  = RNL1(J)*QTENVD(J,NLEVxy(J))
173              ENDIF
174    C
175            ELSE
176    C
177    C         2.2 Vertical diffusion of moisture
178    
179              QTENVD(J,NLEVxy(J)) = RTVD*(QA(J,NLEVxy(J))-QEQL)
180              QTENVD(J,NL1(J))  = RNL1(J)*QTENVD(J,NLEVxy(J))
181    C
182            ENDIF
183    C
184          ENDDO
185    C
186          RETURN
187          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22