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

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

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


Revision 1.6 - (show annotations) (download)
Fri Sep 27 20:05:11 2002 UTC (21 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint48f_post, checkpoint51k_post, checkpoint53f_post, checkpoint47j_post, checkpoint54a_pre, checkpoint55c_post, checkpoint53b_pre, checkpoint48d_pre, checkpoint51l_post, checkpoint51j_post, branch-exfmods-tag, checkpoint47e_post, checkpoint57m_post, checkpoint52l_pre, checkpoint48i_post, checkpoint52e_pre, hrcube4, hrcube5, checkpoint57g_pre, checkpoint52j_post, checkpoint47f_post, checkpoint48d_post, checkpoint51o_pre, checkpoint57f_post, checkpoint46j_post, checkpoint47c_post, checkpoint50e_post, checkpoint52e_post, checkpoint50c_post, checkpoint46i_post, checkpoint51n_pre, checkpoint47d_post, checkpoint57j_post, checkpoint47a_post, checkpoint57b_post, checkpoint52d_pre, checkpoint53c_post, checkpoint53d_post, checkpoint57f_pre, checkpoint48a_post, checkpoint55d_pre, checkpoint51f_pre, checkpoint57g_post, checkpoint48e_post, checkpoint57c_pre, checkpoint48h_post, checkpoint55j_post, checkpoint56b_post, checkpoint50c_pre, checkpoint57h_pre, branchpoint-genmake2, checkpoint46k_post, checkpoint52j_pre, checkpoint54a_post, branch-netcdf, checkpoint50d_pre, checkpoint55h_post, checkpoint51r_post, checkpoint47i_post, checkpoint52b_pre, checkpoint52n_post, checkpoint54b_post, checkpoint46l_pre, checkpoint46j_pre, checkpoint51i_post, checkpoint57e_post, checkpoint54d_post, checkpoint47h_post, checkpoint48c_post, checkpoint46l_post, checkpoint56c_post, checkpoint54e_post, checkpoint55b_post, checkpoint51e_post, checkpoint51b_post, checkpoint51l_pre, checkpoint52m_post, checkpoint51c_post, checkpoint55, checkpoint53a_post, checkpoint55a_post, checkpoint57a_post, checkpoint48, checkpoint49, checkpoint47b_post, checkpoint56, checkpoint57o_post, checkpoint55g_post, checkpoint57h_done, checkpoint51o_post, checkpoint48g_post, checkpoint57k_post, checkpoint57d_post, checkpoint55f_post, checkpoint57i_post, checkpoint51q_post, checkpoint52l_post, checkpoint52k_post, checkpoint57h_post, checkpoint57a_pre, checkpoint54, checkpoint57, checkpoint53b_post, checkpoint51, checkpoint50, checkpoint53, checkpoint52, checkpoint50d_post, checkpoint52d_post, checkpoint51b_pre, checkpoint52a_post, checkpoint47g_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, checkpoint57n_post, checkpoint52c_post, checkpoint46m_post, checkpoint57p_post, checkpoint51h_pre, checkpoint50g_post, checkpoint50b_pre, checkpoint51g_post, ecco_c52_e35, checkpoint54f_post, checkpoint51f_post, checkpoint48b_post, checkpoint50b_post, eckpoint57e_pre, checkpoint57c_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint52a_pre, checkpoint47d_pre, checkpoint51d_post, checkpoint48c_pre, checkpoint51m_post, checkpoint51t_post, checkpoint53d_pre, checkpoint47, checkpoint55e_post, checkpoint54c_post, checkpoint50h_post, checkpoint52i_post, checkpoint51a_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51p_post, checkpoint51n_post, checkpoint55i_post, checkpoint51i_pre, checkpoint57l_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint56a_post, checkpoint51s_post, checkpoint55d_post
Branch point for: netcdf-sm0, branch-genmake2, branch-nonh, tg2-branch, checkpoint51n_branch, branch-exfmods-curt
Changes since 1.5: +52 -37 lines
Clean up AIM package (and keep the results unchanged):
a) include CPP_OPTION and use IMPLICT NONE in all routines ;
  declare all the variables _RL ;
b) use _d 0 for all numerical constants in Physics package,
  so that the code works with g77 (and give the right answer)
c) use ifdef ALLOW_AIM everywhere so that the package can be
 compiled without increasing the memory size.
d) clean-up the AIM interface (remove commented lines, unused
  variables ...)

1 C $Header: /u/gcmpack/MITgcm/pkg/aim/phy_vdifsc.F,v 1.5 2001/09/06 13:28:01 adcroft Exp $
2 C $Name: $
3
4 #include "AIM_OPTIONS.h"
5
6 cch SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
7 SUBROUTINE VDIFSC (UA,VA,Ta,RH,QA,QSAT,
8 & UTENVD,VTENVD,TTENVD,QTENVD,
9 & myThid)
10 C-
11 C-- SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,
12 C-- & UTENVD,VTENVD,TTENVD,QTENVD)
13 C-
14 C-- Purpose: Compute tendencies of momentum, energy and moisture
15 C-- due to vertical diffusion and shallow convection
16 C-- Input: UA = u-wind (3-dim)
17 C-- VA = v-wind (3-dim)
18 C-- SE = dry static energy (3-dim)
19 C-- RH = relative humidity [0-1] (3-dim)
20 C-- QA = specific humidity [g/kg] (3-dim)
21 C-- QSAT = saturation sp. humidity [g/kg] (3-dim)
22 C-- Output: UTENVD = u-wind tendency (3-dim)
23 C-- VTENVD = v-wind tendency (3-dim)
24 C-- TTENVD = temperature tendency (3-dim)
25 C-- QTENVD = sp. humidity tendency [g/(kg s)] (3-dim)
26 C-
27
28 IMPLICIT NONE
29
30 C Resolution parameters
31
32 C-- size for MITgcm & Physics package :
33 #include "AIM_SIZE.h"
34
35 #include "EEPARAMS.h"
36
37 #include "AIM_GRID.h"
38
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
47 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)
52 C
53 _RL UTENVD(NGP,NLEV), VTENVD(NGP,NLEV),
54 & TTENVD(NGP,NLEV), QTENVD(NGP,NLEV)
55
56 #ifdef ALLOW_AIM
57
58 C-- Local variables:
59 INTEGER NL1(NGP)
60 _RL RTST(NGP)
61 _RL RNL1(NGP)
62 C
63 _RL Th(NGP,NLEV)
64 _RL dThdp
65 _RL stab(NGP)
66 c REAL AUX(NGP)
67 _RL Prefw(NLEV), Prefs(NLEV)
68 DATA Prefs / 75., 250., 500., 775., 950./
69 DATA Prefw / 0., 150., 350., 650., 900./
70 _RL Pground
71 DATA pground /1000./
72 Cchdbg
73 c REAL xindconv1
74 c SAVE xindconv1
75 c REAL xindconv
76 c SAVE xindconv
77 c INTEGER npas
78 c SAVE npas
79 c LOGICAL ifirst
80 c DATA ifirst /.TRUE./
81 c SAVE ifirst
82 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
89 C
90 DO K=1,NLEV
91 DO J=1,NGP
92 UTENVD(J,K) = 0.
93 VTENVD(J,K) = 0.
94 TTENVD(J,K) = 0.
95 QTENVD(J,K) = 0.
96 ENDDO
97 ENDDO
98
99 c
100 C
101 C *****************************************
102 C *****************************************
103 Cchdbg
104 C if(ifirst) then
105 C xindconv=0.
106 C xindconv1=0.
107 C npas=0
108 C ifirst=.FALSE.
109 C endif
110 C npas = npas +1
111 Cchdbg
112 C ******************************************
113 C *****************************************
114 C
115 C-- 2. Vertical diffusion and shallow convection
116 C
117 DO J=1,NGP
118 NL1(J)=NLEVxy(J,myThid)-1
119 ENDDO
120 C
121 RTVD = -1./(3600.*TRVDI)
122 RTSQ = -1./(3600.*TRSHC)
123 C
124 DO J=1,NGP
125 IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
126 RTST(J) = RTSQ*DSIG(NL1(J))
127 & /((DSIG(NLEVxy(J,myThid))+DSIG(NL1(J)))*CP)
128 RNL1(J) = -DSIG(NLEVxy(J,myThid))/DSIG(NL1(J))
129 ENDIF
130 ENDDO
131
132 C
133 C
134 C New writing of the Conditional stability
135 C ----------------------------------------
136 DO J=1,NGP
137 IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
138 DO k=NL1(J),NLEVxy(J,myThid)
139 Th(J,K)=Ta(J,K)*(Pground/Prefs(k))**(RD/CP)
140 ENDDO
141 ENDIF
142 ENDDO
143 C
144 DO J=1,NGP
145 stab(J)=0.
146 IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
147 dThdp=(Th(J,NL1(J))-Th(J,NLEVxy(J,myThid)))
148 & *((Prefw(NLEVxy(J,myThid))/Pground)**(RD/CP))*CP
149 stab(J)=dThdp+ALHC*(QSAT(J,NL1(J))-QSAT(J,NLEVxy(J,myThid)))
150 ENDIF
151 ENDDO
152 121 continue
153 C
154 DO J=1,NGP
155 C
156 cch DMSE = (SE(J,NLEVxy(J,myThid))-SE(J,NL1(J)))+
157 cch & ALHC*(QA(J,NLEVxy(J,myThid))-QSAT(J,NL1(J)))
158 DMSE = - stab(J)
159 IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
160 QEQL = MIN( QA(J,NLEVxy(J,myThid)),
161 & RH(J,NL1(J))*QSAT(J,NLEVxy(J,myThid)) )
162 cchdbg QEQL = MIN(QA(J,NLEVxy(J,myThid)),QA(J,NL1(J)))
163 ENDIF
164 C
165 IF (DMSE.GE.0.0) THEN
166 C
167 C ***************************************************
168 C ***************************************************
169 C chdbg
170 C if(J.ge.6336 .and. J.eq.6348) then
171 C xindconv=xindconv+1./13.
172 C endif
173 C if(J.ge.4160 .and. J.eq.4172) then
174 C xindconv1=xindconv1+1./13.
175 C endif
176 C if(npas.eq.960 .and. J.eq.1) then
177 C write(0,*) 'xindconv=',xindconv
178 C write(0,*) 'xindconv1=',xindconv1
179 C endif
180 Cchdbg
181 C ****************************************************
182 C ****************************************************
183 C
184 C 2.1 Shallow convection
185 C
186 IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
187 TTENVD(J,NLEVxy(J,myThid)) = RTST(J)*DMSE
188 TTENVD(J,NL1(J)) = RNL1(J)*TTENVD(J,NLEVxy(J,myThid))
189 QTENVD(J,NLEVxy(J,myThid)) =
190 & RTSQ*(QA(J,NLEVxy(J,myThid))-QEQL)
191 QTENVD(J,NL1(J)) = RNL1(J)*QTENVD(J,NLEVxy(J,myThid))
192 ENDIF
193 C
194 ELSE
195 C
196 C 2.2 Vertical diffusion of moisture
197
198 QTENVD(J,NLEVxy(J,myThid)) =
199 & RTVD*(QA(J,NLEVxy(J,myThid))-QEQL)
200 QTENVD(J,NL1(J)) = RNL1(J)*QTENVD(J,NLEVxy(J,myThid))
201 C
202 ENDIF
203 C
204 ENDDO
205 C
206 #endif /* ALLOW_AIM */
207
208 RETURN
209 END

  ViewVC Help
Powered by ViewVC 1.1.22