pkg/aim/phy_vdifsc.F

C $Header: /u/gcmpack/models/MITgcmUV/pkg/aim/phy_vdifsc.F,v 1.2 2001/02/02 21:36:29 adcroft Exp $
C $Name:  $

cch      SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
      SUBROUTINE VDIFSC (UA,VA,Ta,RH,QA,QSAT,
     &                   UTENVD,VTENVD,TTENVD,QTENVD,
     &                   myThid)
C-
C--   SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
C--  &                   UTENVD,VTENVD,TTENVD,QTENVD)
C-
C--   Purpose: Compute tendencies of momentum, energy and moisture
C--            due to vertical diffusion and shallow convection
C--   Input:   UA     = u-wind                           (3-dim)
C--            VA     = v-wind                           (3-dim)
C--            SE     = dry static energy                (3-dim)
C--            RH     = relative humidity [0-1]          (3-dim)
C--            QA     = specific humidity [g/kg]         (3-dim)
C--            QSAT   = saturation sp. humidity [g/kg]   (3-dim)
C--   Output:  UTENVD = u-wind tendency                  (3-dim)
C--            VTENVD = v-wind tendency                  (3-dim)
C--            TTENVD = temperature tendency             (3-dim)
C--            QTENVD = sp. humidity tendency [g/(kg s)] (3-dim)
C-


      IMPLICIT rEAL*8 (A-H,O-Z)
      INTEGER  myThid

C     Resolution parameters

#include "atparam.h"
#include "atparam1.h"
#include "EEPARAMS.h"
#include "Lev_def.h"
C
      PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
C
C     Physical constants + functions of sigma and latitude
C
#include "com_physcon.h"
C
C     Vertical diffusion constants
C
#include "com_vdicon.h"
C
      REAL UA(NGP,NLEV), VA(NGP,NLEV), SE(NGP,NLEV),
     &     RH(NGP,NLEV), QA(NGP,NLEV), QSAT(NGP,NLEV)
C
      REAL UTENVD(NGP,NLEV), VTENVD(NGP,NLEV),
     &     TTENVD(NGP,NLEV), QTENVD(NGP,NLEV)
C
      INTEGER NL1(NGP)
      REAL RTST(NGP)
      REAL RNL1(NGP)
C
      REAL Th(NGP,NLEV), Ta(NGP,NLEV)
      REAL dThdp
      REAL stab(NGP)
      REAL AUX(NGP)
      REAL Prefw(NLEV), Prefs(NLEV)
      DATA Prefs / 75., 250., 500., 775., 950./
      DATA Prefw / 0., 150., 350., 650., 900./
      REAL Pground
      DATA pground /1000./
Cchdbg
      REAL xindconv1
      SAVE xindconv1
      REAL xindconv
      SAVE xindconv
      INTEGER npas
      SAVE npas
      LOGICAL ifirst
      DATA ifirst /.TRUE./       
      SAVE ifirst
C
C--   1. Initalization
C
      DO K=1,NLEV
        DO J=1,NGP
          UTENVD(J,K) = 0.
          VTENVD(J,K) = 0.
          TTENVD(J,K) = 0.
          QTENVD(J,K) = 0.
        ENDDO
      ENDDO

c
C
C *****************************************
C *****************************************
Cchdbg
C     if(ifirst) then
C       xindconv=0.
C       xindconv1=0.
C       npas=0
C       ifirst=.FALSE.
C     endif
C     npas = npas +1
Cchdbg
C ******************************************
C *****************************************
C
C--   2. Vertical diffusion and shallow convection
C
      DO J=1,NGP
        NL1(J)=NLEVxy(J,myThid)-1
      ENDDO
C
      RTVD = -1./(3600.*TRVDI)
      RTSQ = -1./(3600.*TRSHC)
C
      DO J=1,NGP
       IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
        RTST(J) = RTSQ*DSIG(NL1(J))/((DSIG(NLEVxy(J,myThid))+DSIG(NL1(J)))*CP)
        RNL1(J) = -DSIG(NLEVxy(J,myThid))/DSIG(NL1(J))
       ENDIF
      ENDDO

C
C
C New writing of the Conditional stability
C ----------------------------------------
      DO J=1,NGP
       IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
        DO k=NL1(J),NLEVxy(J,myThid)
         Th(J,K)=Ta(J,K)*(Pground/Prefs(k))**(RD/CP)
        ENDDO
       ENDIF
      ENDDO
C
      DO J=1,NGP
       stab(J)=0.
       IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
        dThdp=(Th(J,NL1(J))-Th(J,NLEVxy(J,myThid)))
     &              *((Prefw(NLEVxy(J,myThid))/Pground)**(RD/CP))*CP
        stab(J)=dThdp+ALHC*(QSAT(J,NL1(J))-QSAT(J,NLEVxy(J,myThid)))
       ENDIF
      ENDDO
 121  continue
C
      DO J=1,NGP
C
cch        DMSE = (SE(J,NLEVxy(J,myThid))-SE(J,NL1(J)))+
cch     &                ALHC*(QA(J,NLEVxy(J,myThid))-QSAT(J,NL1(J)))
       DMSE = - stab(J)
       IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
        QEQL = MIN(QA(J,NLEVxy(J,myThid)),RH(J,NL1(J))*QSAT(J,NLEVxy(J,myThid)))
cchdbg        QEQL = MIN(QA(J,NLEVxy(J,myThid)),QA(J,NL1(J)))
       ENDIF
C
        IF (DMSE.GE.0.0) THEN
C
C ***************************************************
C ***************************************************
C chdbg
C         if(J.ge.6336 .and. J.eq.6348) then
C            xindconv=xindconv+1./13.
C         endif
C         if(J.ge.4160 .and. J.eq.4172) then
C            xindconv1=xindconv1+1./13.
C         endif
C         if(npas.eq.960 .and. J.eq.1) then
C           write(0,*) 'xindconv=',xindconv
C           write(0,*) 'xindconv1=',xindconv1
C         endif
Cchdbg
C ****************************************************
C ****************************************************
C
C         2.1 Shallow convection
C
          IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
           TTENVD(J,NLEVxy(J,myThid)) = RTST(J)*DMSE 
           TTENVD(J,NL1(J))  = RNL1(J)*TTENVD(J,NLEVxy(J,myThid))
           QTENVD(J,NLEVxy(J,myThid)) = RTSQ*(QA(J,NLEVxy(J,myThid))-QEQL)
           QTENVD(J,NL1(J))  = RNL1(J)*QTENVD(J,NLEVxy(J,myThid))
          ENDIF
C
        ELSE
C
C         2.2 Vertical diffusion of moisture

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