/[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

trunk/phylmd/clmain.f revision 104 by guez, Thu Sep 4 10:05:52 2014 UTC trunk/Sources/phylmd/clmain.f revision 221 by guez, Thu Apr 20 14:44:47 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)  
14    
15      ! 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
16      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
# Line 19  contains Line 18  contains
18    
19      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
20      ! de la couche limite pour les traceurs se fait avec "cltrac" et      ! de la couche limite pour les traceurs se fait avec "cltrac" et
21      ! ne tient pas compte de la différentiation des sous-fractions de      ! ne tient pas compte de la diff\'erentiation des sous-fractions
22      ! sol.      ! de sol.
23    
24      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
25      ! dans la première couche, trois champs ont été créés : "ycoefh",      ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
26      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
27      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du mod\`ele.
28    
29      use clqh_m, only: clqh      use clqh_m, only: clqh
30      use clvent_m, only: clvent      use clvent_m, only: clvent
31      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
32      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
33      USE conf_gcm_m, ONLY: prt_level      USE conf_gcm_m, ONLY: prt_level, lmt_pas
34      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
     USE dimens_m, ONLY: iim, jjm  
35      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
38      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
39        USE interfoce_lim_m, ONLY: interfoce_lim
40      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42        use time_phylmdz, only: itap
43      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
44      use vdif_kcay_m, only: vdif_kcay      use vdif_kcay_m, only: vdif_kcay
45      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
46    
47      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
     INTEGER, INTENT(IN):: itap ! numero du pas de temps  
     REAL, INTENT(inout):: pctsrf(klon, nbsrf)  
48    
49      ! la nouvelle repartition des surfaces sortie de l'interface      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50      REAL, INTENT(out):: pctsrf_new(klon, nbsrf)      ! tableau des pourcentages de surface de chaque maille
51    
52      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
54      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: julien ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temp\'erature du sol (en K)
     REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)  
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL, INTENT(IN):: ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
60      LOGICAL, INTENT(IN):: ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
61      REAL ftsoil(klon, nsoilmx, nbsrf)  
62        REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63        ! soil temperature of surface fraction
64    
65      REAL, INTENT(inout):: qsol(klon)      REAL, INTENT(inout):: qsol(klon)
66      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
67    
68      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
69      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70      REAL snow(klon, nbsrf)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
71      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
72      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
73      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
74      REAL alblw(klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
   
     REAL fluxlat(klon, nbsrf)  
75    
76      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
77      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg/m2/s), positive down
# Line 83  contains Line 80  contains
80      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
81    
82      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
83      REAL fder(klon)      REAL, intent(in):: fder(klon)
84      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
   
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
   
     LOGICAL, INTENT(IN):: debut  
85      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
86      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
87    
# Line 100  contains Line 92  contains
92      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
93      ! changement pour "u" et "v"      ! changement pour "u" et "v"
94    
95      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
96    
97        REAL, intent(out):: flux_t(klon, nbsrf)
98        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
99        ! le bas) à la surface
100    
101        REAL, intent(out):: flux_q(klon, nbsrf)
102        ! flux de vapeur d'eau (kg/m2/s) à la surface
103    
104      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
105      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! tension du vent à la surface, en Pa
     !                    (orientation positive vers le bas)  
     ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
   
     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)  
     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
106    
107      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
108      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 117  contains Line 110  contains
110      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
111      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
112      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
113      !IM "slab" ocean      ! IM "slab" ocean
114    
115      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
116      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
117      REAL zv1(klon)      REAL zv1(klon)
118      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
119      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
120    
121      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
122      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
123      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
124      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
125      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
126      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
127      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
128      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
129      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
130      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
131      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 148  contains Line 140  contains
140      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
141      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
142    
     REAL flux_o(klon), flux_g(klon)  
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
   
     REAL tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
   
143      ! Local:      ! Local:
144    
145      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
146      real ytslab(klon)  
147        ! la nouvelle repartition des surfaces sortie de l'interface
148        REAL, save:: pctsrf_new_oce(klon)
149        REAL, save:: pctsrf_new_sic(klon)
150    
151      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
152      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
153      REAL rugmer(klon)      REAL rugmer(klon)
   
154      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
155      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
156      REAL yalb(klon)      REAL yalb(klon)
157      REAL yalblw(klon)  
158      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
159      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! On ajoute en output yu1 et yv1 qui sont les vents dans
160      ! la premiere couche      ! la premi\`ere couche.
161      REAL ysnow(klon), yqsurf(klon), yagesno(klon)      
162        REAL snow(klon), yqsurf(klon), yagesno(klon)
163    
164      real yqsol(klon)      real yqsol(klon)
165      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
# Line 185  contains Line 170  contains
170      REAL ysnow_f(klon)      REAL ysnow_f(klon)
171      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
172    
     REAL ysollw(klon), ysolsw(klon)  
173      REAL yfder(klon)      REAL yfder(klon)
174      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
175      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
176      REAL y_d_ts(klon)      REAL y_d_ts(klon)
177      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
178      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
179      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
180      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
181      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
182      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
183      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 217  contains Line 199  contains
199      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
200    
201      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
202      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
203      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
204    
205      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
206    
207      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
208      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
209    
210      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
211      REAL ypblh(klon)      REAL ypblh(klon)
# Line 277  contains Line 254  contains
254      zu1 = 0.      zu1 = 0.
255      zv1 = 0.      zv1 = 0.
256      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
257      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
258      yrain_f = 0.      yrain_f = 0.
259      ysnow_f = 0.      ysnow_f = 0.
260      yfder = 0.      yfder = 0.
     ysolsw = 0.  
     ysollw = 0.  
261      yrugos = 0.      yrugos = 0.
262      yu1 = 0.      yu1 = 0.
263      yv1 = 0.      yv1 = 0.
# Line 298  contains Line 269  contains
269      yv = 0.      yv = 0.
270      yt = 0.      yt = 0.
271      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
272      y_dflux_t = 0.      y_dflux_t = 0.
273      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
274      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
275      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
276      flux_t = 0.      flux_t = 0.
277      flux_q = 0.      flux_q = 0.
278      flux_u = 0.      flux_u = 0.
279      flux_v = 0.      flux_v = 0.
280        fluxlat = 0.
281      d_t = 0.      d_t = 0.
282      d_q = 0.      d_q = 0.
283      d_u = 0.      d_u = 0.
284      d_v = 0.      d_v = 0.
285      ycoefh = 0.      ycoefh = 0.
286    
287      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
288      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
289      ! (à affiner)      ! (\`a affiner)
290    
291      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
292        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
293      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
294      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
295    
296        ! Tester si c'est le moment de lire le fichier:
297        if (mod(itap - 1, lmt_pas) == 0) then
298           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
299        endif
300    
301      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
302    
303      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 335  contains Line 305  contains
305         ni = 0         ni = 0
306         knon = 0         knon = 0
307         DO i = 1, klon         DO i = 1, klon
308            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
309            ! "potentielles"            ! "potentielles"
310            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
311               knon = knon + 1               knon = knon + 1
# Line 347  contains Line 317  contains
317            DO j = 1, knon            DO j = 1, knon
318               i = ni(j)               i = ni(j)
319               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
320               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
321               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
322               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
323               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
324               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
325               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
326               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
327               yfder(j) = fder(i)               yfder(j) = fder(i)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
328               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
329               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
330               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
331               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
332               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
333               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
334               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
              yu10mx(j) = u10m(i, nsrf)  
              yu10my(j) = v10m(i, nsrf)  
              ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))  
335            END DO            END DO
336    
337            ! For continent, copy soil water content            ! For continent, copy soil water content
# Line 378  contains Line 341  contains
341               yqsol = 0.               yqsol = 0.
342            END IF            END IF
343    
344            DO k = 1, nsoilmx            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
              DO j = 1, knon  
                 i = ni(j)  
                 ytsoil(j, k) = ftsoil(i, k, nsrf)  
              END DO  
           END DO  
345    
346            DO k = 1, klev            DO k = 1, klev
347               DO j = 1, knon               DO j = 1, knon
# Line 399  contains Line 357  contains
357            END DO            END DO
358    
359            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
360            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
361                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
362                   coefh(:knon, :))
363            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
364               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
365               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 422  contains Line 381  contains
381            END IF            END IF
382    
383            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
384               ! Mellor et Yamada adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
385               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
386               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
387                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
388                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 453  contains Line 412  contains
412               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
413               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
414    
415               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
416    
417               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
418                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
419                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
420                       yustar, iflag_pbl)                       iflag_pbl)
421               ELSE               ELSE
422                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
423                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 470  contains Line 429  contains
429    
430            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
431            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
432                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
433            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
434                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
435    
436            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
437            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
438                 ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &
439                 yu1, yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &
440                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yrads, yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
441                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 yfder, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, &
442                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 y_d_q, y_d_ts(:knon), yz0_new, y_flux_t(:knon), &
443                 y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g)                 y_flux_q(:knon), y_dflux_t, y_dflux_q, y_fqcalving, y_ffonte, &
444                   y_run_off_lic_0)
445    
446            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
447            yrugm = 0.            yrugm = 0.
# Line 506  contains Line 466  contains
466                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
467                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
468                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)
                 flux_t(i, k, nsrf) = y_flux_t(j, k)  
                 flux_q(i, k, nsrf) = y_flux_q(j, k)  
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
469                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
470                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
471               END DO               END DO
472            END DO            END DO
473    
474            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
475              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
476              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
477              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
478    
479              evap(:, nsrf) = -flux_q(:, nsrf)
480    
481            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
482            alblw(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
           snow(:, nsrf) = 0.  
483            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
484            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
485            DO j = 1, knon            DO j = 1, knon
486               i = ni(j)               i = ni(j)
487               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
488               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
489               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
490               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
491               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
492               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
# Line 554  contains Line 512  contains
512                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
513               END DO               END DO
514            END IF            END IF
515            !$$$ PB ajout pour soil  
516            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
517            DO k = 1, nsoilmx            ftsoil(ni(:knon), :, nsrf) = ytsoil(:knon, :)
              DO j = 1, knon  
                 i = ni(j)  
                 ftsoil(i, k, nsrf) = ytsoil(j, k)  
              END DO  
           END DO  
518    
519            DO j = 1, knon            DO j = 1, knon
520               i = ni(j)               i = ni(j)
# Line 607  contains Line 560  contains
560               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
561               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
562               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
   
563            END DO            END DO
564    
565            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
566                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
567                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
568    
569            DO j = 1, knon            DO j = 1, knon
570               i = ni(j)               i = ni(j)
# Line 634  contains Line 586  contains
586                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
587               END DO               END DO
588            END DO            END DO
589            !IM "slab" ocean         else
590            IF (nsrf == is_oce) THEN            fsnow(:, nsrf) = 0.
              DO j = 1, knon  
                 ! on projette sur la grille globale  
                 i = ni(j)  
                 IF (pctsrf_new(i, is_oce)>epsfra) THEN  
                    flux_o(i) = y_flux_o(j)  
                 ELSE  
                    flux_o(i) = 0.  
                 END IF  
              END DO  
           END IF  
   
           IF (nsrf == is_sic) THEN  
              DO j = 1, knon  
                 i = ni(j)  
                 ! On pondère lorsque l'on fait le bilan au sol :  
                 IF (pctsrf_new(i, is_sic)>epsfra) THEN  
                    flux_g(i) = y_flux_g(j)  
                 ELSE  
                    flux_g(i) = 0.  
                 END IF  
              END DO  
   
           END IF  
591         end IF if_knon         end IF if_knon
592      END DO loop_surface      END DO loop_surface
593    
594      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
595      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
596      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
597        pctsrf(:, is_sic) = pctsrf_new_sic
598    
599        firstcal = .false.
600    
601    END SUBROUTINE clmain    END SUBROUTINE clmain
602    
Legend:
Removed from v.104  
changed lines
  Added in v.221
  ViewVC Help
Powered by ViewVC 1.1.21