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 |
|
|
|
use dimens_m, only: iim, jjm, llm, nqmx |
|
|
use dimphy, only: klon |
|
52 |
use comconst, only: kappa, cpp, dtphys, g, pi |
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 physiq_m, only: physiq |
use physiq_m, only: physiq |
60 |
use pressure_var, only: p3d, pls |
use pressure_var, only: p3d, pls |
61 |
|
|
91 |
REAL pdqfi(iim + 1, jjm + 1, llm, nqmx) |
REAL pdqfi(iim + 1, jjm + 1, llm, nqmx) |
92 |
REAL pdpsfi(iim + 1, jjm + 1) |
REAL pdpsfi(iim + 1, jjm + 1) |
93 |
|
|
|
INTEGER, PARAMETER:: longcles = 20 |
|
|
|
|
94 |
! Local variables : |
! Local variables : |
95 |
|
|
96 |
INTEGER i, j, l, ig0, ig, iq, iiq |
INTEGER i, j, l, ig0, ig, iq, iiq |
98 |
REAL zplev(klon, llm+1), zplay(klon, llm) |
REAL zplev(klon, llm+1), zplay(klon, llm) |
99 |
REAL zphi(klon, llm), zphis(klon) |
REAL zphi(klon, llm), zphis(klon) |
100 |
|
|
101 |
REAL zufi(klon, llm), zvfi(klon, llm) |
REAL zufi(klon, llm), v(klon, llm) |
102 |
|
real zvfi(iim + 1, jjm + 1, llm) |
103 |
REAL ztfi(klon, llm) ! temperature |
REAL ztfi(klon, llm) ! temperature |
104 |
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) |
|
|
|
|
105 |
REAL pvervel(klon, llm) |
REAL pvervel(klon, llm) |
106 |
|
|
107 |
REAL zdufi(klon, llm), zdvfi(klon, llm) |
REAL zdufi(klon, llm), zdvfi(klon, llm) |
108 |
REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx) |
REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx) |
109 |
REAL zdpsrf(klon) |
REAL zdpsrf(klon) |
110 |
|
|
111 |
REAL zsin(iim), zcos(iim), z1(iim) |
REAL z1(iim) |
|
REAL zsinbis(iim), zcosbis(iim), z1bis(iim) |
|
112 |
REAL pksurcp(iim + 1, jjm + 1) |
REAL pksurcp(iim + 1, jjm + 1) |
113 |
|
|
114 |
! I. Musat: diagnostic PVteta, Amip2 |
! I. Musat: diagnostic PVteta, Amip2 |
116 |
REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./) |
REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./) |
117 |
REAL PVteta(klon, ntetaSTD) |
REAL PVteta(klon, ntetaSTD) |
118 |
|
|
|
REAL SSUM |
|
|
|
|
|
LOGICAL:: firstcal = .true. |
|
119 |
REAL, intent(in):: rdayvrai |
REAL, intent(in):: rdayvrai |
120 |
|
|
121 |
!----------------------------------------------------------------------- |
!----------------------------------------------------------------------- |
153 |
pls(:, :, l) = preff * pksurcp**(1./ kappa) |
pls(:, :, l) = preff * pksurcp**(1./ kappa) |
154 |
zplay(:, l) = pack(pls(:, :, l), dyn_phy) |
zplay(:, l) = pack(pls(:, :, l), dyn_phy) |
155 |
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) |
|
156 |
ENDDO |
ENDDO |
157 |
|
|
158 |
! 43.bis traceurs |
! 43.bis traceurs |
|
|
|
159 |
DO iq=1, nqmx |
DO iq=1, nqmx |
160 |
iiq=niadv(iq) |
iiq=niadv(iq) |
161 |
DO l=1, llm |
DO l=1, llm |
171 |
ENDDO |
ENDDO |
172 |
ENDDO |
ENDDO |
173 |
|
|
|
! 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 |
|
|
|
|
174 |
! Geopotentiel calcule par rapport a la surface locale: |
! Geopotentiel calcule par rapport a la surface locale: |
|
|
|
175 |
forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy) |
forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy) |
176 |
zphis = pack(pphis, dyn_phy) |
zphis = pack(pphis, dyn_phy) |
177 |
DO l=1, llm |
DO l=1, llm |
180 |
ENDDO |
ENDDO |
181 |
ENDDO |
ENDDO |
182 |
|
|
183 |
! .... Calcul de la vitesse verticale (en Pa*m*s ou Kg/s) .... |
! Calcul de la vitesse verticale (en Pa*m*s ou Kg/s) |
|
|
|
184 |
DO l=1, llm |
DO l=1, llm |
185 |
pvervel(1, l)=pw(1, 1, l) * g /apoln |
pvervel(1, l)=pw(1, 1, l) * g /apoln |
186 |
ig0=2 |
ig0=2 |
196 |
! 45. champ u: |
! 45. champ u: |
197 |
|
|
198 |
DO l=1, llm |
DO l=1, llm |
|
|
|
199 |
DO j=2, jjm |
DO j=2, jjm |
200 |
ig0 = 1+(j-2)*iim |
ig0 = 1+(j-2)*iim |
201 |
zufi(ig0+1, l)= 0.5 * & |
zufi(ig0+1, l)= 0.5 * & |
202 |
(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)) |
|
203 |
DO i=2, iim |
DO i=2, iim |
204 |
zufi(ig0+i, l)= 0.5 * & |
zufi(ig0+i, l)= 0.5 * & |
205 |
(pucov(i-1, j, l)/cu_2d(i-1, j) & |
(pucov(i-1, j, l)/cu_2d(i-1, j) & |
206 |
+ 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)) |
|
207 |
end DO |
end DO |
208 |
end DO |
end DO |
|
|
|
209 |
end DO |
end DO |
210 |
|
|
211 |
! 46.champ v: |
! 46.champ v: |
212 |
|
|
213 |
DO l = 1, llm |
forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l)= 0.5 & |
214 |
DO j = 2, jjm |
* (pvcov(:iim, j-1, l) / cv_2d(:iim, j-1) & |
215 |
ig0 = 1 + (j - 2) * iim |
+ pvcov(:iim, j, l) / cv_2d(:iim, j)) |
216 |
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 |
|
217 |
|
|
218 |
! 47. champs de vents au pôle nord |
! 47. champs de vents au pôle nord |
219 |
! U = 1 / pi * integrale [ v * cos(long) * d long ] |
! U = 1 / pi * integrale [ v * cos(long) * d long ] |
220 |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
221 |
|
|
222 |
DO l=1, llm |
DO l=1, llm |
|
|
|
223 |
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) |
|
224 |
DO i=2, iim |
DO i=2, iim |
225 |
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) |
|
226 |
ENDDO |
ENDDO |
227 |
|
|
228 |
zufi(1, l) = SSUM(iim, zcos, 1)/pi |
zufi(1, l) = SUM(COS(rlonv(:iim)) * z1) / pi |
229 |
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 |
|
|
|
|
230 |
ENDDO |
ENDDO |
231 |
|
|
232 |
! 48. champs de vents au pôle sud: |
! 48. champs de vents au pôle sud: |
234 |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
! V = 1 / pi * integrale [ v * sin(long) * d long ] |
235 |
|
|
236 |
DO l=1, llm |
DO l=1, llm |
|
|
|
237 |
z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) & |
z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) & |
238 |
/cv_2d(1, jjm) |
/cv_2d(1, jjm) |
|
z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, jjm, l) & |
|
|
/cv_2d(1, jjm) |
|
239 |
DO i=2, iim |
DO i=2, iim |
240 |
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) |
|
241 |
ENDDO |
ENDDO |
242 |
|
|
243 |
zufi(klon, l) = SSUM(iim, zcos, 1)/pi |
zufi(klon, l) = SUM(COS(rlonv(:iim)) * z1) / pi |
244 |
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 |
|
|
|
|
245 |
ENDDO |
ENDDO |
246 |
|
|
247 |
|
forall(l= 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy) |
248 |
|
|
249 |
!IM calcul PV a teta=350, 380, 405K |
!IM calcul PV a teta=350, 380, 405K |
250 |
CALL PVtheta(klon, llm, pucov, pvcov, pteta, & |
CALL PVtheta(klon, llm, pucov, pvcov, pteta, ztfi, zplay, zplev, & |
|
ztfi, zplay, zplev, & |
|
251 |
ntetaSTD, rtetaSTD, PVteta) |
ntetaSTD, rtetaSTD, PVteta) |
252 |
|
|
253 |
! Appel de la physique: |
! Appel de la physique : |
254 |
|
CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, & |
255 |
CALL physiq(firstcal, lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, & |
zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, & |
256 |
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 |
|
257 |
|
|
258 |
! transformation des tendances physiques en tendances dynamiques: |
! transformation des tendances physiques en tendances dynamiques: |
259 |
|
|
360 |
! v = U * cos(long) + V * SIN(long) |
! v = U * cos(long) + V * SIN(long) |
361 |
|
|
362 |
DO l=1, llm |
DO l=1, llm |
|
|
|
363 |
DO i=1, iim |
DO i=1, iim |
364 |
pdvfi(i, 1, l)= & |
pdvfi(i, 1, l)= & |
365 |
zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i)) |
zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i)) |
373 |
|
|
374 |
pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l) |
pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l) |
375 |
pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l) |
pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l) |
|
|
|
376 |
ENDDO |
ENDDO |
377 |
|
|
|
firstcal = .FALSE. |
|
|
|
|
378 |
END SUBROUTINE calfis |
END SUBROUTINE calfis |
379 |
|
|
380 |
end module calfis_m |
end module calfis_m |