7 |
contains |
contains |
8 |
|
|
9 |
SUBROUTINE calfis(nq, lafin, rdayvrai, heure, pucov, pvcov, pteta, pq, & |
SUBROUTINE calfis(nq, lafin, rdayvrai, heure, pucov, pvcov, pteta, pq, & |
10 |
pmasse, pps, pp, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, & |
pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, & |
11 |
clesphy0, pdufi, pdvfi, pdhfi, pdqfi, pdpsfi) |
clesphy0, pdufi, pdvfi, pdhfi, pdqfi, pdpsfi) |
12 |
|
|
13 |
! From dyn3d/calfis.F,v 1.3 2005/05/25 13:10:09 |
! From dyn3d/calfis.F,v 1.3 2005/05/25 13:10:09 |
60 |
use advtrac_m, only: niadv |
use advtrac_m, only: niadv |
61 |
use grid_change, only: dyn_phy, gr_fi_dyn |
use grid_change, only: dyn_phy, gr_fi_dyn |
62 |
use physiq_m, only: physiq |
use physiq_m, only: physiq |
63 |
|
use pressure_var, only: p3d, pls |
64 |
|
|
65 |
! 0. Declarations : |
! 0. Declarations : |
66 |
|
|
90 |
REAL pw(iim + 1,jjm + 1,llm) |
REAL pw(iim + 1,jjm + 1,llm) |
91 |
|
|
92 |
REAL pps(iim + 1,jjm + 1) |
REAL pps(iim + 1,jjm + 1) |
93 |
REAL pp(iim + 1,jjm + 1,llm + 1) |
REAL, intent(in):: ppk(iim + 1,jjm + 1,llm) |
|
REAL ppk(iim + 1,jjm + 1,llm) |
|
94 |
|
|
95 |
REAL pdvfi(iim + 1,jjm,llm) |
REAL pdvfi(iim + 1,jjm,llm) |
96 |
REAL pdufi(iim + 1,jjm + 1,llm) |
REAL pdufi(iim + 1,jjm + 1,llm) |
99 |
REAL pdpsfi(iim + 1,jjm + 1) |
REAL pdpsfi(iim + 1,jjm + 1) |
100 |
|
|
101 |
INTEGER, PARAMETER:: longcles = 20 |
INTEGER, PARAMETER:: longcles = 20 |
102 |
REAL clesphy0(longcles) |
REAL, intent(in):: clesphy0(longcles) |
103 |
|
|
104 |
! Local variables : |
! Local variables : |
105 |
|
|
123 |
|
|
124 |
REAL zsin(iim),zcos(iim),z1(iim) |
REAL zsin(iim),zcos(iim),z1(iim) |
125 |
REAL zsinbis(iim),zcosbis(iim),z1bis(iim) |
REAL zsinbis(iim),zcosbis(iim),z1bis(iim) |
126 |
REAL unskap, pksurcp |
REAL pksurcp(iim + 1,jjm + 1) |
127 |
|
|
128 |
! I. Musat: diagnostic PVteta, Amip2 |
! I. Musat: diagnostic PVteta, Amip2 |
129 |
INTEGER, PARAMETER:: ntetaSTD=3 |
INTEGER, PARAMETER:: ntetaSTD=3 |
133 |
REAL SSUM |
REAL SSUM |
134 |
|
|
135 |
LOGICAL:: firstcal = .true. |
LOGICAL:: firstcal = .true. |
136 |
REAL rdayvrai |
REAL, intent(in):: rdayvrai |
137 |
|
|
138 |
!----------------------------------------------------------------------- |
!----------------------------------------------------------------------- |
139 |
|
|
162 |
|
|
163 |
! ... Exner = cp * (p(l) / preff) ** kappa .... |
! ... Exner = cp * (p(l) / preff) ** kappa .... |
164 |
|
|
165 |
unskap = 1./ kappa |
forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy) |
|
|
|
|
DO l = 1, llm + 1 |
|
|
zplev(1,l) = pp(1,1,l) |
|
|
ig0 = 2 |
|
|
DO j = 2, jjm |
|
|
DO i =1, iim |
|
|
zplev(ig0,l) = pp(i,j,l) |
|
|
ig0 = ig0 +1 |
|
|
ENDDO |
|
|
ENDDO |
|
|
zplev(klon,l) = pp(1,jjm + 1,l) |
|
|
ENDDO |
|
166 |
|
|
167 |
! 43. temperature naturelle (en K) et pressions milieux couches . |
! 43. temperature naturelle (en K) et pressions milieux couches . |
|
|
|
168 |
DO l=1,llm |
DO l=1,llm |
169 |
|
pksurcp = ppk(:, :, l) / cpp |
170 |
pksurcp = ppk(1,1,l) / cpp |
pls(:, :, l) = preff * pksurcp**(1./ kappa) |
171 |
zplay(1,l) = preff * pksurcp ** unskap |
zplay(:, l) = pack(pls(:, :, l), dyn_phy) |
172 |
ztfi(1,l) = pteta(1,1,l) * pksurcp |
ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy) |
173 |
pcvgt(1,l) = pdteta(1,1,l) * pksurcp / pmasse(1,1,l) |
pcvgt(:, l) = pack(pdteta(:, :, l) * pksurcp / pmasse(:, :, l), dyn_phy) |
|
ig0 = 2 |
|
|
|
|
|
DO j = 2, jjm |
|
|
DO i = 1, iim |
|
|
pksurcp = ppk(i,j,l) / cpp |
|
|
zplay(ig0,l) = preff * pksurcp ** unskap |
|
|
ztfi(ig0,l) = pteta(i,j,l) * pksurcp |
|
|
pcvgt(ig0,l) = pdteta(i,j,l) * pksurcp / pmasse(i,j,l) |
|
|
ig0 = ig0 + 1 |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
pksurcp = ppk(1,jjm + 1,l) / cpp |
|
|
zplay(ig0,l) = preff * pksurcp ** unskap |
|
|
ztfi (ig0,l) = pteta(1,jjm + 1,l) * pksurcp |
|
|
pcvgt(ig0,l) = pdteta(1,jjm + 1,l) * pksurcp/ pmasse(1,jjm + 1,l) |
|
|
|
|
174 |
ENDDO |
ENDDO |
175 |
|
|
176 |
! 43.bis traceurs |
! 43.bis traceurs |