1 |
module calfis_m |
module calfis_m |
2 |
|
|
|
! Clean: no C preprocessor directive, no include line |
|
|
|
|
3 |
IMPLICIT NONE |
IMPLICIT NONE |
4 |
|
|
5 |
contains |
contains |
6 |
|
|
7 |
SUBROUTINE calfis(lafin, rdayvrai, heure, pucov, pvcov, pteta, q, & |
SUBROUTINE calfis(rdayvrai, heure, pucov, pvcov, pteta, q, & |
8 |
pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, & |
pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, & |
9 |
pdufi, pdvfi, pdhfi, pdqfi, pdpsfi) |
pdufi, pdvfi, pdhfi, pdqfi, pdpsfi, lafin) |
|
|
|
|
! From dyn3d/calfis.F, v 1.3 2005/05/25 13:10:09 |
|
10 |
|
|
11 |
! Auteurs : P. Le Van, F. Hourdin |
! From dyn3d/calfis.F, version 1.3 2005/05/25 13:10:09 |
12 |
|
! Authors : P. Le Van, F. Hourdin |
13 |
|
|
14 |
! 1. rearrangement des tableaux et transformation |
! 1. rearrangement des tableaux et transformation |
15 |
! variables dynamiques > variables physiques |
! variables dynamiques > variables physiques |
49 |
! pdtrad radiative tendencies \ both input |
! pdtrad radiative tendencies \ both input |
50 |
! pfluxrad radiative fluxes / and output |
! pfluxrad radiative fluxes / and output |
51 |
|
|
52 |
use dimens_m, only: iim, jjm, llm, nqmx |
use comconst, only: kappa, cpp, dtphys, g |
|
use dimphy, only: klon |
|
|
use comconst, only: kappa, cpp, dtphys, g, pi |
|
53 |
use comvert, only: preff |
use comvert, only: preff |
54 |
use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv |
use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv |
55 |
use iniadvtrac_m, only: niadv |
use dimens_m, only: iim, jjm, llm, nqmx |
56 |
|
use dimphy, only: klon |
57 |
use grid_change, only: dyn_phy, gr_fi_dyn |
use grid_change, only: dyn_phy, gr_fi_dyn |
58 |
|
use iniadvtrac_m, only: niadv |
59 |
|
use nr_util, only: pi |
60 |
use physiq_m, only: physiq |
use physiq_m, only: physiq |
61 |
use pressure_var, only: p3d, pls |
use pressure_var, only: p3d, pls |
62 |
|
|
92 |
REAL pdqfi(iim + 1, jjm + 1, llm, nqmx) |
REAL pdqfi(iim + 1, jjm + 1, llm, nqmx) |
93 |
REAL pdpsfi(iim + 1, jjm + 1) |
REAL pdpsfi(iim + 1, jjm + 1) |
94 |
|
|
|
INTEGER, PARAMETER:: longcles = 20 |
|
|
|
|
95 |
! Local variables : |
! Local variables : |
96 |
|
|
97 |
INTEGER i, j, l, ig0, ig, iq, iiq |
INTEGER i, j, l, ig0, ig, iq, iiq |
99 |
REAL zplev(klon, llm+1), zplay(klon, llm) |
REAL zplev(klon, llm+1), zplay(klon, llm) |
100 |
REAL zphi(klon, llm), zphis(klon) |
REAL zphi(klon, llm), zphis(klon) |
101 |
|
|
102 |
REAL zufi(klon, llm), zvfi(klon, llm) |
REAL zufi(klon, llm), v(klon, llm) |
103 |
|
real zvfi(iim + 1, jjm + 1, llm) |
104 |
REAL ztfi(klon, llm) ! temperature |
REAL ztfi(klon, llm) ! temperature |
105 |
real qx(klon, llm, nqmx) ! mass fractions of advected fields |
real qx(klon, llm, nqmx) ! mass fractions of advected fields |
|
|
|
|
REAL pcvgu(klon, llm), pcvgv(klon, llm) |
|
|
REAL pcvgt(klon, llm), pcvgq(klon, llm, 2) |
|
|
|
|
106 |
REAL pvervel(klon, llm) |
REAL pvervel(klon, llm) |
107 |
|
|
108 |
REAL zdufi(klon, llm), zdvfi(klon, llm) |
REAL zdufi(klon, llm), zdvfi(klon, llm) |
109 |
REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx) |
REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx) |
110 |
REAL zdpsrf(klon) |
REAL zdpsrf(klon) |
111 |
|
|
112 |
REAL zsin(iim), zcos(iim), z1(iim) |
REAL z1(iim) |
|
REAL zsinbis(iim), zcosbis(iim), z1bis(iim) |
|
113 |
REAL pksurcp(iim + 1, jjm + 1) |
REAL pksurcp(iim + 1, jjm + 1) |
114 |
|
|
115 |
! I. Musat: diagnostic PVteta, Amip2 |
! I. Musat: diagnostic PVteta, Amip2 |
117 |
REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./) |
REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./) |
118 |
REAL PVteta(klon, ntetaSTD) |
REAL PVteta(klon, ntetaSTD) |
119 |
|
|
|
REAL SSUM |
|
|
|
|
|
LOGICAL:: firstcal = .true. |
|
120 |
REAL, intent(in):: rdayvrai |
REAL, intent(in):: rdayvrai |
121 |
|
|
122 |
!----------------------------------------------------------------------- |
!----------------------------------------------------------------------- |
154 |
pls(:, :, l) = preff * pksurcp**(1./ kappa) |
pls(:, :, l) = preff * pksurcp**(1./ kappa) |
155 |
zplay(:, l) = pack(pls(:, :, l), dyn_phy) |
zplay(:, l) = pack(pls(:, :, l), dyn_phy) |
156 |
ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy) |
ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy) |
|
pcvgt(:, l) = pack(pdteta(:, :, l) * pksurcp / pmasse(:, :, l), dyn_phy) |
|
157 |
ENDDO |
ENDDO |
158 |
|
|
159 |
! 43.bis traceurs |
! 43.bis traceurs |
|
|
|
160 |
DO iq=1, nqmx |
DO iq=1, nqmx |
161 |
iiq=niadv(iq) |
iiq=niadv(iq) |
162 |
DO l=1, llm |
DO l=1, llm |
172 |
ENDDO |
ENDDO |
173 |
ENDDO |
ENDDO |
174 |
|
|
|
! convergence dynamique pour les traceurs "EAU" |
|
|
|
|
|
DO iq=1, 2 |
|
|
DO l=1, llm |
|
|
pcvgq(1, l, iq)= pdq(1, 1, l, iq) / pmasse(1, 1, l) |
|
|
ig0 = 2 |
|
|
DO j=2, jjm |
|
|
DO i = 1, iim |
|
|
pcvgq(ig0, l, iq) = pdq(i, j, l, iq) / pmasse(i, j, l) |
|
|
ig0 = ig0 + 1 |
|
|
ENDDO |
|
|
ENDDO |
|
|
pcvgq(ig0, l, iq)= pdq(1, jjm + 1, l, iq) / pmasse(1, jjm + 1, l) |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
175 |
! Geopotentiel calcule par rapport a la surface locale: |
! Geopotentiel calcule par rapport a la surface locale: |
|
|
|
176 |
forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy) |
forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy) |
177 |
zphis = pack(pphis, dyn_phy) |
zphis = pack(pphis, dyn_phy) |
178 |
DO l=1, llm |
DO l=1, llm |
181 |
ENDDO |
ENDDO |
182 |
ENDDO |
ENDDO |
183 |
|
|
184 |
! .... Calcul de la vitesse verticale (en Pa*m*s ou Kg/s) .... |
! Calcul de la vitesse verticale (en Pa*m*s ou Kg/s) |
|
|
|
185 |
DO l=1, llm |
DO l=1, llm |
186 |
pvervel(1, l)=pw(1, 1, l) * g /apoln |
pvervel(1, l)=pw(1, 1, l) * g /apoln |
187 |
ig0=2 |
ig0=2 |
197 |
! 45. champ u: |
! 45. champ u: |
198 |
|
|
199 |
DO l=1, llm |
DO l=1, llm |
|
|
|
200 |
DO j=2, jjm |
DO j=2, jjm |
201 |
ig0 = 1+(j-2)*iim |
ig0 = 1+(j-2)*iim |
202 |
zufi(ig0+1, l)= 0.5 * & |
zufi(ig0+1, l)= 0.5 * & |
203 |
(pucov(iim, j, l)/cu_2d(iim, j) + pucov(1, j, l)/cu_2d(1, j)) |
(pucov(iim, j, l)/cu_2d(iim, j) + pucov(1, j, l)/cu_2d(1, j)) |
|
pcvgu(ig0+1, l)= 0.5 * & |
|
|
(pducov(iim, j, l)/cu_2d(iim, j) + pducov(1, j, l)/cu_2d(1, j)) |
|
204 |
DO i=2, iim |
DO i=2, iim |
205 |
zufi(ig0+i, l)= 0.5 * & |
zufi(ig0+i, l)= 0.5 * & |
206 |
(pucov(i-1, j, l)/cu_2d(i-1, j) & |
(pucov(i-1, j, l)/cu_2d(i-1, j) & |
207 |
+ pucov(i, j, l)/cu_2d(i, j)) |
+ pucov(i, j, l)/cu_2d(i, j)) |
|
pcvgu(ig0+i, l)= 0.5 * & |
|
|
(pducov(i-1, j, l)/cu_2d(i-1, j) & |
|
|
+ pducov(i, j, l)/cu_2d(i, j)) |
|
208 |
end DO |
end DO |
209 |
end DO |
end DO |
|
|
|
210 |
end DO |
end DO |
211 |
|
|
212 |
! 46.champ v: |
! 46.champ v: |
213 |
|
|
214 |
DO l = 1, llm |
forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l)= 0.5 & |
215 |
DO j = 2, jjm |
* (pvcov(:iim, j-1, l) / cv_2d(:iim, j-1) & |
216 |
ig0 = 1 + (j - 2) * iim |
+ pvcov(:iim, j, l) / cv_2d(:iim, j)) |
217 |
DO i = 1, iim |
zvfi(iim + 1, 2:jjm, :) = zvfi(1, 2:jjm, :) |
|
zvfi(ig0+i, l)= 0.5 * (pvcov(i, j-1, l) / cv_2d(i, j-1) & |
|
|
+ pvcov(i, j, l) / cv_2d(i, j)) |
|
|
pcvgv(ig0+i, l)= 0.5 * & |
|
|
(pdvcov(i, j-1, l)/cv_2d(i, j-1) & |
|
|
+ pdvcov(i, j, l)/cv_2d(i, j)) |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
218 |
|
|
219 |
! 47. champs de vents au pôle nord |
! 47. champs de vents au pôle nord |
220 |
! U = 1 / pi * integrale [ v * cos(long) * d long ] |
! U = 1 / pi * integrale [ v * cos(long) * d long ] |
221 |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
222 |
|
|
223 |
DO l=1, llm |
DO l=1, llm |
|
|
|
224 |
z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, 1, l)/cv_2d(1, 1) |
z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, 1, l)/cv_2d(1, 1) |
|
z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, 1, l)/cv_2d(1, 1) |
|
225 |
DO i=2, iim |
DO i=2, iim |
226 |
z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, 1, l)/cv_2d(i, 1) |
z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, 1, l)/cv_2d(i, 1) |
|
z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, 1, l)/cv_2d(i, 1) |
|
|
ENDDO |
|
|
|
|
|
DO i=1, iim |
|
|
zcos(i) = COS(rlonv(i))*z1(i) |
|
|
zcosbis(i)= COS(rlonv(i))*z1bis(i) |
|
|
zsin(i) = SIN(rlonv(i))*z1(i) |
|
|
zsinbis(i)= SIN(rlonv(i))*z1bis(i) |
|
227 |
ENDDO |
ENDDO |
228 |
|
|
229 |
zufi(1, l) = SSUM(iim, zcos, 1)/pi |
zufi(1, l) = SUM(COS(rlonv(:iim)) * z1) / pi |
230 |
pcvgu(1, l) = SSUM(iim, zcosbis, 1)/pi |
zvfi(:, 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi |
|
zvfi(1, l) = SSUM(iim, zsin, 1)/pi |
|
|
pcvgv(1, l) = SSUM(iim, zsinbis, 1)/pi |
|
|
|
|
231 |
ENDDO |
ENDDO |
232 |
|
|
233 |
! 48. champs de vents au pôle sud: |
! 48. champs de vents au pôle sud: |
235 |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
236 |
|
|
237 |
DO l=1, llm |
DO l=1, llm |
|
|
|
238 |
z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) & |
z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) & |
239 |
/cv_2d(1, jjm) |
/cv_2d(1, jjm) |
|
z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, jjm, l) & |
|
|
/cv_2d(1, jjm) |
|
240 |
DO i=2, iim |
DO i=2, iim |
241 |
z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, jjm, l)/cv_2d(i, jjm) |
z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, jjm, l)/cv_2d(i, jjm) |
|
z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, jjm, l)/cv_2d(i, jjm) |
|
|
ENDDO |
|
|
|
|
|
DO i=1, iim |
|
|
zcos(i) = COS(rlonv(i))*z1(i) |
|
|
zcosbis(i) = COS(rlonv(i))*z1bis(i) |
|
|
zsin(i) = SIN(rlonv(i))*z1(i) |
|
|
zsinbis(i) = SIN(rlonv(i))*z1bis(i) |
|
242 |
ENDDO |
ENDDO |
243 |
|
|
244 |
zufi(klon, l) = SSUM(iim, zcos, 1)/pi |
zufi(klon, l) = SUM(COS(rlonv(:iim)) * z1) / pi |
245 |
pcvgu(klon, l) = SSUM(iim, zcosbis, 1)/pi |
zvfi(:, jjm + 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi |
|
zvfi(klon, l) = SSUM(iim, zsin, 1)/pi |
|
|
pcvgv(klon, l) = SSUM(iim, zsinbis, 1)/pi |
|
|
|
|
246 |
ENDDO |
ENDDO |
247 |
|
|
248 |
|
forall(l= 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy) |
249 |
|
|
250 |
!IM calcul PV a teta=350, 380, 405K |
!IM calcul PV a teta=350, 380, 405K |
251 |
CALL PVtheta(klon, llm, pucov, pvcov, pteta, & |
CALL PVtheta(klon, llm, pucov, pvcov, pteta, ztfi, zplay, zplev, & |
|
ztfi, zplay, zplev, & |
|
252 |
ntetaSTD, rtetaSTD, PVteta) |
ntetaSTD, rtetaSTD, PVteta) |
253 |
|
|
254 |
! Appel de la physique: |
! Appel de la physique : |
255 |
|
CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, & |
256 |
CALL physiq(firstcal, lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, & |
zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, & |
257 |
zphis, zufi, zvfi, ztfi, qx, pvervel, zdufi, zdvfi, zdtfi, zdqfi, & |
zdtfi, zdqfi, zdpsrf, pducov, PVteta) ! diagnostic PVteta, Amip2 |
|
zdpsrf, pducov, PVteta) ! IM diagnostique PVteta, Amip2 |
|
258 |
|
|
259 |
! transformation des tendances physiques en tendances dynamiques: |
! transformation des tendances physiques en tendances dynamiques: |
260 |
|
|
361 |
! v = U * cos(long) + V * SIN(long) |
! v = U * cos(long) + V * SIN(long) |
362 |
|
|
363 |
DO l=1, llm |
DO l=1, llm |
|
|
|
364 |
DO i=1, iim |
DO i=1, iim |
365 |
pdvfi(i, 1, l)= & |
pdvfi(i, 1, l)= & |
366 |
zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i)) |
zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i)) |
374 |
|
|
375 |
pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l) |
pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l) |
376 |
pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l) |
pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l) |
|
|
|
377 |
ENDDO |
ENDDO |
378 |
|
|
|
firstcal = .FALSE. |
|
|
|
|
379 |
END SUBROUTINE calfis |
END SUBROUTINE calfis |
380 |
|
|
381 |
end module calfis_m |
end module calfis_m |