/[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/libf/phylmd/clmain.f90 revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC trunk/Sources/phylmd/clmain.f revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, date0, pctsrf, pctsrf_new, t, q, u, v,&    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, rmu0, ftsol, cdmmax, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, ts,&         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, snow, &
9         soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil,&         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat,&         rlat, rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         rain_f, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi,&         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v,&         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2,&         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
14         dflux_t, dflux_q, zcoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh,&  
15         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl,&      ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19
16         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
17        ! Objet : interface de couche limite (diffusion verticale)
18      ! From phylmd/clmain.F, version 1.6 2005/11/16 14:47:19  
19      ! Author: Z.X. Li (LMD/CNRS), date: 1993/08/18      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
20      ! Objet : interface de "couche limite" (diffusion verticale)      ! de la couche limite pour les traceurs se fait avec "cltrac" et
21        ! ne tient pas compte de la diff\'erentiation des sous-fractions
22      ! Tout ce qui a trait aux traceurs est dans "phytrac" maintenant.      ! de sol.
23      ! 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      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
25      ! des sous-fractions de sol.      ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
26        ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
27      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! champs sur les quatre sous-surfaces du mod\`ele.
28      ! dans la première couche, trois champs supplémentaires ont été  
29      ! créés : "zcoefh", "zu1" et "zv1". Pour l'instant nous avons      use clqh_m, only: clqh
30      ! moyenné les valeurs de ces trois champs sur les 4 sous-surfaces      use clvent_m, only: clvent
31      ! du modèle. Dans l'avenir, si les informations des sous-surfaces      use coefkz_m, only: coefkz
32      ! doivent être prises en compte, il faudra sortir ces mêmes champs      use coefkzmin_m, only: coefkzmin
33      ! en leur ajoutant une dimension, c'est-à-dire "nbsrf" (nombre de      USE conf_gcm_m, ONLY: prt_level, lmt_pas
34      ! sous-surfaces).      USE conf_phys_m, ONLY: iflag_pbl
35        USE dimphy, ONLY: klev, klon, zmasq
36      ! Arguments:      USE dimsoil, ONLY: nsoilmx
37      ! dtime----input-R- interval du temps (secondes)      use hbtm_m, only: hbtm
38      ! itap-----input-I- numero du pas de temps      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
39      ! date0----input-R- jour initial      USE interfoce_lim_m, ONLY: interfoce_lim
40      ! t--------input-R- temperature (K)      use stdlevvar_m, only: stdlevvar
41      ! q--------input-R- vapeur d'eau (kg/kg)      USE suphec_m, ONLY: rd, rg, rkappa
42      ! u--------input-R- vitesse u      use time_phylmdz, only: itap
43      ! v--------input-R- vitesse v      use ustarhb_m, only: ustarhb
44      ! ts-------input-R- temperature du sol (en Kelvin)      use vdif_kcay_m, only: vdif_kcay
45      ! paprs----input-R- pression a intercouche (Pa)      use yamada4_m, only: yamada4
46      ! pplay----input-R- pression au milieu de couche (Pa)  
47      ! radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
48      ! rlat-----input-R- latitude en degree  
49      ! rugos----input-R- longeur de rugosite (en m)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50      ! cufi-----input-R- resolution des mailles en x (m)      ! tableau des pourcentages de surface de chaque maille
51      ! cvfi-----input-R- resolution des mailles en y (m)  
52        REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53        REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
54        REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55        INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
56        REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
57        REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temperature du sol (en Kelvin)
58        REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59        REAL, INTENT(IN):: ksta, ksta_ter
60        LOGICAL, INTENT(IN):: ok_kzmin
61    
62        REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63        ! soil temperature of surface fraction
64    
65        REAL, INTENT(inout):: qsol(klon)
66        ! column-density of water in soil, in kg m-2
67    
68        REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
69        REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70        REAL, INTENT(inout):: snow(klon, nbsrf)
71        REAL qsurf(klon, nbsrf)
72        REAL evap(klon, nbsrf)
73        REAL, intent(inout):: falbe(klon, nbsrf)
74    
75      ! d_t------output-R- le changement pour "t"      REAL fluxlat(klon, nbsrf)
     ! d_q------output-R- le changement pour "q"  
     ! d_u------output-R- le changement pour "u"  
     ! d_v------output-R- le changement pour "v"  
     ! d_ts-----output-R- le changement pour "ts"  
     ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)  
     !                    (orientation positive vers le bas)  
     ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
     ! 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  
     ! dflux_t derive du flux sensible  
     ! dflux_q derive du flux latent  
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
76    
77      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      REAL, intent(in):: rain_fall(klon)
78      ! uniqmnt pour slab      ! liquid water mass flux (kg/m2/s), positive down
79    
80      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      REAL, intent(in):: snow_f(klon)
81      !cc      ! solid water mass flux (kg/m2/s), positive down
     ! ffonte----Flux thermique utilise pour fondre la neige  
     ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la  
     !           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  
82    
83      USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
84      use histwrite_m, only: histwrite      REAL, intent(in):: fder(klon)
85      use calendar, ONLY : ymds2ju      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
86      USE dimens_m, ONLY : iim, jjm  
87      USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
88      USE dimphy, ONLY : klev, klon, zmasq  
89      USE dimsoil, ONLY : nsoilmx      real agesno(klon, nbsrf)
90      USE temps, ONLY : annee_ref, itau_phy      REAL, INTENT(IN):: rugoro(klon)
     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  
91    
     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)  
92      REAL d_t(klon, klev), d_q(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
93      REAL d_u(klon, klev), d_v(klon, klev)      ! d_t------output-R- le changement pour "t"
94      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      ! d_q------output-R- le changement pour "q"
     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)  
     REAL run_off_lic_0(klon), y_run_off_lic_0(klon)  
95    
96      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
97      REAL rugmer(klon), agesno(klon, nbsrf)      ! changement pour "u" et "v"
     REAL, INTENT (IN) :: rugoro(klon)  
     REAL cdragh(klon), cdragm(klon)  
     ! jour de l'annee en cours                  
     INTEGER jour  
     REAL rmu0(klon) ! cosinus de l'angle solaire zenithal      
     ! taux CO2 atmosphere                      
     REAL co2_ppm  
     LOGICAL, INTENT (IN) :: debut  
     LOGICAL, INTENT (IN) :: lafin  
     LOGICAL ok_veget  
     CHARACTER (len=*), INTENT (IN) :: ocean  
     INTEGER npas, nexca  
   
     REAL pctsrf(klon, nbsrf)  
     REAL ts(klon, nbsrf)  
     REAL d_ts(klon, nbsrf)  
     REAL snow(klon, nbsrf)  
     REAL qsurf(klon, nbsrf)  
     REAL evap(klon, nbsrf)  
     REAL albe(klon, nbsrf)  
     REAL alblw(klon, nbsrf)  
98    
99      REAL fluxlat(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ftsol"
100    
101      REAL rain_f(klon), snow_f(klon)      REAL, intent(out):: flux_t(klon, nbsrf)
102      REAL fder(klon)      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
103        ! le bas) à la surface
104    
105      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL, intent(out):: flux_q(klon, nbsrf)
106      REAL rugos(klon, nbsrf)      ! flux de vapeur d'eau (kg/m2/s) à la surface
107      ! la nouvelle repartition des surfaces sortie de l'interface  
108      REAL pctsrf_new(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
109        ! tension du vent à la surface, en Pa
110    
111        REAL, INTENT(out):: cdragh(klon), cdragm(klon)
112        real q2(klon, klev+1, nbsrf)
113    
114      REAL zcoefh(klon, klev)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
115      REAL zu1(klon)      ! dflux_t derive du flux sensible
116        ! dflux_q derive du flux latent
117        ! IM "slab" ocean
118    
119        REAL, intent(out):: ycoefh(klon, klev)
120        REAL, intent(out):: zu1(klon)
121      REAL zv1(klon)      REAL zv1(klon)
122        REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
123        REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
124    
125      !$$$ PB ajout pour soil      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
126      LOGICAL, INTENT (IN) :: soil_model      ! (Comme les autres diagnostics on cumule dans physiq ce qui
127      !IM ajout seuils cdrm, cdrh      ! permet de sortir les grandeurs par sous-surface)
128      REAL cdmmax, cdhmax      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
129        REAL capcl(klon, nbsrf)
130        REAL oliqcl(klon, nbsrf)
131        REAL cteicl(klon, nbsrf)
132        REAL pblt(klon, nbsrf)
133        ! pblT------- T au nveau HCL
134        REAL therm(klon, nbsrf)
135        REAL trmb1(klon, nbsrf)
136        ! trmb1-------deep_cape
137        REAL trmb2(klon, nbsrf)
138        ! trmb2--------inhibition
139        REAL trmb3(klon, nbsrf)
140        ! trmb3-------Point Omega
141        REAL plcl(klon, nbsrf)
142        REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
143        ! ffonte----Flux thermique utilise pour fondre la neige
144        ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
145        !           hauteur de neige, en kg/m2/s
146        REAL run_off_lic_0(klon)
147    
148      REAL ksta, ksta_ter      ! Local:
     LOGICAL ok_kzmin  
149    
150      REAL ftsoil(klon, nsoilmx, nbsrf)      LOGICAL:: firstcal = .true.
     REAL ytsoil(klon, nsoilmx)  
     REAL qsol(klon)  
151    
152      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac      ! la nouvelle repartition des surfaces sortie de l'interface
153        REAL, save:: pctsrf_new_oce(klon)
154        REAL, save:: pctsrf_new_sic(klon)
155    
156        REAL y_fqcalving(klon), y_ffonte(klon)
157        real y_run_off_lic_0(klon)
158        REAL rugmer(klon)
159        REAL ytsoil(klon, nsoilmx)
160      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
161      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
162      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
163      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      ! on rajoute en output yu1 et yv1 qui sont les vents dans
164      REAL yrain_f(klon), ysnow_f(klon)      ! la premiere couche
165      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
166      REAL yfder(klon), ytaux(klon), ytauy(klon)  
167        real yqsol(klon)
168        ! column-density of water in soil, in kg m-2
169    
170        REAL yrain_f(klon)
171        ! liquid water mass flux (kg/m2/s), positive down
172    
173        REAL ysnow_f(klon)
174        ! solid water mass flux (kg/m2/s), positive down
175    
176        REAL yfder(klon)
177      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
178    
179      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 196  contains Line 181  contains
181      REAL y_d_ts(klon)      REAL y_d_ts(klon)
182      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
183      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
184      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
185      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
186      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
187      REAL ycoefh(klon, klev), ycoefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
188      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
189      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
190      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
191    
     LOGICAL ok_nonloc  
     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)
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)
# Line 223  contains Line 204  contains
204      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
205    
206      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
207      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
208      ! apparitions ou disparitions de la glace de mer      ! 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 extrapolation
   
     ! maf pour sorties IOISPL en cas de debugagage  
   
     CHARACTER (80) cldebug  
     SAVE cldebug  
     CHARACTER (8) cl_surf(nbsrf)  
     SAVE cl_surf  
     INTEGER nhoridbg, nidbg  
     SAVE nhoridbg, nidbg  
     INTEGER ndexbg(iim*(jjm+1))  
     REAL zx_lon(iim, jjm+1), zx_lat(iim, jjm+1), zjulian  
     REAL tabindx(klon)  
     REAL debugtab(iim, jjm+1)  
     LOGICAL first_appel  
     SAVE first_appel  
     DATA first_appel/ .TRUE./  
     LOGICAL :: debugindex = .FALSE.  
     INTEGER idayref  
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf)  
211    
212      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
213      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
214    
215      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
     !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds  
     ! physiq ce qui permet de sortir les grdeurs par sous surface)  
     REAL pblh(klon, nbsrf)  
     REAL plcl(klon, nbsrf)  
     REAL capcl(klon, nbsrf)  
     REAL oliqcl(klon, nbsrf)  
     REAL cteicl(klon, nbsrf)  
     REAL pblt(klon, nbsrf)  
     REAL therm(klon, nbsrf)  
     REAL trmb1(klon, nbsrf)  
     REAL trmb2(klon, nbsrf)  
     REAL trmb3(klon, nbsrf)  
216      REAL ypblh(klon)      REAL ypblh(klon)
217      REAL ylcl(klon)      REAL ylcl(klon)
218      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 279  contains Line 223  contains
223      REAL ytrmb1(klon)      REAL ytrmb1(klon)
224      REAL ytrmb2(klon)      REAL ytrmb2(klon)
225      REAL ytrmb3(klon)      REAL ytrmb3(klon)
     REAL y_cd_h(klon), y_cd_m(klon)  
226      REAL uzon(klon), vmer(klon)      REAL uzon(klon), vmer(klon)
227      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
228      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
# Line 291  contains Line 234  contains
234      LOGICAL zxli      LOGICAL zxli
235      PARAMETER (zxli=.FALSE.)      PARAMETER (zxli=.FALSE.)
236    
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER (len=20) :: modname = 'clmain'  
   
237      !------------------------------------------------------------      !------------------------------------------------------------
238    
239      ytherm = 0.      ytherm = 0.
240    
     IF (debugindex .AND. first_appel) THEN  
        first_appel = .FALSE.  
   
        ! initialisation sorties netcdf  
   
        idayref = day_ini  
        CALL ymds2ju(annee_ref, 1, idayref, 0., zjulian)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)  
        DO i = 1, iim  
           zx_lon(i, 1) = rlon(i+1)  
           zx_lon(i, jjm+1) = rlon(i+1)  
        END DO  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlat, zx_lat)  
        cldebug = 'sous_index'  
        CALL histbeg_totreg(cldebug, zx_lon(:, 1), zx_lat(1, :), 1, &  
             iim, 1, jjm+1, itau_phy, zjulian, dtime, nhoridbg, nidbg)  
        ! no vertical axis  
        cl_surf(1) = 'ter'  
        cl_surf(2) = 'lic'  
        cl_surf(3) = 'oce'  
        cl_surf(4) = 'sic'  
        DO nsrf = 1, nbsrf  
           CALL histdef(nidbg, cl_surf(nsrf), cl_surf(nsrf), '-', iim, jjm+1, &  
                nhoridbg, 1, 1, 1, -99, 'inst', dtime, dtime)  
        END DO  
        CALL histend(nidbg)  
        CALL histsync(nidbg)  
     END IF  
   
241      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
242         DO i = 1, klon         DO i = 1, klon
243            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 354  contains Line 262  contains
262      yts = 0.      yts = 0.
263      ysnow = 0.      ysnow = 0.
264      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
265      yrain_f = 0.      yrain_f = 0.
266      ysnow_f = 0.      ysnow_f = 0.
267      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
     ysollwdown = 0.  
268      yrugos = 0.      yrugos = 0.
269      yu1 = 0.      yu1 = 0.
270      yv1 = 0.      yv1 = 0.
# Line 375  contains Line 276  contains
276      yv = 0.      yv = 0.
277      yt = 0.      yt = 0.
278      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
     !$$ PB  
279      y_dflux_t = 0.      y_dflux_t = 0.
280      y_dflux_q = 0.      y_dflux_q = 0.
281      ytsoil = 999999.      ytsoil = 999999.
282      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
283      d_ts = 0.      d_ts = 0.
     !§§§ PB  
284      yfluxlat = 0.      yfluxlat = 0.
285      flux_t = 0.      flux_t = 0.
286      flux_q = 0.      flux_q = 0.
# Line 399  contains Line 290  contains
290      d_q = 0.      d_q = 0.
291      d_u = 0.      d_u = 0.
292      d_v = 0.      d_v = 0.
293      zcoefh = 0.      ycoefh = 0.
294    
295      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
296        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
297      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! (\`a affiner)
     ! peut avoir potentiellement de la glace sur tout le domaine océanique  
     ! (à affiner)  
298    
299      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
300        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
301      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
302      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
303    
304      DO nsrf = 1, nbsrf      ! Tester si c'est le moment de lire le fichier:
305         ! chercher les indices:      if (mod(itap - 1, lmt_pas) == 0) then
306           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
307        endif
308    
309        ! Boucler sur toutes les sous-fractions du sol:
310    
311        loop_surface: DO nsrf = 1, nbsrf
312           ! Chercher les indices :
313         ni = 0         ni = 0
314         knon = 0         knon = 0
315         DO i = 1, klon         DO i = 1, klon
316            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
317            ! "potentielles"            ! "potentielles"
318            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
319               knon = knon + 1               knon = knon + 1
# Line 424  contains Line 321  contains
321            END IF            END IF
322         END DO         END DO
323    
324         ! variables pour avoir une sortie IOIPSL des INDEX         if_knon: IF (knon /= 0) then
        IF (debugindex) THEN  
           tabindx = 0.  
           DO i = 1, knon  
              tabindx(i) = real(i)  
           END DO  
           debugtab = 0.  
           ndexbg = 0  
           CALL gath2cpl(tabindx, debugtab, klon, knon, iim, jjm, ni)  
           CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)  
        END IF  
   
        IF (knon==0) CYCLE  
   
        DO j = 1, knon  
           i = ni(j)  
           ypct(j) = pctsrf(i, nsrf)  
           yts(j) = ts(i, nsrf)  
           ytslab(i) = tslab(i)  
           ysnow(j) = snow(i, nsrf)  
           yqsurf(j) = qsurf(i, nsrf)  
           yalb(j) = albe(i, nsrf)  
           yalblw(j) = alblw(i, nsrf)  
           yrain_f(j) = rain_f(i)  
           ysnow_f(j) = snow_f(i)  
           yagesno(j) = agesno(i, nsrf)  
           yfder(j) = fder(i)  
           ytaux(j) = flux_u(i, 1, nsrf)  
           ytauy(j) = flux_v(i, 1, nsrf)  
           ysolsw(j) = solsw(i, nsrf)  
           ysollw(j) = sollw(i, nsrf)  
           ysollwdown(j) = sollwdown(i)  
           yrugos(j) = rugos(i, nsrf)  
           yrugoro(j) = rugoro(i)  
           yu1(j) = u1lay(i)  
           yv1(j) = v1lay(i)  
           yrads(j) = ysolsw(j) + ysollw(j)  
           ypaprs(j, klev+1) = paprs(i, klev+1)  
           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))  
        END DO  
   
        !     IF bucket model for continent, copy soil water content  
        IF (nsrf==is_ter .AND. .NOT. ok_veget) THEN  
325            DO j = 1, knon            DO j = 1, knon
326               i = ni(j)               i = ni(j)
327               yqsol(j) = qsol(i)               ypct(j) = pctsrf(i, nsrf)
328            END DO               yts(j) = ftsol(i, nsrf)
329         ELSE               ysnow(j) = snow(i, nsrf)
330            yqsol = 0.               yqsurf(j) = qsurf(i, nsrf)
331         END IF               yalb(j) = falbe(i, nsrf)
332         !$$$ PB ajour pour soil               yrain_f(j) = rain_fall(i)
333         DO k = 1, nsoilmx               ysnow_f(j) = snow_f(i)
334            DO j = 1, knon               yagesno(j) = agesno(i, nsrf)
335               i = ni(j)               yfder(j) = fder(i)
336               ytsoil(j, k) = ftsoil(i, k, nsrf)               yrugos(j) = rugos(i, nsrf)
337            END DO               yrugoro(j) = rugoro(i)
338         END DO               yu1(j) = u1lay(i)
339         DO k = 1, klev               yv1(j) = v1lay(i)
340            DO j = 1, knon               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
341               i = ni(j)               ypaprs(j, klev+1) = paprs(i, klev+1)
342               ypaprs(j, k) = paprs(i, k)               y_run_off_lic_0(j) = run_off_lic_0(i)
343               ypplay(j, k) = pplay(i, k)            END DO
344               ydelp(j, k) = delp(i, k)  
345               yu(j, k) = u(i, k)            ! For continent, copy soil water content
346               yv(j, k) = v(i, k)            IF (nsrf == is_ter) THEN
347               yt(j, k) = t(i, k)               yqsol(:knon) = qsol(ni(:knon))
348               yq(j, k) = q(i, k)            ELSE
349            END DO               yqsol = 0.
350         END DO            END IF
351    
352         ! calculer Cdrag et les coefficients d'echange            DO k = 1, nsoilmx
353         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&               DO j = 1, knon
354              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)                  i = ni(j)
355         !IM 081204 BEG                  ytsoil(j, k) = ftsoil(i, k, nsrf)
        !CR test  
        IF (iflag_pbl==1) THEN  
           !IM 081204 END  
           CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)  
           DO k = 1, klev  
              DO i = 1, knon  
                 ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))  
                 ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k))  
356               END DO               END DO
357            END DO            END DO
        END IF  
   
        !IM cf JLD : on seuille ycoefm et ycoefh  
        IF (nsrf==is_oce) THEN  
           DO j = 1, knon  
              !           ycoefm(j, 1)=min(ycoefm(j, 1), 1.1E-3)  
              ycoefm(j, 1) = min(ycoefm(j, 1), cdmmax)  
              !           ycoefh(j, 1)=min(ycoefh(j, 1), 1.1E-3)  
              ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)  
           END DO  
        END IF  
   
        !IM: 261103  
        IF (ok_kzmin) THEN  
           !IM cf FH: 201103 BEG  
           !   Calcul d'une diffusion minimale pour les conditions tres stables.  
           CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm, &  
                ycoefm0, ycoefh0)  
358    
           IF (1==1) THEN  
              DO k = 1, klev  
                 DO i = 1, knon  
                    ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))  
                    ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k))  
                 END DO  
              END DO  
           END IF  
           !IM cf FH: 201103 END  
           !IM: 261103  
        END IF !ok_kzmin  
   
        IF (iflag_pbl>=3) THEN  
           ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin  
           yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, &  
                1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg  
           DO k = 2, klev  
              yzlay(1:knon, k) = yzlay(1:knon, k-1) &  
                   + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &  
                   / ypaprs(1:knon, k) &  
                   * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg  
           END DO  
359            DO k = 1, klev            DO k = 1, klev
              yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &  
                   / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))  
           END DO  
           yzlev(1:knon, 1) = 0.  
           yzlev(1:knon, klev+1) = 2.*yzlay(1:knon, klev) - yzlay(1:knon, klev-1)  
           DO k = 2, klev  
              yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))  
           END DO  
           DO k = 1, klev + 1  
360               DO j = 1, knon               DO j = 1, knon
361                  i = ni(j)                  i = ni(j)
362                  yq2(j, k) = q2(i, k, nsrf)                  ypaprs(j, k) = paprs(i, k)
363                    ypplay(j, k) = pplay(i, k)
364                    ydelp(j, k) = delp(i, k)
365                    yu(j, k) = u(i, k)
366                    yv(j, k) = v(i, k)
367                    yt(j, k) = t(i, k)
368                    yq(j, k) = q(i, k)
369               END DO               END DO
370            END DO            END DO
371    
372            !   Bug introduit volontairement pour converger avec les resultats            ! calculer Cdrag et les coefficients d'echange
373            !  du papier sur les thermiques.            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &
374            IF (1==1) THEN                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))
375               y_cd_m(1:knon) = ycoefm(1:knon, 1)            IF (iflag_pbl == 1) THEN
376               y_cd_h(1:knon) = ycoefh(1:knon, 1)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
377            ELSE               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
378               y_cd_h(1:knon) = ycoefm(1:knon, 1)               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
              y_cd_m(1:knon) = ycoefh(1:knon, 1)  
379            END IF            END IF
           CALL ustarhb(knon, yu, yv, y_cd_m, yustar)  
380    
381            IF (prt_level>9) THEN            ! on met un seuil pour coefm et coefh
382               PRINT *, 'USTAR = ', yustar            IF (nsrf == is_oce) THEN
383                 coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
384                 coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
385            END IF            END IF
386    
387            !   iflag_pbl peut etre utilise comme longuer de melange            IF (ok_kzmin) THEN
388                 ! Calcul d'une diffusion minimale pour les conditions tres stables
389                 CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
390                      coefm(:knon, 1), ycoefm0, ycoefh0)
391                 coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
392                 coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
393              END IF
394    
395            IF (iflag_pbl>=11) THEN            IF (iflag_pbl >= 3) THEN
396               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
397                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &               ! Fr\'ed\'eric Hourdin
398                    iflag_pbl)               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
399            ELSE                    + ypplay(:knon, 1))) &
400               CALL yamada4(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, yu, &                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
401                    yv, yteta, y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)               DO k = 2, klev
402                    yzlay(1:knon, k) = yzlay(1:knon, k-1) &
403                         + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
404                         / ypaprs(1:knon, k) &
405                         * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
406                 END DO
407                 DO k = 1, klev
408                    yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &
409                         / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))
410                 END DO
411                 yzlev(1:knon, 1) = 0.
412                 yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &
413                      - yzlay(:knon, klev - 1)
414                 DO k = 2, klev
415                    yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))
416                 END DO
417                 DO k = 1, klev + 1
418                    DO j = 1, knon
419                       i = ni(j)
420                       yq2(j, k) = q2(i, k, nsrf)
421                    END DO
422                 END DO
423    
424                 CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
425                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
426    
427                 ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
428    
429                 IF (iflag_pbl >= 11) THEN
430                    CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
431                         yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
432                         iflag_pbl)
433                 ELSE
434                    CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
435                         coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
436                 END IF
437    
438                 coefm(:knon, 2:) = ykmm(:knon, 2:klev)
439                 coefh(:knon, 2:) = ykmn(:knon, 2:klev)
440            END IF            END IF
441    
442            ycoefm(1:knon, 1) = y_cd_m(1:knon)            ! calculer la diffusion des vitesses "u" et "v"
443            ycoefh(1:knon, 1) = y_cd_h(1:knon)            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
444            ycoefm(1:knon, 2:klev) = ykmm(1:knon, 2:klev)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
445            ycoefh(1:knon, 2:klev) = ykmn(1:knon, 2:klev)            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
446         END IF                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
447    
448         ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion de "q" et de "h"
449         CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yu, ypaprs, ypplay, &            CALL clqh(dtime, jour, firstcal, rlat, nsrf, ni(:knon), ytsoil, &
450              ydelp, y_d_u, y_flux_u)                 yqsol, rmu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
451         CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yv, ypaprs, ypplay, &                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &
452              ydelp, y_d_v, y_flux_v)                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
453                   pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
454         ! pour le couplage                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, &
455         ytaux = y_flux_u(:, 1)                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
456         ytauy = y_flux_v(:, 1)  
457              ! calculer la longueur de rugosite sur ocean
458         ! calculer la diffusion de "q" et de "h"            yrugm = 0.
459         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&            IF (nsrf == is_oce) THEN
460              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&               DO j = 1, knon
461              yqsol, ok_veget, ocean, npas, nexca, rmu0, co2_ppm, yrugos,&                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &
462              yrugoro, yu1, yv1, ycoefh, yt, yq, yts, ypaprs, ypplay,&                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))
463              ydelp, yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, &                  yrugm(j) = max(1.5E-05, yrugm(j))
464              yfder, ytaux, ytauy, ywindsp, ysollw, ysollwdown, ysolsw,&               END DO
465              yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts,&            END IF
             yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q,&  
             y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g,&  
             ytslab, y_seaice)  
   
        ! calculer la longueur de rugosite sur ocean  
        yrugm = 0.  
        IF (nsrf==is_oce) THEN  
466            DO j = 1, knon            DO j = 1, knon
467               yrugm(j) = 0.018*ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &               y_dflux_t(j) = y_dflux_t(j)*ypct(j)
468                    0.11*14E-6/sqrt(ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2))               y_dflux_q(j) = y_dflux_q(j)*ypct(j)
469               yrugm(j) = max(1.5E-05, yrugm(j))               yu1(j) = yu1(j)*ypct(j)
470            END DO               yv1(j) = yv1(j)*ypct(j)
471         END IF            END DO
472         DO j = 1, knon  
473            y_dflux_t(j) = y_dflux_t(j)*ypct(j)            DO k = 1, klev
474            y_dflux_q(j) = y_dflux_q(j)*ypct(j)               DO j = 1, knon
475            yu1(j) = yu1(j)*ypct(j)                  i = ni(j)
476            yv1(j) = yv1(j)*ypct(j)                  coefh(j, k) = coefh(j, k)*ypct(j)
477         END DO                  coefm(j, k) = coefm(j, k)*ypct(j)
478                    y_d_t(j, k) = y_d_t(j, k)*ypct(j)
479                    y_d_q(j, k) = y_d_q(j, k)*ypct(j)
480                    y_d_u(j, k) = y_d_u(j, k)*ypct(j)
481                    y_d_v(j, k) = y_d_v(j, k)*ypct(j)
482                 END DO
483              END DO
484    
        DO k = 1, klev  
485            DO j = 1, knon            DO j = 1, knon
486               i = ni(j)               i = ni(j)
487               ycoefh(j, k) = ycoefh(j, k)*ypct(j)               flux_t(i, nsrf) = y_flux_t(j)
488               ycoefm(j, k) = ycoefm(j, k)*ypct(j)               flux_q(i, nsrf) = y_flux_q(j)
489               y_d_t(j, k) = y_d_t(j, k)*ypct(j)               flux_u(i, nsrf) = y_flux_u(j)
490               y_d_q(j, k) = y_d_q(j, k)*ypct(j)               flux_v(i, nsrf) = y_flux_v(j)
              !§§§ PB  
              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)  
              !$$$ 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)  
              y_d_u(j, k) = y_d_u(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)  
491            END DO            END DO
        END DO  
492    
493         evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, nsrf)
494    
495         albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
496         alblw(:, nsrf) = 0.            snow(:, nsrf) = 0.
497         snow(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
498         qsurf(:, nsrf) = 0.            rugos(:, nsrf) = 0.
499         rugos(:, nsrf) = 0.            fluxlat(:, nsrf) = 0.
        fluxlat(:, nsrf) = 0.  
        DO j = 1, knon  
           i = ni(j)  
           d_ts(i, nsrf) = y_d_ts(j)  
           albe(i, nsrf) = yalb(j)  
           alblw(i, nsrf) = yalblw(j)  
           snow(i, nsrf) = ysnow(j)  
           qsurf(i, nsrf) = yqsurf(j)  
           rugos(i, nsrf) = yz0_new(j)  
           fluxlat(i, nsrf) = yfluxlat(j)  
           !$$$ pb         rugmer(i) = yrugm(j)  
           IF (nsrf==is_oce) THEN  
              rugmer(i) = yrugm(j)  
              rugos(i, nsrf) = yrugm(j)  
           END IF  
           !IM cf JLD ??  
           agesno(i, nsrf) = yagesno(j)  
           fqcalving(i, nsrf) = y_fqcalving(j)  
           ffonte(i, nsrf) = y_ffonte(j)  
           cdragh(i) = cdragh(i) + ycoefh(j, 1)  
           cdragm(i) = cdragm(i) + ycoefm(j, 1)  
           dflux_t(i) = dflux_t(i) + y_dflux_t(j)  
           dflux_q(i) = dflux_q(i) + y_dflux_q(j)  
           zu1(i) = zu1(i) + yu1(j)  
           zv1(i) = zv1(i) + yv1(j)  
        END DO  
        IF (nsrf==is_ter) THEN  
500            DO j = 1, knon            DO j = 1, knon
501               i = ni(j)               i = ni(j)
502               qsol(i) = yqsol(j)               d_ts(i, nsrf) = y_d_ts(j)
503                 falbe(i, nsrf) = yalb(j)
504                 snow(i, nsrf) = ysnow(j)
505                 qsurf(i, nsrf) = yqsurf(j)
506                 rugos(i, nsrf) = yz0_new(j)
507                 fluxlat(i, nsrf) = yfluxlat(j)
508                 IF (nsrf == is_oce) THEN
509                    rugmer(i) = yrugm(j)
510                    rugos(i, nsrf) = yrugm(j)
511                 END IF
512                 agesno(i, nsrf) = yagesno(j)
513                 fqcalving(i, nsrf) = y_fqcalving(j)
514                 ffonte(i, nsrf) = y_ffonte(j)
515                 cdragh(i) = cdragh(i) + coefh(j, 1)
516                 cdragm(i) = cdragm(i) + coefm(j, 1)
517                 dflux_t(i) = dflux_t(i) + y_dflux_t(j)
518                 dflux_q(i) = dflux_q(i) + y_dflux_q(j)
519                 zu1(i) = zu1(i) + yu1(j)
520                 zv1(i) = zv1(i) + yv1(j)
521              END DO
522              IF (nsrf == is_ter) THEN
523                 qsol(ni(:knon)) = yqsol(:knon)
524              else IF (nsrf == is_lic) THEN
525                 DO j = 1, knon
526                    i = ni(j)
527                    run_off_lic_0(i) = y_run_off_lic_0(j)
528                 END DO
529              END IF
530    
531              ftsoil(:, :, nsrf) = 0.
532              DO k = 1, nsoilmx
533                 DO j = 1, knon
534                    i = ni(j)
535                    ftsoil(i, k, nsrf) = ytsoil(j, k)
536                 END DO
537            END DO            END DO
538         END IF  
        IF (nsrf==is_lic) THEN  
539            DO j = 1, knon            DO j = 1, knon
540               i = ni(j)               i = ni(j)
541               run_off_lic_0(i) = y_run_off_lic_0(j)               DO k = 1, klev
542                    d_t(i, k) = d_t(i, k) + y_d_t(j, k)
543                    d_q(i, k) = d_q(i, k) + y_d_q(j, k)
544                    d_u(i, k) = d_u(i, k) + y_d_u(j, k)
545                    d_v(i, k) = d_v(i, k) + y_d_v(j, k)
546                    ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
547                 END DO
548            END DO            END DO
549         END IF  
550         !$$$ PB ajout pour soil            ! diagnostic t, q a 2m et u, v a 10m
551         ftsoil(:, :, nsrf) = 0.  
        DO k = 1, nsoilmx  
552            DO j = 1, knon            DO j = 1, knon
553               i = ni(j)               i = ni(j)
554               ftsoil(i, k, nsrf) = ytsoil(j, k)               uzon(j) = yu(j, 1) + y_d_u(j, 1)
555            END DO               vmer(j) = yv(j, 1) + y_d_v(j, 1)
556         END DO               tair1(j) = yt(j, 1) + y_d_t(j, 1)
557                 qair1(j) = yq(j, 1) + y_d_q(j, 1)
558                 zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &
559                      1)))*(ypaprs(j, 1)-ypplay(j, 1))
560                 tairsol(j) = yts(j) + y_d_ts(j)
561                 rugo1(j) = yrugos(j)
562                 IF (nsrf == is_oce) THEN
563                    rugo1(j) = rugos(i, nsrf)
564                 END IF
565                 psfce(j) = ypaprs(j, 1)
566                 patm(j) = ypplay(j, 1)
567    
568         DO j = 1, knon               qairsol(j) = yqsurf(j)
           i = ni(j)  
           DO k = 1, klev  
              d_t(i, k) = d_t(i, k) + y_d_t(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)  
              d_u(i, k) = d_u(i, k) + y_d_u(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)  
              zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)  
569            END DO            END DO
        END DO  
   
        !cc diagnostic t, q a 2m et u, v a 10m  
570    
571         DO j = 1, knon            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &
572            i = ni(j)                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &
573            uzon(j) = yu(j, 1) + y_d_u(j, 1)                 yt10m, yq10m, yu10m, yustar)
           vmer(j) = yv(j, 1) + y_d_v(j, 1)  
           tair1(j) = yt(j, 1) + y_d_t(j, 1)  
           qair1(j) = yq(j, 1) + y_d_q(j, 1)  
           zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &  
                1)))*(ypaprs(j, 1)-ypplay(j, 1))  
           tairsol(j) = yts(j) + y_d_ts(j)  
           rugo1(j) = yrugos(j)  
           IF (nsrf==is_oce) THEN  
              rugo1(j) = rugos(i, nsrf)  
           END IF  
           psfce(j) = ypaprs(j, 1)  
           patm(j) = ypplay(j, 1)  
574    
575            qairsol(j) = yqsurf(j)            DO j = 1, knon
576         END DO               i = ni(j)
577                 t2m(i, nsrf) = yt2m(j)
578                 q2m(i, nsrf) = yq2m(j)
579    
580         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
581              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
582              yu10m, yustar)               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
        !IM 081204 END  
   
        DO j = 1, knon  
           i = ni(j)  
           t2m(i, nsrf) = yt2m(j)  
           q2m(i, nsrf) = yq2m(j)  
   
           ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman  
           u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)  
           v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)  
583    
584         END DO            END DO
585    
586         DO i = 1, knon            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
587            y_cd_h(i) = ycoefh(i, 1)                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
588            y_cd_m(i) = ycoefm(i, 1)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
        END DO  
        CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &  
             y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &  
             ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)  
   
        DO j = 1, knon  
           i = ni(j)  
           pblh(i, nsrf) = ypblh(j)  
           plcl(i, nsrf) = ylcl(j)  
           capcl(i, nsrf) = ycapcl(j)  
           oliqcl(i, nsrf) = yoliqcl(j)  
           cteicl(i, nsrf) = ycteicl(j)  
           pblt(i, nsrf) = ypblt(j)  
           therm(i, nsrf) = ytherm(j)  
           trmb1(i, nsrf) = ytrmb1(j)  
           trmb2(i, nsrf) = ytrmb2(j)  
           trmb3(i, nsrf) = ytrmb3(j)  
        END DO  
589    
        DO j = 1, knon  
           DO k = 1, klev + 1  
              i = ni(j)  
              q2(i, k, nsrf) = yq2(j, k)  
           END DO  
        END DO  
        !IM "slab" ocean  
        IF (nsrf==is_oce) THEN  
590            DO j = 1, knon            DO j = 1, knon
              ! on projette sur la grille globale  
591               i = ni(j)               i = ni(j)
592               IF (pctsrf_new(i, is_oce)>epsfra) THEN               pblh(i, nsrf) = ypblh(j)
593                  flux_o(i) = y_flux_o(j)               plcl(i, nsrf) = ylcl(j)
594               ELSE               capcl(i, nsrf) = ycapcl(j)
595                  flux_o(i) = 0.               oliqcl(i, nsrf) = yoliqcl(j)
596               END IF               cteicl(i, nsrf) = ycteicl(j)
597                 pblt(i, nsrf) = ypblt(j)
598                 therm(i, nsrf) = ytherm(j)
599                 trmb1(i, nsrf) = ytrmb1(j)
600                 trmb2(i, nsrf) = ytrmb2(j)
601                 trmb3(i, nsrf) = ytrmb3(j)
602            END DO            END DO
        END IF  
603    
        IF (nsrf==is_sic) THEN  
604            DO j = 1, knon            DO j = 1, knon
605               i = ni(j)               DO k = 1, klev + 1
606               ! On pondère lorsque l'on fait le bilan au sol :                  i = ni(j)
607               ! flux_g(i) = y_flux_g(j)*ypct(j)                  q2(i, k, nsrf) = yq2(j, k)
608               IF (pctsrf_new(i, is_sic)>epsfra) THEN               END DO
                 flux_g(i) = y_flux_g(j)  
              ELSE  
                 flux_g(i) = 0.  
              END IF  
609            END DO            END DO
610           end IF if_knon
611         END IF      END DO loop_surface
        !nsrf.EQ.is_sic                                              
        IF (ocean=='slab  ') THEN  
           IF (nsrf==is_oce) THEN  
              tslab(1:klon) = ytslab(1:klon)  
              seaice(1:klon) = y_seaice(1:klon)  
              !nsrf                                                        
           END IF  
           !OCEAN                                                        
        END IF  
     END DO  
612    
613      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
     ! A rajouter: conservation de l'albedo  
   
614      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
615      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
616        pctsrf(:, is_sic) = pctsrf_new_sic
617    
618        firstcal = .false.
619    
620    END SUBROUTINE clmain    END SUBROUTINE clmain
621    

Legend:
Removed from v.40  
changed lines
  Added in v.207

  ViewVC Help
Powered by ViewVC 1.1.21