/[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 61 by guez, Fri Apr 20 14:58:43 2012 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 histsync_m, ONLY : histsync
48        USE histbeg_totreg_m, ONLY : histbeg_totreg
49        USE histend_m, ONLY : histend
50        USE histdef_m, ONLY : histdef
51        use histwrite_m, only: histwrite
52        USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
53        USE conf_gcm_m, ONLY : prt_level
54        USE suphec_m, ONLY : rd, rg, rkappa
55        USE temps, ONLY : annee_ref, itau_phy
56        use yamada4_m, only: yamada4
57    
58      ! Arguments:      ! Arguments:
59      ! dtime----input-R- interval du temps (secondes)  
60      ! itap-----input-I- numero du pas de temps      REAL, INTENT (IN) :: dtime ! interval du temps (secondes)
61        REAL date0
62      ! date0----input-R- jour initial      ! date0----input-R- jour initial
63        INTEGER, INTENT (IN) :: itap
64        ! itap-----input-I- numero du pas de temps
65        REAL, INTENT(IN):: t(klon, klev), q(klon, klev)
66      ! t--------input-R- temperature (K)      ! t--------input-R- temperature (K)
67      ! q--------input-R- vapeur d'eau (kg/kg)      ! q--------input-R- vapeur d'eau (kg/kg)
68        REAL, INTENT (IN):: u(klon, klev), v(klon, klev)
69      ! u--------input-R- vitesse u      ! u--------input-R- vitesse u
70      ! v--------input-R- vitesse v      ! v--------input-R- vitesse v
71      ! ts-------input-R- temperature du sol (en Kelvin)      REAL, INTENT (IN):: paprs(klon, klev+1)
72      ! paprs----input-R- pression a intercouche (Pa)      ! paprs----input-R- pression a intercouche (Pa)
73        REAL, INTENT (IN):: pplay(klon, klev)
74      ! pplay----input-R- pression au milieu de couche (Pa)      ! pplay----input-R- pression au milieu de couche (Pa)
75      ! radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2      REAL, INTENT (IN):: rlon(klon), rlat(klon)
76      ! rlat-----input-R- latitude en degree      ! rlat-----input-R- latitude en degree
77      ! rugos----input-R- longeur de rugosite (en m)      REAL cufi(klon), cvfi(klon)
78      ! cufi-----input-R- resolution des mailles en x (m)      ! cufi-----input-R- resolution des mailles en x (m)
79      ! cvfi-----input-R- resolution des mailles en y (m)      ! cvfi-----input-R- resolution des mailles en y (m)
80        REAL d_t(klon, klev), d_q(klon, klev)
81      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
82      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
83        REAL d_u(klon, klev), d_v(klon, klev)
84      ! d_u------output-R- le changement pour "u"      ! d_u------output-R- le changement pour "u"
85      ! d_v------output-R- le changement pour "v"      ! d_v------output-R- le changement pour "v"
86      ! d_ts-----output-R- le changement pour "ts"      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
87      ! 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)
88      !                    (orientation positive vers le bas)      !                    (orientation positive vers le bas)
89      ! 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)
90      ! 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  
91      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
92      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
93      !IM "slab" ocean      !IM "slab" ocean
94        REAL flux_o(klon), flux_g(klon)
95        !IM "slab" ocean
96      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')
97      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')
98        REAL y_flux_o(klon), y_flux_g(klon)
99        REAL tslab(klon), ytslab(klon)
100      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
101      ! uniqmnt pour slab      ! uniqmnt pour slab
102        REAL seaice(klon), y_seaice(klon)
103      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')
104      !cc      REAL y_fqcalving(klon), y_ffonte(klon)
105        REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
106      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
107      ! 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
108      !           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)  
109      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)
110    
111      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
112        ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
113        ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
114      REAL rugmer(klon), agesno(klon, nbsrf)      REAL rugmer(klon), agesno(klon, nbsrf)
115      REAL, INTENT (IN) :: rugoro(klon)      REAL, INTENT (IN) :: rugoro(klon)
116      REAL cdragh(klon), cdragm(klon)      REAL cdragh(klon), cdragm(klon)
# Line 146  contains Line 127  contains
127    
128      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
129      REAL ts(klon, nbsrf)      REAL ts(klon, nbsrf)
130        ! ts-------input-R- temperature du sol (en Kelvin)
131      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
132        ! d_ts-----output-R- le changement pour "ts"
133      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
134      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
135      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
# Line 160  contains Line 143  contains
143    
144      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)
145      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
146        ! rugos----input-R- longeur de rugosite (en m)
147      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
148      REAL pctsrf_new(klon, nbsrf)      REAL pctsrf_new(klon, nbsrf)
149    
# Line 179  contains Line 163  contains
163      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
164      REAL qsol(klon)      REAL qsol(klon)
165    
166      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac      EXTERNAL clvent, calbeta, cltrac
167    
168      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
169      REAL yalb(klon)      REAL yalb(klon)
170      REAL yalblw(klon)      REAL yalblw(klon)
171      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
172        ! on rajoute en output yu1 et yv1 qui sont les vents dans
173        ! la premiere couche
174      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)
175      REAL yrain_f(klon), ysnow_f(klon)      REAL yrain_f(klon), ysnow_f(klon)
176      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)
# Line 208  contains Line 194  contains
194      PARAMETER (ok_nonloc=.FALSE.)      PARAMETER (ok_nonloc=.FALSE.)
195      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
196    
     !IM 081204 hcl_Anne ? BEG  
197      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
198      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
199      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
200      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)
201      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
     !IM 081204 hcl_Anne ? END  
202    
203      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
204      REAL delp(klon, klev)      REAL delp(klon, klev)
205      INTEGER i, k, nsrf      INTEGER i, k, nsrf
206    
207      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
208      ! Introduction d'une variable "pourcentage potentiel" pour tenir compte  
     ! des eventuelles apparitions et/ou disparitions de la glace de mer  
209      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
210        ! "pourcentage potentiel" pour tenir compte des éventuelles
211        ! apparitions ou disparitions de la glace de mer
212    
213      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
214    
# Line 259  contains Line 244  contains
244      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds
245      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! physiq ce qui permet de sortir les grdeurs par sous surface)
246      REAL pblh(klon, nbsrf)      REAL pblh(klon, nbsrf)
247        ! pblh------- HCL
248      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
249      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
250      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
251      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
252      REAL pblt(klon, nbsrf)      REAL pblt(klon, nbsrf)
253        ! pblT------- T au nveau HCL
254      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
255      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
256        ! trmb1-------deep_cape
257      REAL trmb2(klon, nbsrf)      REAL trmb2(klon, nbsrf)
258        ! trmb2--------inhibition
259      REAL trmb3(klon, nbsrf)      REAL trmb3(klon, nbsrf)
260        ! trmb3-------Point Omega
261      REAL ypblh(klon)      REAL ypblh(klon)
262      REAL ylcl(klon)      REAL ylcl(klon)
263      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 298  contains Line 288  contains
288    
289      !------------------------------------------------------------      !------------------------------------------------------------
290    
     ! initialisation Anne  
291      ytherm = 0.      ytherm = 0.
292    
293      IF (debugindex .AND. first_appel) THEN      IF (debugindex .AND. first_appel) THEN
# Line 307  contains Line 296  contains
296         ! initialisation sorties netcdf         ! initialisation sorties netcdf
297    
298         idayref = day_ini         idayref = day_ini
299         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)         CALL ymds2ju(annee_ref, 1, idayref, 0., zjulian)
300         CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)         CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)
301         DO i = 1, iim         DO i = 1, iim
302            zx_lon(i, 1) = rlon(i+1)            zx_lon(i, 1) = rlon(i+1)
# Line 342  contains Line 331  contains
331         v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2         v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2
332      END DO      END DO
333    
334      ! initialisation:      ! Initialization:
335        rugmer = 0.
336      DO i = 1, klon      cdragh = 0.
337         rugmer(i) = 0.0      cdragm = 0.
338         cdragh(i) = 0.0      dflux_t = 0.
339         cdragm(i) = 0.0      dflux_q = 0.
340         dflux_t(i) = 0.0      zu1 = 0.
341         dflux_q(i) = 0.0      zv1 = 0.
342         zu1(i) = 0.0      ypct = 0.
343         zv1(i) = 0.0      yts = 0.
344      END DO      ysnow = 0.
345      ypct = 0.0      yqsurf = 0.
346      yts = 0.0      yalb = 0.
347      ysnow = 0.0      yalblw = 0.
348      yqsurf = 0.0      yrain_f = 0.
349      yalb = 0.0      ysnow_f = 0.
350      yalblw = 0.0      yfder = 0.
351      yrain_f = 0.0      ytaux = 0.
352      ysnow_f = 0.0      ytauy = 0.
353      yfder = 0.0      ysolsw = 0.
354      ytaux = 0.0      ysollw = 0.
355      ytauy = 0.0      ysollwdown = 0.
356      ysolsw = 0.0      yrugos = 0.
357      ysollw = 0.0      yu1 = 0.
358      ysollwdown = 0.0      yv1 = 0.
359      yrugos = 0.0      yrads = 0.
360      yu1 = 0.0      ypaprs = 0.
361      yv1 = 0.0      ypplay = 0.
362      yrads = 0.0      ydelp = 0.
363      ypaprs = 0.0      yu = 0.
364      ypplay = 0.0      yv = 0.
365      ydelp = 0.0      yt = 0.
366      yu = 0.0      yq = 0.
367      yv = 0.0      pctsrf_new = 0.
368      yt = 0.0      y_flux_u = 0.
369      yq = 0.0      y_flux_v = 0.
     pctsrf_new = 0.0  
     y_flux_u = 0.0  
     y_flux_v = 0.0  
370      !$$ PB      !$$ PB
371      y_dflux_t = 0.0      y_dflux_t = 0.
372      y_dflux_q = 0.0      y_dflux_q = 0.
373      ytsoil = 999999.      ytsoil = 999999.
374      yrugoro = 0.      yrugoro = 0.
375      ! -- LOOP      ! -- LOOP
376      yu10mx = 0.0      yu10mx = 0.
377      yu10my = 0.0      yu10my = 0.
378      ywindsp = 0.0      ywindsp = 0.
379      ! -- LOOP      ! -- LOOP
380      DO nsrf = 1, nbsrf      d_ts = 0.
        DO i = 1, klon  
           d_ts(i, nsrf) = 0.0  
        END DO  
     END DO  
381      !§§§ PB      !§§§ PB
382      yfluxlat = 0.      yfluxlat = 0.
383      flux_t = 0.      flux_t = 0.
384      flux_q = 0.      flux_q = 0.
385      flux_u = 0.      flux_u = 0.
386      flux_v = 0.      flux_v = 0.
387      DO k = 1, klev      d_t = 0.
388         DO i = 1, klon      d_q = 0.
389            d_t(i, k) = 0.0      d_u = 0.
390            d_q(i, k) = 0.0      d_v = 0.
391            d_u(i, k) = 0.0      zcoefh = 0.
           d_v(i, k) = 0.0  
           zcoefh(i, k) = 0.0  
        END DO  
     END DO  
392    
393      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
394    
# Line 422  contains Line 400  contains
400      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
401      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
402    
403      DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
404         ! chercher les indices:         ! Chercher les indices :
405         ni = 0         ni = 0
406         knon = 0         knon = 0
407         DO i = 1, klon         DO i = 1, klon
408            ! pour determiner le domaine a traiter on utilise les surfaces            ! Pour déterminer le domaine à traiter, on utilise les surfaces
409            ! "potentielles"            ! "potentielles"
410            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
411               knon = knon + 1               knon = knon + 1
# Line 447  contains Line 425  contains
425            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)
426         END IF         END IF
427    
428         IF (knon==0) CYCLE         IF (knon == 0) CYCLE
429    
430         DO j = 1, knon         DO j = 1, knon
431            i = ni(j)            i = ni(j)
# Line 479  contains Line 457  contains
457            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
458         END DO         END DO
459    
460         !     IF bucket model for continent, copy soil water content         ! IF bucket model for continent, copy soil water content
461         IF (nsrf==is_ter .AND. .NOT. ok_veget) THEN         IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN
462            DO j = 1, knon            DO j = 1, knon
463               i = ni(j)               i = ni(j)
464               yqsol(j) = qsol(i)               yqsol(j) = qsol(i)
# Line 511  contains Line 489  contains
489         ! calculer Cdrag et les coefficients d'echange         ! calculer Cdrag et les coefficients d'echange
490         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&
491              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)
492         !IM 081204 BEG         IF (iflag_pbl == 1) THEN
        !CR test  
        IF (iflag_pbl==1) THEN  
           !IM 081204 END  
493            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
494            DO k = 1, klev            DO k = 1, klev
495               DO i = 1, knon               DO i = 1, knon
# Line 524  contains Line 499  contains
499            END DO            END DO
500         END IF         END IF
501    
502         !IM cf JLD : on seuille ycoefm et ycoefh         ! on seuille ycoefm et ycoefh
503         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
504            DO j = 1, knon            DO j = 1, knon
              !           ycoefm(j, 1)=min(ycoefm(j, 1), 1.1E-3)  
505               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)  
506               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)
507            END DO            END DO
508         END IF         END IF
509    
        !IM: 261103  
510         IF (ok_kzmin) THEN         IF (ok_kzmin) THEN
511            !IM cf FH: 201103 BEG            ! Calcul d'une diffusion minimale pour les conditions tres stables
512            !   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, &  
513                 ycoefm0, ycoefh0)                 ycoefm0, ycoefh0)
514    
515            IF (1==1) THEN            DO k = 1, klev
516               DO k = 1, klev               DO i = 1, knon
517                  DO i = 1, knon                  ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))
518                     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  
519               END DO               END DO
520            END IF            END DO
521            !IM cf FH: 201103 END         END IF
           !IM: 261103  
        END IF !ok_kzmin  
522    
523         IF (iflag_pbl>=3) THEN         IF (iflag_pbl >= 3) THEN
524            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin
525            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, &
526                 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 546  contains
546               END DO               END DO
547            END DO            END DO
548    
549            !   Bug introduit volontairement pour converger avec les resultats            y_cd_m(1:knon) = ycoefm(1:knon, 1)
550            !  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  
551            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)
552    
553            IF (prt_level>9) THEN            IF (prt_level>9) THEN
554               PRINT *, 'USTAR = ', yustar               PRINT *, 'USTAR = ', yustar
555            END IF            END IF
556    
557            !   iflag_pbl peut etre utilise comme longuer de melange            ! iflag_pbl peut être utilisé comme longueur de mélange
558    
559            IF (iflag_pbl>=11) THEN            IF (iflag_pbl >= 11) THEN
560               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &
561                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &
562                    iflag_pbl)                    iflag_pbl)
563            ELSE            ELSE
564               CALL yamada4(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, yu, &               CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
565                    yv, yteta, y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                    y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
566            END IF            END IF
567    
568            ycoefm(1:knon, 1) = y_cd_m(1:knon)            ycoefm(1:knon, 1) = y_cd_m(1:knon)
# Line 621  contains Line 581  contains
581         ytaux = y_flux_u(:, 1)         ytaux = y_flux_u(:, 1)
582         ytauy = y_flux_v(:, 1)         ytauy = y_flux_v(:, 1)
583    
        ! FH modif sur le cdrag temperature  
        !$$$PB : déplace dans clcdrag  
        !$$$      do i=1, knon  
        !$$$         ycoefh(i, 1)=ycoefm(i, 1)*0.8  
        !$$$      enddo  
   
584         ! calculer la diffusion de "q" et de "h"         ! calculer la diffusion de "q" et de "h"
585         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&
586              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&
# Line 641  contains Line 595  contains
595    
596         ! calculer la longueur de rugosite sur ocean         ! calculer la longueur de rugosite sur ocean
597         yrugm = 0.         yrugm = 0.
598         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
599            DO j = 1, knon            DO j = 1, knon
600               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 + &
601                    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 616  contains
616               ycoefm(j, k) = ycoefm(j, k)*ypct(j)               ycoefm(j, k) = ycoefm(j, k)*ypct(j)
617               y_d_t(j, k) = y_d_t(j, k)*ypct(j)               y_d_t(j, k) = y_d_t(j, k)*ypct(j)
618               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  
619               flux_t(i, k, nsrf) = y_flux_t(j, k)               flux_t(i, k, nsrf) = y_flux_t(j, k)
620               flux_q(i, k, nsrf) = y_flux_q(j, k)               flux_q(i, k, nsrf) = y_flux_q(j, k)
621               flux_u(i, k, nsrf) = y_flux_u(j, k)               flux_u(i, k, nsrf) = y_flux_u(j, k)
622               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)  
623               y_d_u(j, k) = y_d_u(j, k)*ypct(j)               y_d_u(j, k) = y_d_u(j, k)*ypct(j)
624               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)  
625            END DO            END DO
626         END DO         END DO
627    
# Line 693  contains Line 642  contains
642            qsurf(i, nsrf) = yqsurf(j)            qsurf(i, nsrf) = yqsurf(j)
643            rugos(i, nsrf) = yz0_new(j)            rugos(i, nsrf) = yz0_new(j)
644            fluxlat(i, nsrf) = yfluxlat(j)            fluxlat(i, nsrf) = yfluxlat(j)
645            !$$$ pb         rugmer(i) = yrugm(j)            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
646               rugmer(i) = yrugm(j)               rugmer(i) = yrugm(j)
647               rugos(i, nsrf) = yrugm(j)               rugos(i, nsrf) = yrugm(j)
648            END IF            END IF
           !IM cf JLD ??  
649            agesno(i, nsrf) = yagesno(j)            agesno(i, nsrf) = yagesno(j)
650            fqcalving(i, nsrf) = y_fqcalving(j)            fqcalving(i, nsrf) = y_fqcalving(j)
651            ffonte(i, nsrf) = y_ffonte(j)            ffonte(i, nsrf) = y_ffonte(j)
# Line 709  contains Line 656  contains
656            zu1(i) = zu1(i) + yu1(j)            zu1(i) = zu1(i) + yu1(j)
657            zv1(i) = zv1(i) + yv1(j)            zv1(i) = zv1(i) + yv1(j)
658         END DO         END DO
659         IF (nsrf==is_ter) THEN         IF (nsrf == is_ter) THEN
660            DO j = 1, knon            DO j = 1, knon
661               i = ni(j)               i = ni(j)
662               qsol(i) = yqsol(j)               qsol(i) = yqsol(j)
663            END DO            END DO
664         END IF         END IF
665         IF (nsrf==is_lic) THEN         IF (nsrf == is_lic) THEN
666            DO j = 1, knon            DO j = 1, knon
667               i = ni(j)               i = ni(j)
668               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 682  contains
682            DO k = 1, klev            DO k = 1, klev
683               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)
684               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)  
685               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)
686               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)  
687               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)
688            END DO            END DO
689         END DO         END DO
# Line 757  contains Line 700  contains
700                 1)))*(ypaprs(j, 1)-ypplay(j, 1))                 1)))*(ypaprs(j, 1)-ypplay(j, 1))
701            tairsol(j) = yts(j) + y_d_ts(j)            tairsol(j) = yts(j) + y_d_ts(j)
702            rugo1(j) = yrugos(j)            rugo1(j) = yrugos(j)
703            IF (nsrf==is_oce) THEN            IF (nsrf == is_oce) THEN
704               rugo1(j) = rugos(i, nsrf)               rugo1(j) = rugos(i, nsrf)
705            END IF            END IF
706            psfce(j) = ypaprs(j, 1)            psfce(j) = ypaprs(j, 1)
# Line 769  contains Line 712  contains
712         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &
713              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &
714              yu10m, yustar)              yu10m, yustar)
        !IM 081204 END  
715    
716         DO j = 1, knon         DO j = 1, knon
717            i = ni(j)            i = ni(j)
# Line 811  contains Line 753  contains
753            END DO            END DO
754         END DO         END DO
755         !IM "slab" ocean         !IM "slab" ocean
756         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
757            DO j = 1, knon            DO j = 1, knon
758               ! on projette sur la grille globale               ! on projette sur la grille globale
759               i = ni(j)               i = ni(j)
# Line 823  contains Line 765  contains
765            END DO            END DO
766         END IF         END IF
767    
768         IF (nsrf==is_sic) THEN         IF (nsrf == is_sic) THEN
769            DO j = 1, knon            DO j = 1, knon
770               i = ni(j)               i = ni(j)
771               ! 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)  
772               IF (pctsrf_new(i, is_sic)>epsfra) THEN               IF (pctsrf_new(i, is_sic)>epsfra) THEN
773                  flux_g(i) = y_flux_g(j)                  flux_g(i) = y_flux_g(j)
774               ELSE               ELSE
# Line 836  contains Line 777  contains
777            END DO            END DO
778    
779         END IF         END IF
780         !nsrf.EQ.is_sic                                                     IF (ocean == 'slab  ') THEN
781         IF (ocean=='slab  ') THEN            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
782               tslab(1:klon) = ytslab(1:klon)               tslab(1:klon) = ytslab(1:klon)
783               seaice(1:klon) = y_seaice(1:klon)               seaice(1:klon) = y_seaice(1:klon)
              !nsrf                                                        
784            END IF            END IF
           !OCEAN                                                        
785         END IF         END IF
786      END DO      END DO loop_surface
787    
788      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
     ! A rajouter: conservation de l'albedo  
789    
790      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
791      pctsrf = pctsrf_new      pctsrf = pctsrf_new
Legend:
Removed from v.38  
changed lines
  Added in v.61
  ViewVC Help
Powered by ViewVC 1.1.21