/[MITgcm]/MITgcm/verification/fizhi-gridalt-hs/code/do_fizhi.F
ViewVC logotype

Contents of /MITgcm/verification/fizhi-gridalt-hs/code/do_fizhi.F

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


Revision 1.9 - (show annotations) (download)
Tue Mar 27 15:49:37 2012 UTC (8 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.8: +112 -111 lines
clean-up turbulence cold-start switch: decided in fizhi_init_vars.F, stored
in common bloc (fizhi_coms.h) and then passed as argument up to S/R TURBIO

1 C $Header: /u/gcmpack/MITgcm/verification/fizhi-gridalt-hs/code/do_fizhi.F,v 1.8 2004/10/26 17:47:12 molod Exp $
2 C $Name: $
3 #include "FIZHI_OPTIONS.h"
4 SUBROUTINE DO_FIZHI(myIter,myid,
5 & idim1,idim2,jdim1,jdim2,Nrphin,nSxin,nSyin,im1,im2,jm1,jm2,bi,bj,
6 & turbStart, nchp,nchptot,nchpland,
7 & uphy,vphy,thphy,sphy,pephy,lons,lats,Zsurf,
8 & ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
9 & tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
10 & albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlat,chlon,
11 & tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,
12 & o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,
13 & iras,nlwcld,cldtotlwin,cldraslwin,cldlsplwin,nlwlz,lwlzin,
14 & nswcld,cldtotswin,cldrasswin,cldlspswin,nswlz,swlzin,imstturbsw,
15 & imstturblw,qliqaveswin,qliqavelwin,fccaveswin,fccavelwin,
16 & rainconin,rainlspin,snowfallin,
17 & duphy,dvphy,dthphy,dsphy)
18 c-----------------------------------------------------------------------
19 c Interface routine to calculate physics increments - calls fizhi_driver.
20 c Purpose of this routine is to set up arrays local to fizhi and 'save'
21 c them from one iteration to the next, and act as interface between the
22 c model common blocks (held in fizhi_wrapper) and fizhi_driver.
23 c Copies of variables that are 'shadowed' are made here without shadows
24 c for passing to fizhi_driver.
25 c Note: routine is called from inside a bi-bj loop
26 c
27 c-----------------------------------------------------------------------
28 IMPLICIT NONE
29 #include "SIZE.h"
30 #include "fizhi_SIZE.h"
31 #include "chronos.h"
32
33 C Argument list declarations
34 INTEGER myIter,myid,im1,im2,jm1,jm2,idim1,idim2,jdim1,jdim2
35 INTEGER Nrphin,nSxin,nSyin,bi,bj,nchp
36 LOGICAL turbStart
37 INTEGER nchptot(nSxin,nSyin),nchpland(nSxin,nSyin)
38 _RL uphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
39 _RL vphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
40 _RL thphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
41 _RL sphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
42 _RL pephy(idim1:idim2,jdim1:jdim2,Nrphin+1,nSxin,nSyin)
43 _RS lons(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
44 _RS lats(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
45 _RS Zsurf(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
46 _RL ctmt(nchp,nSxin,nSyin),xxmt(nchp,nSxin,nSyin)
47 _RL yymt(nchp,nSxin,nSyin)
48 _RL zetamt(nchp,nSxin,nSyin)
49 _RL xlmt(nchp,Nrphin,nSxin,nSyin),khmt(nchp,Nrphin,nSxin,nSyin)
50 _RL tke(nchp,Nrphin,nSxin,nSyin)
51 _RL tgz(im2,jm2,nSxin,nSyin)
52 _RL sst(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
53 _RL sice(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
54 _RL phis_var(im2,jm2,nSxin,nSyin)
55 INTEGER landtype(im2,jm2,nSxin,nSyin)
56 _RL fracland(im2,jm2,nSxin,nSyin),emiss(im2,jm2,10,nSxin,nSyin)
57 _RL albvisdr(im2,jm2,nSxin,nSyin),albvisdf(im2,jm2,nSxin,nSyin)
58 _RL albnirdr(im2,jm2,nSxin,nSyin),albnirdf(im2,jm2,nSxin,nSyin)
59 _RL chfr(nchp,nSxin,nSyin),alai(nchp,nSxin,nSyin)
60 _RL agrn(nchp,nSxin,nSyin)
61 INTEGER ityp(nchp,nSxin,nSyin),igrd(nchp,nSxin,nSyin)
62 _RL chlat(nchp,nSxin,nSyin),chlon(nchp,nSxin,nSyin)
63 _RL tcanopy(nchp,nSxin,nSyin),tdeep(nchp,nSxin,nSyin)
64 _RL ecanopy(nchp,nSxin,nSyin),swetshal(nchp,nSxin,nSyin)
65 _RL swetroot(nchp,nSxin,nSyin),swetdeep(nchp,nSxin,nSyin)
66 _RL snodep(nchp,nSxin,nSyin),capac(nchp,nSxin,nSyin)
67 _RL o3(im2,jm2,Nrphin,nSxin,nSyin)
68 _RL qstr(im2,jm2,Nrphin,nSxin,nSyin)
69 _RL co2,cfc11,cfc12,cfc22,n2o(Nrphin),methane(Nrphin)
70
71 INTEGER iras(nSxin,nSyin)
72 INTEGER nlwcld(nSxin,nSyin),nlwlz(nSxin,nSyin)
73 INTEGER nswcld(nSxin,nSyin),nswlz(nSxin,nSyin)
74 INTEGER imstturbsw(nSxin,nSyin),imstturblw(nSxin,nSyin)
75 _RL cldtotlwin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
76 _RL cldraslwin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
77 _RL cldlsplwin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
78 _RL lwlzin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
79 _RL cldtotswin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
80 _RL cldrasswin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
81 _RL cldlspswin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
82 _RL swlzin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
83 _RL qliqaveswin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
84 _RL qliqavelwin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
85 _RL fccaveswin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
86 _RL fccavelwin(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
87 _RL rainlspin(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
88 _RL rainconin(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
89 _RL snowfallin(idim1:idim2,jdim1:jdim2,nSxin,nSyin)
90
91
92 _RL duphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
93 _RL dvphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
94 _RL dthphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
95 _RL dsphy(idim1:idim2,jdim1:jdim2,Nrphin,nSxin,nSyin)
96
97
98 c Local Variables
99 INTEGER ptracer,ntracer
100 PARAMETER (ptracer = 1)
101 PARAMETER (ntracer = 1)
102
103 _RL xlats(sNx,sNy),xlons(sNx,sNy),sea_ice(sNx,sNy)
104 _RL p(sNx,sNy,nSx,nSy)
105 _RL u(sNx,sNy,Nrphys),v(sNx,sNy,Nrphys),t(sNx,sNy,Nrphys)
106 _RL q(sNx,sNy,Nrphys,ntracer)
107 _RL pl(sNx,sNy,Nrphys,nSx,nSy),pkl(sNx,sNy,Nrphys,nSx,nSy)
108 _RL ple(sNx,sNy,Nrphys+1,nSx,nSy)
109 _RL pkle(sNx,sNy,Nrphys+1,nSx,nSy)
110 _RL dpres(sNx,sNy,Nrphys,nSx,nSy)
111 _RL lwdt(sNx,sNy,Nrphys,nSx,nSy)
112 _RL lwdtclr(sNx,sNy,Nrphys,nSx,nSy)
113 _RL swdt(sNx,sNy,Nrphys,nSx,nSy)
114 _RL swdtclr(sNx,sNy,Nrphys,nSx,nSy)
115 _RL turbu(sNx,sNy,Nrphys,nSx,nSy)
116 _RL turbv(sNx,sNy,Nrphys,nSx,nSy)
117 _RL turbt(sNx,sNy,Nrphys,nSx,nSy)
118 _RL turbq(sNx,sNy,Nrphys,ntracer,nSx,nSy)
119 _RL moistu(sNx,sNy,Nrphys,nSx,nSy)
120 _RL moistv(sNx,sNy,Nrphys,nSx,nSy)
121 _RL moistt(sNx,sNy,Nrphys,nSx,nSy)
122 _RL moistq(sNx,sNy,Nrphys,ntracer,nSx,nSy)
123 _RL radswt(sNx,sNy,nSx,nSy),radswg(sNx,sNy,nSx,nSy)
124 _RL swgclr(sNx,sNy,nSx,nSy)
125 _RL fdirpar(sNx,sNy,nSx,nSy),fdifpar(sNx,sNy,nSx,nSy)
126 _RL osr(sNx,sNy,nSx,nSy),osrclr(sNx,sNy,nSx,nSy)
127 _RL tg0(sNx,sNy,nSx,nSy),radlwg(sNx,sNy,nSx,nSy)
128 _RL lwgclr(sNx,sNy,nSx,nSy),st4(sNx,sNy,nSx,nSy)
129 _RL dst4(sNx,sNy,nSx,nSy),dlwdtg(sNx,sNy,Nrphys,nSx,nSy)
130 _RL qq(sNx,sNy,Nrphys,nSx,nSy)
131 INTEGER i,j,L
132 _RL getcon, kappa, p0kappa, s0, ra
133 _RL cosz(sNx,sNy)
134 _RL cldtot_lw(sNx,sNy,Nrphys)
135 _RL cldras_lw(sNx,sNy,Nrphys)
136 _RL cldlsp_lw(sNx,sNy,Nrphys)
137 _RL lwlz(sNx,sNy,Nrphys)
138 _RL cldtot_sw(sNx,sNy,Nrphys)
139 _RL cldras_sw(sNx,sNy,Nrphys)
140 _RL cldlsp_sw(sNx,sNy,Nrphys)
141 _RL swlz(sNx,sNy,Nrphys)
142 _RL qliqavesw(sNx,sNy,Nrphys)
143 _RL qliqavelw(sNx,sNy,Nrphys)
144 _RL fccavesw(sNx,sNy,Nrphys)
145 _RL fccavelw(sNx,sNy,Nrphys)
146 _RL rainlsp(sNx,sNy)
147 _RL raincon(sNx,sNy)
148 _RL snowfall(sNx,sNy)
149
150 _RL tempij(sNx,sNy)
151 _RL tempi(2)
152
153 _RL kF,sigma_b,ks,ka,deg2rad,pi,atm_po,atm_kappa,termp,kv,kT
154 _RL term1,term2,thetalim,thetaeq,recip_p0g
155
156 LOGICAL alarm
157 EXTERNAL alarm
158
159 C***********************************************************************
160
161 kF=1. _d 0/86400. _d 0
162 sigma_b = 0.7 _d 0
163 ka=1. _d 0/(40. _d 0*86400. _d 0)
164 ks=1. _d 0/(4. _d 0 *86400. _d 0)
165 pi = getcon('PI')
166 atm_kappa = getcon('KAPPA')
167 atm_po = getcon('ATMPOPA')
168 deg2rad = getcon('DEG2RAD')
169
170 do L = 1,Nrphys
171 do j = jm1,jm2
172 do i = im1,im2
173 recip_P0g= 1. _d 0 / pephy(i,j,Nrphys+1,bi,bj)
174 c U and V terms:
175 termP=0.5 _d 0*((pephy(i,j,L,bi,bj)+pephy(i,j,L+1,bi,bj))
176 & *recip_P0g )
177 kV=kF*MAX( 0. _d 0, (termP-sigma_b)/(1. _d 0-sigma_b) )
178 duphy(i,j,L,bi,bj)= -kV*uphy(i,j,L,bi,bj)
179 dvphy(i,j,L,bi,bj)= -kV*vphy(i,j,L,bi,bj)
180
181 c T terms
182 C-- Forcing term(s)
183 term1=60. _d 0*(sin(lats(I,J,bi,bj)*deg2rad)**2)
184 termP=0.5 _d 0*( pephy(i,j,L,bi,bj) + pephy(i,j,L+1,bi,bj) )
185 term2=10. _d 0*log(termP/atm_po)
186 & *(cos(lats(I,J,bi,bj)*deg2rad)**2)
187 thetaLim = 200. _d 0/ ((termP/atm_po)**atm_kappa)
188 thetaEq=315. _d 0-term1-term2
189 thetaEq=MAX(thetaLim,thetaEq)
190 kT=ka+(ks-ka)
191 & *MAX(0. _d 0,
192 & (termP*recip_P0g-sigma_b)/(1. _d 0-sigma_b) )
193 & *COS((lats(I,J,bi,bj)*deg2rad))**4
194 if(termP*recip_P0g.gt.0.04)then
195 dthphy(i,j,L,bi,bj)=- kT*( thphy(I,J,L,bi,bj)-thetaEq )
196 else
197 dthphy(i,j,L,bi,bj)=0.
198 endif
199
200 c S terms (hs runs dry - no moisture)
201 C-- Forcing term(s)
202 dsphy(i,j,L,bi,bj)=0.
203
204 enddo
205 enddo
206 enddo
207
208 return
209 end

  ViewVC Help
Powered by ViewVC 1.1.22