/[lmdze]/trunk/dyn3d/calfis.f
ViewVC logotype

Diff of /trunk/dyn3d/calfis.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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