| 1 |
adcroft |
1.2 |
C $Header: /u/gcmpack/models/MITgcmUV/pkg/aim/Attic/phy_vdifsc.F,v 1.1.2.2 2001/01/26 17:54:25 adcroft Exp $ |
| 2 |
|
|
C $Name: branch-atmos-merge-freeze $ |
| 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 |
Parent Directory
| 
Revision Log
| 
Revision Graph