libf/dyn3d/calfis.f90

module calfis_m

  IMPLICIT NONE

contains

  SUBROUTINE calfis(rdayvrai, heure, pucov, pvcov, pteta, q, &
       pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, 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. rearrangement des tableaux et transformation
    !      variables dynamiques  >  variables physiques
    !   2. calcul des termes physiques
    !   3. retransformation des tendances physiques en tendances dynamiques

    !   remarques:
    !   ----------

    !    - les vents sont donnes 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 dependant de la geometrie necessaires
    !      pour la physique sont la latitude pour le rayonnement et 
    !      l'aire de la maille quand on veut integrer une grandeur 
    !      horizontalement.

    !     Input :
    !     -------
    !       pucov           covariant zonal velocity
    !       pvcov           covariant meridional velocity 
    !       pteta           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  \  both input
    !        pfluxrad       radiative fluxes      /  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 pteta(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 pdteta(iim + 1, jjm + 1, llm)
    REAL pdq(iim + 1, jjm + 1, llm, nqmx)

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