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