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

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

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


Revision 1.4 - (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.3: +36 -23 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_driver.F,v 1.3 2001/05/29 19:28:53 cnh Exp $
2 C $Name: $
3
4 #include "AIM_OPTIONS.h"
5
6 SUBROUTINE PDRIVER (TYEAR, myThid)
7 C--
8 C-- SUBROUTINE PDRIVER (TYEAR)
9 C--
10 C-- Purpose: stand-alone driver for physical parametrization routines
11 C-- Input : TYEAR : fraction of year (0 = 1jan.00, 1 = 31dec.24)
12 C-- grid-point model fields in common block: PHYGR1
13 C-- forcing fields in common blocks : LSMASK, FORFIX, FORCIN
14 C-- Output : Diagnosed upper-air variables in common block: PHYGR2
15 C-- Diagnosed surface variables in common block: PHYGR3
16 C-- Physical param. tendencies in common block: PHYTEN
17 C-- Surface and upper boundary fluxes in common block: FLUXES
18 C--
19
20 IMPLICIT NONE
21
22 C Resolution parameters
23
24 C-- size for MITgcm & Physics package :
25 #include "AIM_SIZE.h"
26
27 #include "EEPARAMS.h"
28
29 #include "AIM_GRID.h"
30
31 C Constants + functions of sigma and latitude
32 C
33 #include "com_physcon.h"
34 C
35 C Model variables, tendencies and fluxes on gaussian grid
36 C
37 #include "com_physvar.h"
38 C
39 C Surface forcing fields (time-inv. or functions of seasonal cycle)
40 C
41 #include "com_forcing1.h"
42 #include "com_forcon.h"
43 #include "com_sflcon.h"
44
45 C-- Routine arguments:
46 _RL TYEAR
47 INTEGER myThid
48
49 #ifdef ALLOW_AIM
50
51 C-- Local variables:
52 INTEGER IDEPTH(NGP)
53 _RL RPS(NGP), ALB1(NGP), FSOL1(NGP), OZONE1(NGP)
54
55 _RL TAURAD(NGP,NLEV), ST4ARAD(NGP,NLEV,2)
56 CcnhDebugStarts
57 c REAL AUX(NGP)
58 _RL Phymask(NGP,NLEV)
59 c real xminim
60 _RL UT_VDI(NGP,NLEV), VT_VDI(NGP,NLEV), TT_VDI(NGP,NLEV)
61 _RL QT_VDI(NGP,NLEV)
62 CcnhDebugEnds
63 INTEGER J, K
64
65 C- jmc: declare all local variables:
66 _RL DALB, RSD
67 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
68
69 C-- 1. Compute surface variables
70
71 C 1.1 Surface pressure (ps), 1/ps and surface temperature
72 C
73 DO J=1,NGP
74 PSG(J,myThid)=EXP(PSLG1(J,myThid))
75 RPS(J)=1./PSG(J,myThid)
76 TS(J,myThid) =SST1(J,myThid)+
77 & FMASK1(J,myThid)*(STL1(J,myThid)-SST1(J,myThid))
78 ENDDO
79
80 C 1.2 Surface albedo:
81 C defined as a weighed average of land and ocean albedos, where
82 C land albedo depends linearly on snow depth (up to the SDALB
83 C threshold) and sea albedo depends linearly on sea-ice fraction.
84 C
85 DALB=ALBICE-ALBSEA
86 RSD=1./SDALB
87 C
88 CmoltBegin
89 DO J=1,NGP
90 ALB1(J)=ALB0(J,myThid)
91 ENDDO
92 CmoltEnd
93
94 C-- 2. Compute thermodynamic variables
95
96 C 2.1 Dry static energy
97
98 DO K=1,NLEV
99 DO J=1,NGP
100 SE(J,K,myThid)=CP*TG1(J,K,myThid)+PHIG1(J,K,myThid)
101 ENDDO
102 ENDDO
103 C
104 C 2.2 Relative humidity and saturation spec. humidity
105 C
106 DO K=1,NLEV
107 CALL SHTORH (1,NGP,TG1(1,K,myThid),PSG(1,myThid),
108 & SIG(K),QG1(1,K,myThid),
109 * RH(1,K,myThid),QSAT(1,K,myThid),
110 I myThid)
111 ENDDO
112 C
113 DO K=1,NLEV
114 DO J=1,NGP
115 phymask(J,K)=0.
116 IF (Tg1(J,K,myThid).ne.0.) THEN
117 phymask(J,K)=1.
118 ENDIF
119 QSAT(J,K,myThid)=QSAT(J,K,myThid)*Phymask(J,K)
120 QG1(J,K,myThid)=QG1(J,K,myThid)*Phymask(J,K)
121 RH(J,K,myThid)=RH(J,K,myThid)*Phymask(J,K)
122 ENDDO
123 ENDDO
124 cdbgch
125 C
126 C-- 3. Precipitation
127
128 C 3.1 Deep convection
129 C
130 cch CALL CONVMF (PSG,SE,QG1,QSAT,
131 CALL CONVMF (PSG(1,myThid),TG1(1,1,myThid),
132 & QG1(1,1,myThid),QSAT(1,1,myThid),
133 * IDEPTH,CBMF(1,myThid),PRECNV(1,myThid),
134 & TT_CNV(1,1,myThid),QT_CNV(1,1,myThid),
135 I myThid)
136
137 C
138 DO K=2,NLEV
139 DO J=1,NGP
140 TT_CNV(J,K,myThid)=TT_CNV(J,K,myThid)*RPS(J)*GRDSCP(K)
141 QT_CNV(J,K,myThid)=QT_CNV(J,K,myThid)*RPS(J)*GRDSIG(K)
142 ENDDO
143 ENDDO
144
145 C 3.2 Large-scale condensation
146
147 CALL LSCOND (PSG(1,myThid),QG1(1,1,myThid),QSAT(1,1,myThid),
148 * PRECLS(1,myThid),TT_LSC(1,1,myThid),
149 & QT_LSC(1,1,myThid),
150 I myThid)
151
152 C
153 C-- 4. Radiation (shortwave and longwave)
154
155 C 4.1 Compute climatological forcing
156
157 CALL SOL_OZ (SOLC,TYEAR,FSOL1,OZONE1,
158 I myThid)
159
160 C 4.2 Compute shortwave tendencies and initialize lw transmissivity
161 C (The sw radiation may be called at selected time steps)
162
163 CALL RADSW (PSG(1,myThid),QG1(1,1,myThid),RH(1,1,myThid),
164 * FSOL1,OZONE1,ALB1,TAURAD,
165 * CLOUDC(1,myThid),TSR(1,myThid),SSR(1,myThid),
166 & TT_RSW(1,1,myThid),
167 I myThid)
168
169 C 4.3 Compute longwave fluxes
170
171 CALL RADLW (1,TG1(1,1,myThid),TS(1,myThid),ST4S(1,myThid),
172 & TAURAD, ST4ARAD,
173 * OLR(1,myThid),SLR(1,myThid),TT_RLW(1,1,myThid),
174 & SLR_DOWN(1,myThid),
175 I myThid)
176
177 DO K=1,NLEV
178 DO J=1,NGP
179 TT_RSW(J,K,myThid)=TT_RSW(J,K,myThid)*RPS(J)*GRDSCP(K)
180 TT_RLW(J,K,myThid)=TT_RLW(J,K,myThid)*RPS(J)*GRDSCP(K)
181 ENDDO
182 ENDDO
183
184 C
185 C-- 5. PBL interactions with lower troposphere and surface
186
187 C 5.1. Surface fluxes (from climatological surface temperature)
188
189 cch Attention the pressure used is a the last T level and
190 Cch not at the last W level
191 C --------------------------------
192 CALL SUFLUX (PNLEVW(1,myThid),
193 & UG1(1,1,myThid),VG1(1,1,myThid),
194 & TG1(1,1,myThid),QG1(1,1,myThid),
195 & RH(1,1,myThid),QSAT(1,1,myThid),
196 & VsurfSq(1,myThid),PHIG1(1,1,myThid),
197 & PHI0(1,myThid),FMASK1(1,myThid),
198 & STL1(1,myThid),SST1(1,myThid),SOILQ1(1,myThid),
199 & SSR(1,myThid),SLR(1,myThid),
200 & DRAG(1,myThid),
201 & USTR(1,1,myThid),VSTR(1,1,myThid),SHF(1,1,myThid),
202 & EVAP(1,1,myThid),T0(1,1,myThid),Q0(1,myThid),
203 & QSAT0(1,1,myThid),SPEED0(1,myThid),
204 I myThid)
205
206 C
207 C remove when vdifsc is implemented
208 DO K=1,NLEV
209 DO J=1,NGP
210 UT_PBL(J,K,myThid)=0.
211 VT_PBL(J,K,myThid)=0.
212 TT_PBL(J,K,myThid)=0.
213 QT_PBL(J,K,myThid)=0.
214 ENDDO
215 ENDDO
216 c
217 C
218 c
219 C 5.3 Add surface fluxes and convert fluxes to tendencies
220
221 DO J=1,NGP
222 IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
223 UT_PBL(J,NLEVxy(J,myThid),myThid)=
224 & UT_PBL(J,NLEVxy(J,myThid),myThid)+ USTR(J,3,myThid)
225 VT_PBL(J,NLEVxy(J,myThid),myThid)=
226 & VT_PBL(J,NLEVxy(J,myThid),myThid)+ VSTR(J,3,myThid)
227 TT_PBL(J,NLEVxy(J,myThid),myThid)=
228 & TT_PBL(J,NLEVxy(J,myThid),myThid)+ SHF(J,3,myThid)
229 QT_PBL(J,NLEVxy(J,myThid),myThid)=
230 & QT_PBL(J,NLEVxy(J,myThid),myThid)+ EVAP(J,3,myThid)
231 ENDIF
232 ENDDO
233 C
234 Cdbgch
235 DO J=1,NGP
236 IF ( NLEVxy(J,myThid) .GT. 0 ) THEN
237 DO K=NLEVxy(J,myThid)-1,NLEVxy(J,myThid)
238 UT_PBL(J,K,myThid)=UT_PBL(J,K,myThid)*GRDSIG(K)
239 VT_PBL(J,K,myThid)=VT_PBL(J,K,myThid)*GRDSIG(K)
240 TT_PBL(J,K,myThid)=TT_PBL(J,K,myThid)*GRDSCP(K)
241 QT_PBL(J,K,myThid)=QT_PBL(J,K,myThid)*GRDSIG(K)
242 ENDDO
243 ENDIF
244 ENDDO
245 C
246 C 5.2 Vertical diffusion and shallow convection (not yet implemented)
247 C
248 CALL VDIFSC (UG1(1,1,myThid),VG1(1,1,myThid),
249 & TG1(1,1,myThid),RH(1,1,myThid),
250 & QG1(1,1,myThid), QSAT(1,1,myThid),
251 * UT_VDI,VT_VDI,TT_VDI,QT_VDI,
252 I myThid)
253 C
254 DO K=1,NLEV
255 DO J=1,NGP
256 UT_PBL(J,K,myThid)=UT_PBL(J,K,myThid)+ UT_VDI(J,K)
257 VT_PBL(J,K,myThid)=VT_PBL(J,K,myThid)+ VT_VDI(J,K)
258 TT_PBL(J,K,myThid)=TT_PBL(J,K,myThid)+ TT_VDI(J,K)
259 QT_PBL(J,K,myThid)=QT_PBL(J,K,myThid)+ QT_VDI(J,K)
260 ENDDO
261 ENDDO
262 C
263
264 CdbgC--
265
266 #endif /* ALLOW_AIM */
267
268 RETURN
269 END

  ViewVC Help
Powered by ViewVC 1.1.22