libf/dyn3d/calfis.f90

module calfis_m

  IMPLICIT NONE

contains

  SUBROUTINE calfis(rdayvrai, heure, pucov, pvcov, teta, q, pmasse, pps, &
       ppk, pphis, pphi, pducov, pdvcov, pdq, pw, pdufi, pdvfi, pdhfi, pdqfi, &
       pdpsfi, lafin)

    ! From dyn3d/calfis.F, version 1.3 2005/05/25 13:10:09
    ! Authors: P. Le Van, F. Hourdin

    ! 1. Réarrangement des tableaux et transformation variables
    ! dynamiques en variables physiques
    ! 2. Calcul des termes physiques
    ! 3. Retransformation des tendances physiques en tendances dynamiques

    ! Remarques:

    ! - Les vents sont donnés dans la physique par leurs composantes 
    ! naturelles.

    ! - La variable thermodynamique de la physique est une variable
    ! intensive : T.
    ! Pour la dynamique on prend T * (preff / p(l)) **kappa

    ! - Les deux seules variables dépendant de la géométrie
    ! nécessaires pour la physique sont la latitude pour le
    ! rayonnement et l'aire de la maille quand on veut intégrer une
    ! grandeur horizontalement.

    ! Input :
    ! pucov covariant zonal velocity
    ! pvcov covariant meridional velocity 
    ! teta potential temperature
    ! pps surface pressure
    ! pmasse masse d'air dans chaque maille
    ! pts surface temperature (K)
    ! callrad clef d'appel au rayonnement

    ! Output :
    ! pdufi tendency for the natural zonal velocity (ms-1)
    ! pdvfi tendency for the natural meridional velocity 
    ! pdhfi tendency for the potential temperature
    ! pdtsfi tendency for the surface temperature

    ! pdtrad radiative tendencies \ input and output
    ! pfluxrad radiative fluxes / input and output

    use comconst, only: kappa, cpp, dtphys, g
    use comvert, only: preff
    use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv
    use dimens_m, only: iim, jjm, llm, nqmx
    use dimphy, only: klon
    use grid_change, only: dyn_phy, gr_fi_dyn
    use iniadvtrac_m, only: niadv
    use nr_util, only: pi
    use physiq_m, only: physiq
    use pressure_var, only: p3d, pls

    ! Arguments :

    LOGICAL, intent(in):: lafin
    REAL, intent(in):: heure ! heure de la journée en fraction de jour

    REAL pvcov(iim + 1, jjm, llm)
    REAL pucov(iim + 1, jjm + 1, llm)
    REAL, intent(in):: teta(iim + 1, jjm + 1, llm)
    REAL pmasse(iim + 1, jjm + 1, llm)

    REAL, intent(in):: q(iim + 1, jjm + 1, llm, nqmx)
    ! (mass fractions of advected fields)

    REAL pphis(iim + 1, jjm + 1)
    REAL pphi(iim + 1, jjm + 1, llm)

    REAL pdvcov(iim + 1, jjm, llm)
    REAL pducov(iim + 1, jjm + 1, llm)
    REAL pdq(iim + 1, jjm + 1, llm, nqmx)

    REAL, intent(in):: pw(iim + 1, jjm + 1, llm)

    REAL pps(iim + 1, jjm + 1)
    REAL, intent(in):: ppk(iim + 1, jjm + 1, llm)

    REAL pdvfi(iim + 1, jjm, llm)
    REAL pdufi(iim + 1, jjm + 1, llm)
    REAL, intent(out):: pdhfi(iim + 1, jjm + 1, llm)
    REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
    REAL pdpsfi(iim + 1, jjm + 1)

    ! Local variables :

    INTEGER i, j, l, ig0, ig, iq, iiq
    REAL zpsrf(klon)
    REAL zplev(klon, llm+1), zplay(klon, llm)
    REAL zphi(klon, llm), zphis(klon)

    REAL zufi(klon, llm), v(klon, llm)
    real zvfi(iim + 1, jjm + 1, llm)
    REAL ztfi(klon, llm) ! temperature
    real qx(klon, llm, nqmx) ! mass fractions of advected fields
    REAL pvervel(klon, llm)

    REAL zdufi(klon, llm), zdvfi(klon, llm)
    REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)
    REAL zdpsrf(klon)

    REAL z1(iim)
    REAL pksurcp(iim + 1, jjm + 1)

    ! I. Musat: diagnostic PVteta, Amip2
    INTEGER, PARAMETER:: ntetaSTD=3
    REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)
    REAL PVteta(klon, ntetaSTD)

    REAL, intent(in):: rdayvrai

    !-----------------------------------------------------------------------

    !!print *, "Call sequence information: calfis"

    ! 1. Initialisations :
    ! latitude, longitude et aires des mailles pour la physique:

    ! 40. transformation des variables dynamiques en variables physiques:
    ! 41. pressions au sol (en Pascals)

    zpsrf(1) = pps(1, 1)

    ig0 = 2
    DO j = 2, jjm
       CALL SCOPY(iim, pps(1, j), 1, zpsrf(ig0), 1)
       ig0 = ig0+iim
    ENDDO

    zpsrf(klon) = pps(1, jjm + 1)

    ! 42. pression intercouches :

    ! zplev defini aux (llm +1) interfaces des couches 
    ! zplay defini aux (llm) milieux des couches  

    ! Exner = cp * (p(l) / preff) ** kappa 

    forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)

    ! 43. temperature naturelle (en K) et pressions milieux couches
    DO l=1, llm
       pksurcp = ppk(:, :, l) / cpp
       pls(:, :, l) = preff * pksurcp**(1./ kappa)
       zplay(:, l) = pack(pls(:, :, l), dyn_phy)
       ztfi(:, l) = pack(teta(:, :, l) * pksurcp, dyn_phy)
    ENDDO

    ! 43.bis traceurs
    DO iq=1, nqmx
       iiq=niadv(iq) 
       DO l=1, llm
          qx(1, l, iq) = q(1, 1, l, iiq)
          ig0 = 2
          DO j=2, jjm
             DO i = 1, iim
                qx(ig0, l, iq) = q(i, j, l, iiq)
                ig0 = ig0 + 1
             ENDDO
          ENDDO
          qx(ig0, l, iq) = q(1, jjm + 1, l, iiq)
       ENDDO
    ENDDO

    ! Geopotentiel calcule par rapport a la surface locale:
    forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)
    zphis = pack(pphis, dyn_phy)
    DO l=1, llm
       DO ig=1, klon
          zphi(ig, l)=zphi(ig, l)-zphis(ig)
       ENDDO
    ENDDO

    ! Calcul de la vitesse verticale (en Pa*m*s ou Kg/s)
    DO l=1, llm
       pvervel(1, l)=pw(1, 1, l) * g /apoln
       ig0=2
       DO j=2, jjm
          DO i = 1, iim
             pvervel(ig0, l) = pw(i, j, l) * g * unsaire_2d(i, j)
             ig0 = ig0 + 1
          ENDDO
       ENDDO
       pvervel(ig0, l)=pw(1, jjm + 1, l) * g /apols
    ENDDO

    ! 45. champ u:

    DO l=1, llm
       DO j=2, jjm
          ig0 = 1+(j-2)*iim
          zufi(ig0+1, l)= 0.5 * &
               (pucov(iim, j, l)/cu_2d(iim, j) + pucov(1, j, l)/cu_2d(1, j))
          DO i=2, iim
             zufi(ig0+i, l)= 0.5 * &
                  (pucov(i-1, j, l)/cu_2d(i-1, j) &
                  + pucov(i, j, l)/cu_2d(i, j))
          end DO
       end DO
    end DO

    ! 46.champ v:

    forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l)= 0.5 &
         * (pvcov(:iim, j-1, l) / cv_2d(:iim, j-1) &
         + pvcov(:iim, j, l) / cv_2d(:iim, j))
    zvfi(iim + 1, 2:jjm, :) = zvfi(1, 2:jjm, :)

    ! 47. champs de vents au pôle nord 
    ! U = 1 / pi * integrale [ v * cos(long) * d long ]
    ! V = 1 / pi * integrale [ v * sin(long) * d long ]

    DO l=1, llm
       z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, 1, l)/cv_2d(1, 1)
       DO i=2, iim
          z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, 1, l)/cv_2d(i, 1)
       ENDDO

       zufi(1, l) = SUM(COS(rlonv(:iim)) * z1) / pi
       zvfi(:, 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
    ENDDO

    ! 48. champs de vents au pôle sud:
    ! U = 1 / pi * integrale [ v * cos(long) * d long ]
    ! V = 1 / pi * integrale [ v * sin(long) * d long ]

    DO l=1, llm
       z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) &
            /cv_2d(1, jjm)
       DO i=2, iim
          z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, jjm, l)/cv_2d(i, jjm)
       ENDDO

       zufi(klon, l) = SUM(COS(rlonv(:iim)) * z1) / pi
       zvfi(:, jjm + 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
    ENDDO

    forall(l= 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy)

    !IM calcul PV a teta=350, 380, 405K
    CALL PVtheta(klon, llm, pucov, pvcov, teta, ztfi, zplay, zplev, &
         ntetaSTD, rtetaSTD, PVteta)

    ! Appel de la physique :
    CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
         zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, &
         zdtfi, zdqfi, zdpsrf, pducov, PVteta) ! diagnostic PVteta, Amip2

    ! transformation des tendances physiques en tendances dynamiques:

    ! tendance sur la pression :

    pdpsfi = gr_fi_dyn(zdpsrf)

    ! 62. enthalpie potentielle

    DO l=1, llm

       DO i=1, iim + 1
          pdhfi(i, 1, l) = cpp * zdtfi(1, l) / ppk(i, 1 , l)
          pdhfi(i, jjm + 1, l) = cpp * zdtfi(klon, l)/ ppk(i, jjm + 1, l)
       ENDDO

       DO j=2, jjm
          ig0=1+(j-2)*iim
          DO i=1, iim
             pdhfi(i, j, l) = cpp * zdtfi(ig0+i, l) / ppk(i, j, l)
          ENDDO
          pdhfi(iim + 1, j, l) = pdhfi(1, j, l)
       ENDDO

    ENDDO

    ! 62. humidite specifique

    DO iq=1, nqmx
       DO l=1, llm
          DO i=1, iim + 1
             pdqfi(i, 1, l, iq) = zdqfi(1, l, iq)
             pdqfi(i, jjm + 1, l, iq) = zdqfi(klon, l, iq)
          ENDDO
          DO j=2, jjm
             ig0=1+(j-2)*iim
             DO i=1, iim
                pdqfi(i, j, l, iq) = zdqfi(ig0+i, l, iq)
             ENDDO
             pdqfi(iim + 1, j, l, iq) = pdqfi(1, j, l, iq)
          ENDDO
       ENDDO
    ENDDO

    ! 63. traceurs

    ! initialisation des tendances
    pdqfi=0.

    DO iq=1, nqmx
       iiq=niadv(iq)
       DO l=1, llm
          DO i=1, iim + 1
             pdqfi(i, 1, l, iiq) = zdqfi(1, l, iq)
             pdqfi(i, jjm + 1, l, iiq) = zdqfi(klon, l, iq)
          ENDDO
          DO j=2, jjm
             ig0=1+(j-2)*iim
             DO i=1, iim
                pdqfi(i, j, l, iiq) = zdqfi(ig0+i, l, iq)
             ENDDO
             pdqfi(iim + 1, j, l, iiq) = pdqfi(1, j, l, iq)
          ENDDO
       ENDDO
    ENDDO

    ! 65. champ u:

    DO l=1, llm

       DO i=1, iim + 1
          pdufi(i, 1, l) = 0.
          pdufi(i, jjm + 1, l) = 0.
       ENDDO

       DO j=2, jjm
          ig0=1+(j-2)*iim
          DO i=1, iim-1
             pdufi(i, j, l)= &
                  0.5*(zdufi(ig0+i, l)+zdufi(ig0+i+1, l))*cu_2d(i, j)
          ENDDO
          pdufi(iim, j, l)= &
               0.5*(zdufi(ig0+1, l)+zdufi(ig0+iim, l))*cu_2d(iim, j)
          pdufi(iim + 1, j, l)=pdufi(1, j, l)
       ENDDO

    ENDDO

    ! 67. champ v:

    DO l=1, llm

       DO j=2, jjm-1
          ig0=1+(j-2)*iim
          DO i=1, iim
             pdvfi(i, j, l)= &
                  0.5*(zdvfi(ig0+i, l)+zdvfi(ig0+i+iim, l))*cv_2d(i, j)
          ENDDO
          pdvfi(iim + 1, j, l) = pdvfi(1, j, l)
       ENDDO
    ENDDO

    ! 68. champ v pres des poles:
    ! v = U * cos(long) + V * SIN(long)

    DO l=1, llm
       DO i=1, iim
          pdvfi(i, 1, l)= &
               zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i))
          pdvfi(i, jjm, l)=zdufi(klon, l)*COS(rlonv(i)) &
               +zdvfi(klon, l)*SIN(rlonv(i))
          pdvfi(i, 1, l)= &
               0.5*(pdvfi(i, 1, l)+zdvfi(i+1, l))*cv_2d(i, 1)
          pdvfi(i, jjm, l)= &
               0.5*(pdvfi(i, jjm, l)+zdvfi(klon-iim-1+i, l))*cv_2d(i, jjm)
       ENDDO

       pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l)
       pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l)
    ENDDO

  END SUBROUTINE calfis

end module calfis_m
1	module calfis_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE calfis(rdayvrai, heure, pucov, pvcov, teta, q, pmasse, pps, &
8	ppk, pphis, pphi, pducov, pdvcov, pdq, pw, pdufi, pdvfi, pdhfi, pdqfi, &
9	pdpsfi, lafin)
10
11	! From dyn3d/calfis.F, version 1.3 2005/05/25 13:10:09
12	! Authors: P. Le Van, F. Hourdin
13
14	! 1. Réarrangement des tableaux et transformation variables
15	! dynamiques en variables physiques
16	! 2. Calcul des termes physiques
17	! 3. Retransformation des tendances physiques en tendances dynamiques
18
19	! Remarques:
20
21	! - Les vents sont donnés dans la physique par leurs composantes
22	! naturelles.
23
24	! - La variable thermodynamique de la physique est une variable
25	! intensive : T.
26	! Pour la dynamique on prend T * (preff / p(l)) **kappa
27
28	! - Les deux seules variables dépendant de la géométrie
29	! nécessaires pour la physique sont la latitude pour le
30	! rayonnement et l'aire de la maille quand on veut intégrer une
31	! grandeur horizontalement.
32
33	! Input :
34	! pucov covariant zonal velocity
35	! pvcov covariant meridional velocity
36	! teta potential temperature
37	! pps surface pressure
38	! pmasse masse d'air dans chaque maille
39	! pts surface temperature (K)
40	! callrad clef d'appel au rayonnement
41
42	! Output :
43	! pdufi tendency for the natural zonal velocity (ms-1)
44	! pdvfi tendency for the natural meridional velocity
45	! pdhfi tendency for the potential temperature
46	! pdtsfi tendency for the surface temperature
47
48	! pdtrad radiative tendencies \ input and output
49	! pfluxrad radiative fluxes / input and output
50
51	use comconst, only: kappa, cpp, dtphys, g
52	use comvert, only: preff
53	use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv
54	use dimens_m, only: iim, jjm, llm, nqmx
55	use dimphy, only: klon
56	use grid_change, only: dyn_phy, gr_fi_dyn
57	use iniadvtrac_m, only: niadv
58	use nr_util, only: pi
59	use physiq_m, only: physiq
60	use pressure_var, only: p3d, pls
61
62	! Arguments :
63
64	LOGICAL, intent(in):: lafin
65	REAL, intent(in):: heure ! heure de la journée en fraction de jour
66
67	REAL pvcov(iim + 1, jjm, llm)
68	REAL pucov(iim + 1, jjm + 1, llm)
69	REAL, intent(in):: teta(iim + 1, jjm + 1, llm)
70	REAL pmasse(iim + 1, jjm + 1, llm)
71
72	REAL, intent(in):: q(iim + 1, jjm + 1, llm, nqmx)
73	! (mass fractions of advected fields)
74
75	REAL pphis(iim + 1, jjm + 1)
76	REAL pphi(iim + 1, jjm + 1, llm)
77
78	REAL pdvcov(iim + 1, jjm, llm)
79	REAL pducov(iim + 1, jjm + 1, llm)
80	REAL pdq(iim + 1, jjm + 1, llm, nqmx)
81
82	REAL, intent(in):: pw(iim + 1, jjm + 1, llm)
83
84	REAL pps(iim + 1, jjm + 1)
85	REAL, intent(in):: ppk(iim + 1, jjm + 1, llm)
86
87	REAL pdvfi(iim + 1, jjm, llm)
88	REAL pdufi(iim + 1, jjm + 1, llm)
89	REAL, intent(out):: pdhfi(iim + 1, jjm + 1, llm)
90	REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
91	REAL pdpsfi(iim + 1, jjm + 1)
92
93	! Local variables :
94
95	INTEGER i, j, l, ig0, ig, iq, iiq
96	REAL zpsrf(klon)
97	REAL zplev(klon, llm+1), zplay(klon, llm)
98	REAL zphi(klon, llm), zphis(klon)
99
100	REAL zufi(klon, llm), v(klon, llm)
101	real zvfi(iim + 1, jjm + 1, llm)
102	REAL ztfi(klon, llm) ! temperature
103	real qx(klon, llm, nqmx) ! mass fractions of advected fields
104	REAL pvervel(klon, llm)
105
106	REAL zdufi(klon, llm), zdvfi(klon, llm)
107	REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)
108	REAL zdpsrf(klon)
109
110	REAL z1(iim)
111	REAL pksurcp(iim + 1, jjm + 1)
112
113	! I. Musat: diagnostic PVteta, Amip2
114	INTEGER, PARAMETER:: ntetaSTD=3
115	REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)
116	REAL PVteta(klon, ntetaSTD)
117
118	REAL, intent(in):: rdayvrai
119
120	!-----------------------------------------------------------------------
121
122	!!print *, "Call sequence information: calfis"
123
124	! 1. Initialisations :
125	! latitude, longitude et aires des mailles pour la physique:
126
127	! 40. transformation des variables dynamiques en variables physiques:
128	! 41. pressions au sol (en Pascals)
129
130	zpsrf(1) = pps(1, 1)
131
132	ig0 = 2
133	DO j = 2, jjm
134	CALL SCOPY(iim, pps(1, j), 1, zpsrf(ig0), 1)
135	ig0 = ig0+iim
136	ENDDO
137
138	zpsrf(klon) = pps(1, jjm + 1)
139
140	! 42. pression intercouches :
141
142	! zplev defini aux (llm +1) interfaces des couches
143	! zplay defini aux (llm) milieux des couches
144
145	! Exner = cp * (p(l) / preff) ** kappa
146
147	forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)
148
149	! 43. temperature naturelle (en K) et pressions milieux couches
150	DO l=1, llm
151	pksurcp = ppk(:, :, l) / cpp
152	pls(:, :, l) = preff * pksurcp**(1./ kappa)
153	zplay(:, l) = pack(pls(:, :, l), dyn_phy)
154	ztfi(:, l) = pack(teta(:, :, l) * pksurcp, dyn_phy)
155	ENDDO
156
157	! 43.bis traceurs
158	DO iq=1, nqmx
159	iiq=niadv(iq)
160	DO l=1, llm
161	qx(1, l, iq) = q(1, 1, l, iiq)
162	ig0 = 2
163	DO j=2, jjm
164	DO i = 1, iim
165	qx(ig0, l, iq) = q(i, j, l, iiq)
166	ig0 = ig0 + 1
167	ENDDO
168	ENDDO
169	qx(ig0, l, iq) = q(1, jjm + 1, l, iiq)
170	ENDDO
171	ENDDO
172
173	! Geopotentiel calcule par rapport a la surface locale:
174	forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)
175	zphis = pack(pphis, dyn_phy)
176	DO l=1, llm
177	DO ig=1, klon
178	zphi(ig, l)=zphi(ig, l)-zphis(ig)
179	ENDDO
180	ENDDO
181
182	! Calcul de la vitesse verticale (en Pams ou Kg/s)
183	DO l=1, llm
184	pvervel(1, l)=pw(1, 1, l) * g /apoln
185	ig0=2
186	DO j=2, jjm
187	DO i = 1, iim
188	pvervel(ig0, l) = pw(i, j, l) * g * unsaire_2d(i, j)
189	ig0 = ig0 + 1
190	ENDDO
191	ENDDO
192	pvervel(ig0, l)=pw(1, jjm + 1, l) * g /apols
193	ENDDO
194
195	! 45. champ u:
196
197	DO l=1, llm
198	DO j=2, jjm
199	ig0 = 1+(j-2)*iim
200	zufi(ig0+1, l)= 0.5 * &
201	(pucov(iim, j, l)/cu_2d(iim, j) + pucov(1, j, l)/cu_2d(1, j))
202	DO i=2, iim
203	zufi(ig0+i, l)= 0.5 * &
204	(pucov(i-1, j, l)/cu_2d(i-1, j) &
205	+ pucov(i, j, l)/cu_2d(i, j))
206	end DO
207	end DO
208	end DO
209
210	! 46.champ v:
211
212	forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l)= 0.5 &
213	* (pvcov(:iim, j-1, l) / cv_2d(:iim, j-1) &
214	+ pvcov(:iim, j, l) / cv_2d(:iim, j))
215	zvfi(iim + 1, 2:jjm, :) = zvfi(1, 2:jjm, :)
216
217	! 47. champs de vents au pôle nord
218	! U = 1 / pi * integrale [ v * cos(long) * d long ]
219	! V = 1 / pi * integrale [ v * sin(long) * d long ]
220
221	DO l=1, llm
222	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1, 1, l)/cv_2d(1, 1)
223	DO i=2, iim
224	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, 1, l)/cv_2d(i, 1)
225	ENDDO
226
227	zufi(1, l) = SUM(COS(rlonv(:iim)) * z1) / pi
228	zvfi(:, 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
229	ENDDO
230
231	! 48. champs de vents au pôle sud:
232	! U = 1 / pi * integrale [ v * cos(long) * d long ]
233	! V = 1 / pi * integrale [ v * sin(long) * d long ]
234
235	DO l=1, llm
236	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1, jjm, l) &
237	/cv_2d(1, jjm)
238	DO i=2, iim
239	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, jjm, l)/cv_2d(i, jjm)
240	ENDDO
241
242	zufi(klon, l) = SUM(COS(rlonv(:iim)) * z1) / pi
243	zvfi(:, jjm + 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
244	ENDDO
245
246	forall(l= 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy)
247
248	!IM calcul PV a teta=350, 380, 405K
249	CALL PVtheta(klon, llm, pucov, pvcov, teta, ztfi, zplay, zplev, &
250	ntetaSTD, rtetaSTD, PVteta)
251
252	! Appel de la physique :
253	CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
254	zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, &
255	zdtfi, zdqfi, zdpsrf, pducov, PVteta) ! diagnostic PVteta, Amip2
256
257	! transformation des tendances physiques en tendances dynamiques:
258
259	! tendance sur la pression :
260
261	pdpsfi = gr_fi_dyn(zdpsrf)
262
263	! 62. enthalpie potentielle
264
265	DO l=1, llm
266
267	DO i=1, iim + 1
268	pdhfi(i, 1, l) = cpp * zdtfi(1, l) / ppk(i, 1 , l)
269	pdhfi(i, jjm + 1, l) = cpp * zdtfi(klon, l)/ ppk(i, jjm + 1, l)
270	ENDDO
271
272	DO j=2, jjm
273	ig0=1+(j-2)*iim
274	DO i=1, iim
275	pdhfi(i, j, l) = cpp * zdtfi(ig0+i, l) / ppk(i, j, l)
276	ENDDO
277	pdhfi(iim + 1, j, l) = pdhfi(1, j, l)
278	ENDDO
279
280	ENDDO
281
282	! 62. humidite specifique
283
284	DO iq=1, nqmx
285	DO l=1, llm
286	DO i=1, iim + 1
287	pdqfi(i, 1, l, iq) = zdqfi(1, l, iq)
288	pdqfi(i, jjm + 1, l, iq) = zdqfi(klon, l, iq)
289	ENDDO
290	DO j=2, jjm
291	ig0=1+(j-2)*iim
292	DO i=1, iim
293	pdqfi(i, j, l, iq) = zdqfi(ig0+i, l, iq)
294	ENDDO
295	pdqfi(iim + 1, j, l, iq) = pdqfi(1, j, l, iq)
296	ENDDO
297	ENDDO
298	ENDDO
299
300	! 63. traceurs
301
302	! initialisation des tendances
303	pdqfi=0.
304
305	DO iq=1, nqmx
306	iiq=niadv(iq)
307	DO l=1, llm
308	DO i=1, iim + 1
309	pdqfi(i, 1, l, iiq) = zdqfi(1, l, iq)
310	pdqfi(i, jjm + 1, l, iiq) = zdqfi(klon, l, iq)
311	ENDDO
312	DO j=2, jjm
313	ig0=1+(j-2)*iim
314	DO i=1, iim
315	pdqfi(i, j, l, iiq) = zdqfi(ig0+i, l, iq)
316	ENDDO
317	pdqfi(iim + 1, j, l, iiq) = pdqfi(1, j, l, iq)
318	ENDDO
319	ENDDO
320	ENDDO
321
322	! 65. champ u:
323
324	DO l=1, llm
325
326	DO i=1, iim + 1
327	pdufi(i, 1, l) = 0.
328	pdufi(i, jjm + 1, l) = 0.
329	ENDDO
330
331	DO j=2, jjm
332	ig0=1+(j-2)*iim
333	DO i=1, iim-1
334	pdufi(i, j, l)= &
335	0.5(zdufi(ig0+i, l)+zdufi(ig0+i+1, l))cu_2d(i, j)
336	ENDDO
337	pdufi(iim, j, l)= &
338	0.5(zdufi(ig0+1, l)+zdufi(ig0+iim, l))cu_2d(iim, j)
339	pdufi(iim + 1, j, l)=pdufi(1, j, l)
340	ENDDO
341
342	ENDDO
343
344	! 67. champ v:
345
346	DO l=1, llm
347
348	DO j=2, jjm-1
349	ig0=1+(j-2)*iim
350	DO i=1, iim
351	pdvfi(i, j, l)= &
352	0.5(zdvfi(ig0+i, l)+zdvfi(ig0+i+iim, l))cv_2d(i, j)
353	ENDDO
354	pdvfi(iim + 1, j, l) = pdvfi(1, j, l)
355	ENDDO
356	ENDDO
357
358	! 68. champ v pres des poles:
359	! v = U * cos(long) + V * SIN(long)
360
361	DO l=1, llm
362	DO i=1, iim
363	pdvfi(i, 1, l)= &
364	zdufi(1, l)COS(rlonv(i))+zdvfi(1, l)SIN(rlonv(i))
365	pdvfi(i, jjm, l)=zdufi(klon, l)*COS(rlonv(i)) &
366	+zdvfi(klon, l)*SIN(rlonv(i))
367	pdvfi(i, 1, l)= &
368	0.5(pdvfi(i, 1, l)+zdvfi(i+1, l))cv_2d(i, 1)
369	pdvfi(i, jjm, l)= &
370	0.5(pdvfi(i, jjm, l)+zdvfi(klon-iim-1+i, l))cv_2d(i, jjm)
371	ENDDO
372
373	pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l)
374	pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l)
375	ENDDO
376
377	END SUBROUTINE calfis
378
379	end module calfis_m