/[lmdze]/trunk/Sources/phylmd/clmain.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/clmain.f

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

revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC revision 49 by guez, Wed Aug 24 11:43:14 2011 UTC
# Line 16  contains Line 16  contains
16         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)
17    
18      ! From phylmd/clmain.F, version 1.6 2005/11/16 14:47:19      ! From phylmd/clmain.F, version 1.6 2005/11/16 14:47:19
19        ! Author: Z.X. Li (LMD/CNRS), date: 1993/08/18
20        ! Objet : interface de "couche limite" (diffusion verticale)
21    
22      ! Tout ce qui a trait aux traceurs est dans phytrac maintenant.      ! Tout ce qui a trait aux traceurs est dans "phytrac" maintenant.
23      ! Pour l'instant le calcul de la couche limite pour les traceurs      ! Pour l'instant le calcul de la couche limite pour les traceurs
24      ! se fait avec cltrac et ne tient pas compte de la différentiation      ! se fait avec "cltrac" et ne tient pas compte de la différentiation
25      ! des sous-fractions de sol.      ! des sous-fractions de sol.
26    
27      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'échanges et le vent
28      ! dans la première couche, trois champs supplémentaires ont été créés :      ! dans la première couche, trois champs supplémentaires ont été
29      ! zcoefh, zu1 et zv1. Pour l'instant nous avons moyenné les valeurs      ! créés : "zcoefh", "zu1" et "zv1". Pour l'instant nous avons
30      ! de ces trois champs sur les 4 sous-surfaces du modèle. Dans l'avenir      ! moyenné les valeurs de ces trois champs sur les 4 sous-surfaces
31      ! si les informations des sous-surfaces doivent être prises en compte      ! du modèle. Dans l'avenir, si les informations des sous-surfaces
32      ! il faudra sortir ces mêmes champs en leur ajoutant une dimension,      ! doivent être prises en compte, il faudra sortir ces mêmes champs
33      ! c'est a dire nbsrf (nombre de sous-surfaces).      ! en leur ajoutant une dimension, c'est-à-dire "nbsrf" (nombre de
34        ! sous-surfaces).
35    
36      ! Auteur Z.X. Li (LMD/CNRS) date: 1993/08/18      use calendar, ONLY : ymds2ju
37      ! Objet : interface de "couche limite" (diffusion verticale)      use clqh_m, only: clqh
38        use coefkz_m, only: coefkz
39        use coefkzmin_m, only: coefkzmin
40        USE conf_phys_m, ONLY : iflag_pbl
41        USE dimens_m, ONLY : iim, jjm
42        USE dimphy, ONLY : klev, klon, zmasq
43        USE dimsoil, ONLY : nsoilmx
44        USE dynetat0_m, ONLY : day_ini
45        USE gath_cpl, ONLY : gath2cpl
46        use hbtm_m, only: hbtm
47        USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync
48        use histwrite_m, only: histwrite
49        USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
50        USE iniprint, ONLY : prt_level
51        USE suphec_m, ONLY : rd, rg, rkappa
52        USE temps, ONLY : annee_ref, itau_phy
53        use yamada4_m, only: yamada4
54    
55      ! Arguments:      ! Arguments:
56      ! dtime----input-R- interval du temps (secondes)  
57      ! itap-----input-I- numero du pas de temps      REAL, INTENT (IN) :: dtime ! interval du temps (secondes)
58        REAL date0
59      ! date0----input-R- jour initial      ! date0----input-R- jour initial
60        INTEGER, INTENT (IN) :: itap
61        ! itap-----input-I- numero du pas de temps
62        REAL t(klon, klev), q(klon, klev)
63      ! t--------input-R- temperature (K)      ! t--------input-R- temperature (K)
64      ! q--------input-R- vapeur d'eau (kg/kg)      ! q--------input-R- vapeur d'eau (kg/kg)
65        REAL, INTENT (IN):: u(klon, klev), v(klon, klev)
66      ! u--------input-R- vitesse u      ! u--------input-R- vitesse u
67      ! v--------input-R- vitesse v      ! v--------input-R- vitesse v
68      ! ts-------input-R- temperature du sol (en Kelvin)      REAL, INTENT (IN):: paprs(klon, klev+1)
69      ! paprs----input-R- pression a intercouche (Pa)      ! paprs----input-R- pression a intercouche (Pa)
70        REAL, INTENT (IN):: pplay(klon, klev)
71      ! pplay----input-R- pression au milieu de couche (Pa)      ! pplay----input-R- pression au milieu de couche (Pa)
72      ! radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2      REAL, INTENT (IN):: rlon(klon), rlat(klon)
73      ! rlat-----input-R- latitude en degree      ! rlat-----input-R- latitude en degree
74      ! rugos----input-R- longeur de rugosite (en m)      REAL cufi(klon), cvfi(klon)
75      ! cufi-----input-R- resolution des mailles en x (m)      ! cufi-----input-R- resolution des mailles en x (m)
76      ! cvfi-----input-R- resolution des mailles en y (m)      ! cvfi-----input-R- resolution des mailles en y (m)
77        REAL d_t(klon, klev), d_q(klon, klev)
78      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
79      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
80        REAL d_u(klon, klev), d_v(klon, klev)
81      ! d_u------output-R- le changement pour "u"      ! d_u------output-R- le changement pour "u"
82      ! d_v------output-R- le changement pour "v"      ! d_v------output-R- le changement pour "v"
83      ! d_ts-----output-R- le changement pour "ts"      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
84      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
85      !                    (orientation positive vers le bas)      !                    (orientation positive vers le bas)
86      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
87      ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal      REAL dflux_t(klon), dflux_q(klon)
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
88      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
89      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
90      !IM "slab" ocean      !IM "slab" ocean
91        REAL flux_o(klon), flux_g(klon)
92        !IM "slab" ocean
93      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')
94      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')
95        REAL y_flux_o(klon), y_flux_g(klon)
96        REAL tslab(klon), ytslab(klon)
97      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
98      ! uniqmnt pour slab      ! uniqmnt pour slab
99        REAL seaice(klon), y_seaice(klon)
100      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')
101      !cc      REAL y_fqcalving(klon), y_ffonte(klon)
102        REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
103      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
104      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
105      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
     ! on rajoute en output yu1 et yv1 qui sont les vents dans  
     ! la premiere couche  
     ! ces 4 variables sont maintenant traites dans phytrac  
     ! itr--------input-I- nombre de traceurs  
     ! tr---------input-R- q. de traceurs  
     ! flux_surf--input-R- flux de traceurs a la surface  
     ! d_tr-------output-R tendance de traceurs  
     !IM cf. AM : PBL  
     ! trmb1-------deep_cape  
     ! trmb2--------inhibition  
     ! trmb3-------Point Omega  
     ! Cape(klon)-------Cape du thermique  
     ! EauLiq(klon)-------Eau liqu integr du thermique  
     ! ctei(klon)-------Critere d'instab d'entrainmt des nuages de CL  
     ! lcl------- Niveau de condensation  
     ! pblh------- HCL  
     ! pblT------- T au nveau HCL  
   
     USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync  
     use histwrite_m, only: histwrite  
     use calendar, ONLY : ymds2ju  
     USE dimens_m, ONLY : iim, jjm  
     USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf  
     USE dimphy, ONLY : klev, klon, zmasq  
     USE dimsoil, ONLY : nsoilmx  
     USE temps, ONLY : annee_ref, itau_phy  
     USE dynetat0_m, ONLY : day_ini  
     USE iniprint, ONLY : prt_level  
     USE suphec_m, ONLY : rd, rg, rkappa  
     USE conf_phys_m, ONLY : iflag_pbl  
     USE gath_cpl, ONLY : gath2cpl  
     use hbtm_m, only: hbtm  
   
     REAL, INTENT (IN) :: dtime  
     REAL date0  
     INTEGER, INTENT (IN) :: itap  
     REAL t(klon, klev), q(klon, klev)  
     REAL u(klon, klev), v(klon, klev)  
     REAL, INTENT (IN) :: paprs(klon, klev+1)  
     REAL, INTENT (IN) :: pplay(klon, klev)  
     REAL, INTENT (IN) :: rlon(klon), rlat(klon)  
     REAL cufi(klon), cvfi(klon)  
     REAL d_t(klon, klev), d_q(klon, klev)  
     REAL d_u(klon, klev), d_v(klon, klev)  
     REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)  
     REAL dflux_t(klon), dflux_q(klon)  
     !IM "slab" ocean  
     REAL flux_o(klon), flux_g(klon)  
     REAL y_flux_o(klon), y_flux_g(klon)  
     REAL tslab(klon), ytslab(klon)  
     REAL seaice(klon), y_seaice(klon)  
     REAL y_fqcalving(klon), y_ffonte(klon)  
     REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
106      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)
107    
108      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
109        ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
110        ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
111      REAL rugmer(klon), agesno(klon, nbsrf)      REAL rugmer(klon), agesno(klon, nbsrf)
112      REAL, INTENT (IN) :: rugoro(klon)      REAL, INTENT (IN) :: rugoro(klon)
113      REAL cdragh(klon), cdragm(klon)      REAL cdragh(klon), cdragm(klon)
# Line 146  contains Line 124  contains
124    
125      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
126      REAL ts(klon, nbsrf)      REAL ts(klon, nbsrf)
127        ! ts-------input-R- temperature du sol (en Kelvin)
128      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
129        ! d_ts-----output-R- le changement pour "ts"
130      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
131      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
132      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
# Line 160  contains Line 140  contains
140    
141      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)
142      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
143        ! rugos----input-R- longeur de rugosite (en m)
144      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
145      REAL pctsrf_new(klon, nbsrf)      REAL pctsrf_new(klon, nbsrf)
146    
# Line 179  contains Line 160  contains
160      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
161      REAL qsol(klon)      REAL qsol(klon)
162    
163      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac      EXTERNAL clvent, calbeta, cltrac
164    
165      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
166      REAL yalb(klon)      REAL yalb(klon)
167      REAL yalblw(klon)      REAL yalblw(klon)
168      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
169        ! on rajoute en output yu1 et yv1 qui sont les vents dans
170        ! la premiere couche
171      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)
172      REAL yrain_f(klon), ysnow_f(klon)      REAL yrain_f(klon), ysnow_f(klon)
173      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)
# Line 208  contains Line 191  contains
191      PARAMETER (ok_nonloc=.FALSE.)      PARAMETER (ok_nonloc=.FALSE.)
192      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
193    
     !IM 081204 hcl_Anne ? BEG  
194      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
195      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
196      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
197      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)
198      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
     !IM 081204 hcl_Anne ? END  
199    
200      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
201      REAL delp(klon, klev)      REAL delp(klon, klev)
202      INTEGER i, k, nsrf      INTEGER i, k, nsrf
203    
204      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
205      ! Introduction d'une variable "pourcentage potentiel" pour tenir compte  
     ! des eventuelles apparitions et/ou disparitions de la glace de mer  
206      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
207        ! "pourcentage potentiel" pour tenir compte des éventuelles
208        ! apparitions ou disparitions de la glace de mer
209    
210      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
211    
# Line 259  contains Line 241  contains
241      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds
242      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! physiq ce qui permet de sortir les grdeurs par sous surface)
243      REAL pblh(klon, nbsrf)      REAL pblh(klon, nbsrf)
244        ! pblh------- HCL
245      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
246      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
247      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
248      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
249      REAL pblt(klon, nbsrf)      REAL pblt(klon, nbsrf)
250        ! pblT------- T au nveau HCL
251      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
252      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
253        ! trmb1-------deep_cape
254      REAL trmb2(klon, nbsrf)      REAL trmb2(klon, nbsrf)
255        ! trmb2--------inhibition
256      REAL trmb3(klon, nbsrf)      REAL trmb3(klon, nbsrf)
257        ! trmb3-------Point Omega
258      REAL ypblh(klon)      REAL ypblh(klon)
259      REAL ylcl(klon)      REAL ylcl(klon)
260      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 298  contains Line 285  contains
285    
286      !------------------------------------------------------------      !------------------------------------------------------------
287    
     ! initialisation Anne  
288      ytherm = 0.      ytherm = 0.
289    
290      IF (debugindex .AND. first_appel) THEN      IF (debugindex .AND. first_appel) THEN
# Line 307  contains Line 293  contains
293         ! initialisation sorties netcdf         ! initialisation sorties netcdf
294    
295         idayref = day_ini         idayref = day_ini
296         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)         CALL ymds2ju(annee_ref, 1, idayref, 0., zjulian)
297         CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)         CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)
298         DO i = 1, iim         DO i = 1, iim
299            zx_lon(i, 1) = rlon(i+1)            zx_lon(i, 1) = rlon(i+1)
# Line 342  contains Line 328  contains
328         v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2         v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2
329      END DO      END DO
330    
331      ! initialisation:      ! Initialization:
332        rugmer = 0.
333      DO i = 1, klon      cdragh = 0.
334         rugmer(i) = 0.0      cdragm = 0.
335         cdragh(i) = 0.0      dflux_t = 0.
336         cdragm(i) = 0.0      dflux_q = 0.
337         dflux_t(i) = 0.0      zu1 = 0.
338         dflux_q(i) = 0.0      zv1 = 0.
339         zu1(i) = 0.0      ypct = 0.
340         zv1(i) = 0.0      yts = 0.
341      END DO      ysnow = 0.
342      ypct = 0.0      yqsurf = 0.
343      yts = 0.0      yalb = 0.
344      ysnow = 0.0      yalblw = 0.
345      yqsurf = 0.0      yrain_f = 0.
346      yalb = 0.0      ysnow_f = 0.
347      yalblw = 0.0      yfder = 0.
348      yrain_f = 0.0      ytaux = 0.
349      ysnow_f = 0.0      ytauy = 0.
350      yfder = 0.0      ysolsw = 0.
351      ytaux = 0.0      ysollw = 0.
352      ytauy = 0.0      ysollwdown = 0.
353      ysolsw = 0.0      yrugos = 0.
354      ysollw = 0.0      yu1 = 0.
355      ysollwdown = 0.0      yv1 = 0.
356      yrugos = 0.0      yrads = 0.
357      yu1 = 0.0      ypaprs = 0.
358      yv1 = 0.0      ypplay = 0.
359      yrads = 0.0      ydelp = 0.
360      ypaprs = 0.0      yu = 0.
361      ypplay = 0.0      yv = 0.
362      ydelp = 0.0      yt = 0.
363      yu = 0.0      yq = 0.
364      yv = 0.0      pctsrf_new = 0.
365      yt = 0.0      y_flux_u = 0.
366      yq = 0.0      y_flux_v = 0.
     pctsrf_new = 0.0  
     y_flux_u = 0.0  
     y_flux_v = 0.0  
367      !$$ PB      !$$ PB
368      y_dflux_t = 0.0      y_dflux_t = 0.
369      y_dflux_q = 0.0      y_dflux_q = 0.
370      ytsoil = 999999.      ytsoil = 999999.
371      yrugoro = 0.      yrugoro = 0.
372      ! -- LOOP      ! -- LOOP
373      yu10mx = 0.0      yu10mx = 0.
374      yu10my = 0.0      yu10my = 0.
375      ywindsp = 0.0      ywindsp = 0.
376      ! -- LOOP      ! -- LOOP
377      DO nsrf = 1, nbsrf      d_ts = 0.
        DO i = 1, klon  
           d_ts(i, nsrf) = 0.0  
        END DO  
     END DO  
378      !§§§ PB      !§§§ PB
379      yfluxlat = 0.      yfluxlat = 0.
380      flux_t = 0.      flux_t = 0.
381      flux_q = 0.      flux_q = 0.
382      flux_u = 0.      flux_u = 0.
383      flux_v = 0.      flux_v = 0.
384      DO k = 1, klev      d_t = 0.
385         DO i = 1, klon      d_q = 0.
386            d_t(i, k) = 0.0      d_u = 0.
387            d_q(i, k) = 0.0      d_v = 0.
388            d_u(i, k) = 0.0      zcoefh = 0.
           d_v(i, k) = 0.0  
           zcoefh(i, k) = 0.0  
        END DO  
     END DO  
389    
390      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
391    
# Line 422  contains Line 397  contains
397      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
398      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
399    
400      DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
401         ! chercher les indices:         ! Chercher les indices :
402         ni = 0         ni = 0
403         knon = 0         knon = 0
404         DO i = 1, klon         DO i = 1, klon
405            ! pour determiner le domaine a traiter on utilise les surfaces            ! Pour déterminer le domaine à traiter, on utilise les surfaces
406            ! "potentielles"            ! "potentielles"
407            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
408               knon = knon + 1               knon = knon + 1
# Line 447  contains Line 422  contains
422            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)
423         END IF         END IF
424    
425         IF (knon==0) CYCLE         IF (knon == 0) CYCLE
426    
427         DO j = 1, knon         DO j = 1, knon
428            i = ni(j)            i = ni(j)
# Line 479  contains Line 454  contains
454            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
455         END DO         END DO
456    
457         !     IF bucket model for continent, copy soil water content         ! IF bucket model for continent, copy soil water content
458         IF (nsrf==is_ter .AND. .NOT. ok_veget) THEN         IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN
459            DO j = 1, knon            DO j = 1, knon
460               i = ni(j)               i = ni(j)
461               yqsol(j) = qsol(i)               yqsol(j) = qsol(i)
# Line 511  contains Line 486  contains
486         ! calculer Cdrag et les coefficients d'echange         ! calculer Cdrag et les coefficients d'echange
487         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&
488              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)
489         !IM 081204 BEG         IF (iflag_pbl == 1) THEN
        !CR test  
        IF (iflag_pbl==1) THEN  
           !IM 081204 END  
490            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
491            DO k = 1, klev            DO k = 1, klev
492               DO i = 1, knon               DO i = 1, knon
# Line 524  contains Line 496  contains
496            END DO            END DO
497         END IF         END IF
498    
499         !IM cf JLD : on seuille ycoefm et ycoefh         ! on seuille ycoefm et ycoefh
500         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
501            DO j = 1, knon            DO j = 1, knon
              !           ycoefm(j, 1)=min(ycoefm(j, 1), 1.1E-3)  
502               ycoefm(j, 1) = min(ycoefm(j, 1), cdmmax)               ycoefm(j, 1) = min(ycoefm(j, 1), cdmmax)
              !           ycoefh(j, 1)=min(ycoefh(j, 1), 1.1E-3)  
503               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)
504            END DO            END DO
505         END IF         END IF
506    
        !IM: 261103  
507         IF (ok_kzmin) THEN         IF (ok_kzmin) THEN
508            !IM cf FH: 201103 BEG            ! Calcul d'une diffusion minimale pour les conditions tres stables
509            !   Calcul d'une diffusion minimale pour les conditions tres stables.            CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm(:, 1), &
           CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm, &  
510                 ycoefm0, ycoefh0)                 ycoefm0, ycoefh0)
511    
512            IF (1==1) THEN            DO k = 1, klev
513               DO k = 1, klev               DO i = 1, knon
514                  DO i = 1, knon                  ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))
515                     ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))                  ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k))
                    ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k))  
                 END DO  
516               END DO               END DO
517            END IF            END DO
518            !IM cf FH: 201103 END         END IF
           !IM: 261103  
        END IF !ok_kzmin  
519    
520         IF (iflag_pbl>=3) THEN         IF (iflag_pbl >= 3) THEN
521            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin
522            yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, &            yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, &
523                 1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg                 1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg
# Line 579  contains Line 543  contains
543               END DO               END DO
544            END DO            END DO
545    
546            !   Bug introduit volontairement pour converger avec les resultats            y_cd_m(1:knon) = ycoefm(1:knon, 1)
547            !  du papier sur les thermiques.            y_cd_h(1:knon) = ycoefh(1:knon, 1)
           IF (1==1) THEN  
              y_cd_m(1:knon) = ycoefm(1:knon, 1)  
              y_cd_h(1:knon) = ycoefh(1:knon, 1)  
           ELSE  
              y_cd_h(1:knon) = ycoefm(1:knon, 1)  
              y_cd_m(1:knon) = ycoefh(1:knon, 1)  
           END IF  
548            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)
549    
550            IF (prt_level>9) THEN            IF (prt_level>9) THEN
551               PRINT *, 'USTAR = ', yustar               PRINT *, 'USTAR = ', yustar
552            END IF            END IF
553    
554            !   iflag_pbl peut etre utilise comme longuer de melange            ! iflag_pbl peut être utilisé comme longueur de mélange
555    
556            IF (iflag_pbl>=11) THEN            IF (iflag_pbl >= 11) THEN
557               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &
558                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &
559                    iflag_pbl)                    iflag_pbl)
560            ELSE            ELSE
561               CALL yamada4(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, yu, &               CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
562                    yv, yteta, y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                    y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
563            END IF            END IF
564    
565            ycoefm(1:knon, 1) = y_cd_m(1:knon)            ycoefm(1:knon, 1) = y_cd_m(1:knon)
# Line 621  contains Line 578  contains
578         ytaux = y_flux_u(:, 1)         ytaux = y_flux_u(:, 1)
579         ytauy = y_flux_v(:, 1)         ytauy = y_flux_v(:, 1)
580    
        ! FH modif sur le cdrag temperature  
        !$$$PB : déplace dans clcdrag  
        !$$$      do i=1, knon  
        !$$$         ycoefh(i, 1)=ycoefm(i, 1)*0.8  
        !$$$      enddo  
   
581         ! calculer la diffusion de "q" et de "h"         ! calculer la diffusion de "q" et de "h"
582         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&
583              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&
# Line 641  contains Line 592  contains
592    
593         ! calculer la longueur de rugosite sur ocean         ! calculer la longueur de rugosite sur ocean
594         yrugm = 0.         yrugm = 0.
595         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
596            DO j = 1, knon            DO j = 1, knon
597               yrugm(j) = 0.018*ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &               yrugm(j) = 0.018*ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &
598                    0.11*14E-6/sqrt(ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2))                    0.11*14E-6/sqrt(ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2))
# Line 662  contains Line 613  contains
613               ycoefm(j, k) = ycoefm(j, k)*ypct(j)               ycoefm(j, k) = ycoefm(j, k)*ypct(j)
614               y_d_t(j, k) = y_d_t(j, k)*ypct(j)               y_d_t(j, k) = y_d_t(j, k)*ypct(j)
615               y_d_q(j, k) = y_d_q(j, k)*ypct(j)               y_d_q(j, k) = y_d_q(j, k)*ypct(j)
              !§§§ PB  
616               flux_t(i, k, nsrf) = y_flux_t(j, k)               flux_t(i, k, nsrf) = y_flux_t(j, k)
617               flux_q(i, k, nsrf) = y_flux_q(j, k)               flux_q(i, k, nsrf) = y_flux_q(j, k)
618               flux_u(i, k, nsrf) = y_flux_u(j, k)               flux_u(i, k, nsrf) = y_flux_u(j, k)
619               flux_v(i, k, nsrf) = y_flux_v(j, k)               flux_v(i, k, nsrf) = y_flux_v(j, k)
              !$$$ PB        y_flux_t(j, k) = y_flux_t(j, k) * ypct(j)  
              !$$$ PB        y_flux_q(j, k) = y_flux_q(j, k) * ypct(j)  
620               y_d_u(j, k) = y_d_u(j, k)*ypct(j)               y_d_u(j, k) = y_d_u(j, k)*ypct(j)
621               y_d_v(j, k) = y_d_v(j, k)*ypct(j)               y_d_v(j, k) = y_d_v(j, k)*ypct(j)
              !$$$ PB        y_flux_u(j, k) = y_flux_u(j, k) * ypct(j)  
              !$$$ PB        y_flux_v(j, k) = y_flux_v(j, k) * ypct(j)  
622            END DO            END DO
623         END DO         END DO
624    
# Line 693  contains Line 639  contains
639            qsurf(i, nsrf) = yqsurf(j)            qsurf(i, nsrf) = yqsurf(j)
640            rugos(i, nsrf) = yz0_new(j)            rugos(i, nsrf) = yz0_new(j)
641            fluxlat(i, nsrf) = yfluxlat(j)            fluxlat(i, nsrf) = yfluxlat(j)
642            !$$$ pb         rugmer(i) = yrugm(j)            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
643               rugmer(i) = yrugm(j)               rugmer(i) = yrugm(j)
644               rugos(i, nsrf) = yrugm(j)               rugos(i, nsrf) = yrugm(j)
645            END IF            END IF
           !IM cf JLD ??  
646            agesno(i, nsrf) = yagesno(j)            agesno(i, nsrf) = yagesno(j)
647            fqcalving(i, nsrf) = y_fqcalving(j)            fqcalving(i, nsrf) = y_fqcalving(j)
648            ffonte(i, nsrf) = y_ffonte(j)            ffonte(i, nsrf) = y_ffonte(j)
# Line 709  contains Line 653  contains
653            zu1(i) = zu1(i) + yu1(j)            zu1(i) = zu1(i) + yu1(j)
654            zv1(i) = zv1(i) + yv1(j)            zv1(i) = zv1(i) + yv1(j)
655         END DO         END DO
656         IF (nsrf==is_ter) THEN         IF (nsrf == is_ter) THEN
657            DO j = 1, knon            DO j = 1, knon
658               i = ni(j)               i = ni(j)
659               qsol(i) = yqsol(j)               qsol(i) = yqsol(j)
660            END DO            END DO
661         END IF         END IF
662         IF (nsrf==is_lic) THEN         IF (nsrf == is_lic) THEN
663            DO j = 1, knon            DO j = 1, knon
664               i = ni(j)               i = ni(j)
665               run_off_lic_0(i) = y_run_off_lic_0(j)               run_off_lic_0(i) = y_run_off_lic_0(j)
# Line 735  contains Line 679  contains
679            DO k = 1, klev            DO k = 1, klev
680               d_t(i, k) = d_t(i, k) + y_d_t(j, k)               d_t(i, k) = d_t(i, k) + y_d_t(j, k)
681               d_q(i, k) = d_q(i, k) + y_d_q(j, k)               d_q(i, k) = d_q(i, k) + y_d_q(j, k)
              !$$$ PB        flux_t(i, k) = flux_t(i, k) + y_flux_t(j, k)  
              !$$$         flux_q(i, k) = flux_q(i, k) + y_flux_q(j, k)  
682               d_u(i, k) = d_u(i, k) + y_d_u(j, k)               d_u(i, k) = d_u(i, k) + y_d_u(j, k)
683               d_v(i, k) = d_v(i, k) + y_d_v(j, k)               d_v(i, k) = d_v(i, k) + y_d_v(j, k)
              !$$$  PB       flux_u(i, k) = flux_u(i, k) + y_flux_u(j, k)  
              !$$$         flux_v(i, k) = flux_v(i, k) + y_flux_v(j, k)  
684               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)
685            END DO            END DO
686         END DO         END DO
# Line 757  contains Line 697  contains
697                 1)))*(ypaprs(j, 1)-ypplay(j, 1))                 1)))*(ypaprs(j, 1)-ypplay(j, 1))
698            tairsol(j) = yts(j) + y_d_ts(j)            tairsol(j) = yts(j) + y_d_ts(j)
699            rugo1(j) = yrugos(j)            rugo1(j) = yrugos(j)
700            IF (nsrf==is_oce) THEN            IF (nsrf == is_oce) THEN
701               rugo1(j) = rugos(i, nsrf)               rugo1(j) = rugos(i, nsrf)
702            END IF            END IF
703            psfce(j) = ypaprs(j, 1)            psfce(j) = ypaprs(j, 1)
# Line 769  contains Line 709  contains
709         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &
710              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &
711              yu10m, yustar)              yu10m, yustar)
        !IM 081204 END  
712    
713         DO j = 1, knon         DO j = 1, knon
714            i = ni(j)            i = ni(j)
# Line 811  contains Line 750  contains
750            END DO            END DO
751         END DO         END DO
752         !IM "slab" ocean         !IM "slab" ocean
753         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
754            DO j = 1, knon            DO j = 1, knon
755               ! on projette sur la grille globale               ! on projette sur la grille globale
756               i = ni(j)               i = ni(j)
# Line 823  contains Line 762  contains
762            END DO            END DO
763         END IF         END IF
764    
765         IF (nsrf==is_sic) THEN         IF (nsrf == is_sic) THEN
766            DO j = 1, knon            DO j = 1, knon
767               i = ni(j)               i = ni(j)
768               ! On pondère lorsque l'on fait le bilan au sol :               ! On pondère lorsque l'on fait le bilan au sol :
              ! flux_g(i) = y_flux_g(j)*ypct(j)  
769               IF (pctsrf_new(i, is_sic)>epsfra) THEN               IF (pctsrf_new(i, is_sic)>epsfra) THEN
770                  flux_g(i) = y_flux_g(j)                  flux_g(i) = y_flux_g(j)
771               ELSE               ELSE
# Line 836  contains Line 774  contains
774            END DO            END DO
775    
776         END IF         END IF
777         !nsrf.EQ.is_sic                                                     IF (ocean == 'slab  ') THEN
778         IF (ocean=='slab  ') THEN            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
779               tslab(1:klon) = ytslab(1:klon)               tslab(1:klon) = ytslab(1:klon)
780               seaice(1:klon) = y_seaice(1:klon)               seaice(1:klon) = y_seaice(1:klon)
              !nsrf                                                        
781            END IF            END IF
           !OCEAN                                                        
782         END IF         END IF
783      END DO      END DO loop_surface
784    
785      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
     ! A rajouter: conservation de l'albedo  
786    
787      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
788      pctsrf = pctsrf_new      pctsrf = pctsrf_new
Legend:
Removed from v.38  
changed lines
  Added in v.49
  ViewVC Help
Powered by ViewVC 1.1.21