/[lmdze]/trunk/phylmd/pbl_surface.f
ViewVC logotype

Diff of /trunk/phylmd/pbl_surface.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 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.
     ! 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) ! temperature du sol (en Kelvin)
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
82      ! la nouvelle repartition des surfaces sortie de l'interface  
83      REAL pctsrf_new(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
84        REAL, intent(in):: fder(klon)
85        REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
86    
87        REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
88    
89        real agesno(klon, nbsrf)
90        REAL, INTENT(IN):: rugoro(klon)
91    
92      REAL zcoefh(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
93      REAL zu1(klon)      ! d_t------output-R- le changement pour "t"
94        ! d_q------output-R- le changement pour "q"
95    
96        REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
97        ! changement pour "u" et "v"
98    
99        REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ftsol"
100    
101        REAL, intent(out):: flux_t(klon, nbsrf)
102        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
103        ! le bas) à la surface
104    
105        REAL, intent(out):: flux_q(klon, nbsrf)
106        ! flux de vapeur d'eau (kg/m2/s) à la surface
107    
108        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, INTENT(out):: dflux_t(klon), dflux_q(klon)
115        ! 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, 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 199  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    
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)
199    
200      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
# Line 224  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 280  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 292  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 355  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 376  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 400  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.
   
     ! Boucler sur toutes les sous-fractions du sol:  
294    
295      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
296      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
297      ! (à affiner)      ! (\`a 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 425  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  
           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  
325            DO j = 1, knon            DO j = 1, knon
326               i = ni(j)               i = ni(j)
327               ytsoil(j, k) = ftsoil(i, k, nsrf)               ypct(j) = pctsrf(i, nsrf)
328            END DO               yts(j) = ftsol(i, nsrf)
329         END DO               ysnow(j) = snow(i, nsrf)
330         DO k = 1, klev               yqsurf(j) = qsurf(i, nsrf)
331            DO j = 1, knon               yalb(j) = falbe(i, nsrf)
332               i = ni(j)               yrain_f(j) = rain_fall(i)
333               ypaprs(j, k) = paprs(i, k)               ysnow_f(j) = snow_f(i)
334               ypplay(j, k) = pplay(i, k)               yagesno(j) = agesno(i, nsrf)
335               ydelp(j, k) = delp(i, k)               yfder(j) = fder(i)
336               yu(j, k) = u(i, k)               yrugos(j) = rugos(i, nsrf)
337               yv(j, k) = v(i, k)               yrugoro(j) = rugoro(i)
338               yt(j, k) = t(i, k)               yu1(j) = u1lay(i)
339               yq(j, k) = q(i, k)               yv1(j) = v1lay(i)
340            END DO               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
341         END DO               ypaprs(j, klev+1) = paprs(i, klev+1)
342                 y_run_off_lic_0(j) = run_off_lic_0(i)
343              END DO
344    
345              ! For continent, copy soil water content
346              IF (nsrf == is_ter) THEN
347                 yqsol(:knon) = qsol(ni(:knon))
348              ELSE
349                 yqsol = 0.
350              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         IF (iflag_pbl == 1) THEN                  ytsoil(j, k) = ftsoil(i, k, nsrf)
           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  
   
        ! on seuille ycoefm et ycoefh  
        IF (nsrf == is_oce) THEN  
           DO j = 1, knon  
              ycoefm(j, 1) = min(ycoefm(j, 1), cdmmax)  
              ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)  
           END DO  
        END IF  
   
        IF (ok_kzmin) THEN  
           ! Calcul d'une diffusion minimale pour les conditions tres stables  
           CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm(:, 1), &  
                ycoefm0, ycoefh0)  
358    
359            DO k = 1, klev            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  
   
        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  
           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            y_cd_m(1:knon) = ycoefm(1:knon, 1)            ! calculer Cdrag et les coefficients d'echange
373            y_cd_h(1:knon) = ycoefh(1:knon, 1)            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &
374            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))
375              IF (iflag_pbl == 1) THEN
376            IF (prt_level>9) THEN               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
377               PRINT *, 'USTAR = ', yustar               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
378                 coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
379            END IF            END IF
380    
381            ! iflag_pbl peut être utilisé comme longueur de mélange            ! on met un seuil pour coefm et coefh
382              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
386    
387            IF (iflag_pbl >= 11) THEN            IF (ok_kzmin) THEN
388               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &               ! Calcul d'une diffusion minimale pour les conditions tres stables
389                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
390                    iflag_pbl)                    coefm(:knon, 1), ycoefm0, ycoefh0)
391            ELSE               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
392               CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
                   y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)  
393            END IF            END IF
394    
395            ycoefm(1:knon, 1) = y_cd_m(1:knon)            IF (iflag_pbl >= 3) THEN
396            ycoefh(1:knon, 1) = y_cd_h(1:knon)               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
397            ycoefm(1:knon, 2:klev) = ykmm(1:knon, 2:klev)               ! Fr\'ed\'eric Hourdin
398            ycoefh(1:knon, 2:klev) = ykmn(1:knon, 2:klev)               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
399         END IF                    + ypplay(:knon, 1))) &
400                      * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
401         ! calculer la diffusion des vitesses "u" et "v"               DO k = 2, klev
402         CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yu, ypaprs, ypplay, &                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &
403              ydelp, y_d_u, y_flux_u)                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
404         CALL clvent(knon, dtime, yu1, yv1, ycoefm, yt, yv, ypaprs, ypplay, &                       / ypaprs(1:knon, k) &
405              ydelp, y_d_v, y_flux_v)                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
406                 END DO
407         ! pour le couplage               DO k = 1, klev
408         ytaux = y_flux_u(:, 1)                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &
409         ytauy = y_flux_v(:, 1)                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))
410                 END DO
411         ! calculer la diffusion de "q" et de "h"               yzlev(1:knon, 1) = 0.
412         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &
413              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&                    - yzlay(:knon, klev - 1)
414              yqsol, ok_veget, ocean, npas, nexca, rmu0, co2_ppm, yrugos,&               DO k = 2, klev
415              yrugoro, yu1, yv1, ycoefh, yt, yq, yts, ypaprs, ypplay,&                  yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))
416              ydelp, yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, &               END DO
417              yfder, ytaux, ytauy, ywindsp, ysollw, ysollwdown, ysolsw,&               DO k = 1, klev + 1
418              yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts,&                  DO j = 1, knon
419              yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q,&                     i = ni(j)
420              y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g,&                     yq2(j, k) = q2(i, k, nsrf)
421              ytslab, y_seaice)                  END DO
422                 END DO
        ! 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  
423    
424         DO k = 1, klev               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
425            DO j = 1, knon               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
426               i = ni(j)  
427               ycoefh(j, k) = ycoefh(j, k)*ypct(j)               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
428               ycoefm(j, k) = ycoefm(j, k)*ypct(j)  
429               y_d_t(j, k) = y_d_t(j, k)*ypct(j)               IF (iflag_pbl >= 11) THEN
430               y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
431               flux_t(i, k, nsrf) = y_flux_t(j, k)                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
432               flux_q(i, k, nsrf) = y_flux_q(j, k)                       iflag_pbl)
433               flux_u(i, k, nsrf) = y_flux_u(j, k)               ELSE
434               flux_v(i, k, nsrf) = y_flux_v(j, k)                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
435               y_d_u(j, k) = y_d_u(j, k)*ypct(j)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
436               y_d_v(j, k) = y_d_v(j, k)*ypct(j)               END IF
437            END DO  
438         END DO               coefm(:knon, 2:) = ykmm(:knon, 2:klev)
439                 coefh(:knon, 2:) = ykmn(:knon, 2:klev)
440              END IF
441    
442         evap(:, nsrf) = -flux_q(:, 1, nsrf)            ! calculer la diffusion des vitesses "u" et "v"
443              CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
444                   ypplay, ydelp, y_d_u, y_flux_u(:knon))
445              CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
446                   ypplay, ydelp, y_d_v, y_flux_v(:knon))
447    
448              ! calculer la diffusion de "q" et de "h"
449              CALL clqh(dtime, jour, firstcal, rlat, nsrf, ni(:knon), ytsoil, &
450                   yqsol, rmu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
451                   yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &
452                   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                   yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, &
455                   y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
456    
457         albe(:, nsrf) = 0.            ! calculer la longueur de rugosite sur ocean
458         alblw(:, nsrf) = 0.            yrugm = 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)  
459            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
460               rugmer(i) = yrugm(j)               DO j = 1, knon
461               rugos(i, nsrf) = yrugm(j)                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &
462                         0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))
463                    yrugm(j) = max(1.5E-05, yrugm(j))
464                 END DO
465            END IF            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  
466            DO j = 1, knon            DO j = 1, knon
467               i = ni(j)               y_dflux_t(j) = y_dflux_t(j)*ypct(j)
468               qsol(i) = yqsol(j)               y_dflux_q(j) = y_dflux_q(j)*ypct(j)
469                 yu1(j) = yu1(j)*ypct(j)
470                 yv1(j) = yv1(j)*ypct(j)
471            END DO            END DO
472         END IF  
473         IF (nsrf == is_lic) THEN            DO k = 1, klev
474                 DO j = 1, knon
475                    i = ni(j)
476                    coefh(j, k) = coefh(j, k)*ypct(j)
477                    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    
485            DO j = 1, knon            DO j = 1, knon
486               i = ni(j)               i = ni(j)
487               run_off_lic_0(i) = y_run_off_lic_0(j)               flux_t(i, nsrf) = y_flux_t(j)
488                 flux_q(i, nsrf) = y_flux_q(j)
489                 flux_u(i, nsrf) = y_flux_u(j)
490                 flux_v(i, nsrf) = y_flux_v(j)
491            END DO            END DO
492         END IF  
493         !$$$ PB ajout pour soil            evap(:, nsrf) = -flux_q(:, nsrf)
494         ftsoil(:, :, nsrf) = 0.  
495         DO k = 1, nsoilmx            falbe(:, nsrf) = 0.
496              snow(:, nsrf) = 0.
497              qsurf(:, nsrf) = 0.
498              rugos(:, nsrf) = 0.
499              fluxlat(:, nsrf) = 0.
500            DO j = 1, knon            DO j = 1, knon
501               i = ni(j)               i = ni(j)
502               ftsoil(i, k, nsrf) = ytsoil(j, k)               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
        END DO  
538    
539         DO j = 1, knon            DO j = 1, knon
540            i = ni(j)               i = ni(j)
541            DO k = 1, klev               DO k = 1, klev
542               d_t(i, k) = d_t(i, k) + y_d_t(j, k)                  d_t(i, k) = d_t(i, k) + y_d_t(j, k)
543               d_q(i, k) = d_q(i, k) + y_d_q(j, k)                  d_q(i, k) = d_q(i, k) + y_d_q(j, k)
544               d_u(i, k) = d_u(i, k) + y_d_u(j, k)                  d_u(i, k) = d_u(i, k) + y_d_u(j, k)
545               d_v(i, k) = d_v(i, k) + y_d_v(j, k)                  d_v(i, k) = d_v(i, k) + y_d_v(j, k)
546               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
547                 END DO
548            END DO            END DO
        END DO  
549    
550         !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
551    
552         DO j = 1, knon            DO j = 1, knon
553            i = ni(j)               i = ni(j)
554            uzon(j) = yu(j, 1) + y_d_u(j, 1)               uzon(j) = yu(j, 1) + y_d_u(j, 1)
555            vmer(j) = yv(j, 1) + y_d_v(j, 1)               vmer(j) = yv(j, 1) + y_d_v(j, 1)
556            tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
557            qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
558            zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &
559                 1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1)))*(ypaprs(j, 1)-ypplay(j, 1))
560            tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
561            rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
562            IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
563               rugo1(j) = rugos(i, nsrf)                  rugo1(j) = rugos(i, nsrf)
564            END IF               END IF
565            psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
566            patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
567    
568            qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
569         END DO            END DO
570    
571         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &
572              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &
573              yu10m, yustar)                 yt10m, yq10m, yu10m, yustar)
   
        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)  
574    
575         END DO            DO j = 1, knon
576                 i = ni(j)
577                 t2m(i, nsrf) = yt2m(j)
578                 q2m(i, nsrf) = yq2m(j)
579    
580         DO i = 1, knon               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
581            y_cd_h(i) = ycoefh(i, 1)               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
582            y_cd_m(i) = ycoefm(i, 1)               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
        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  
583    
        DO j = 1, knon  
           DO k = 1, klev + 1  
              i = ni(j)  
              q2(i, k, nsrf) = yq2(j, k)  
584            END DO            END DO
585         END DO  
586         !IM "slab" ocean            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
587         IF (nsrf == is_oce) THEN                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
588                   yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
589    
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               IF (pctsrf_new(i, is_sic)>epsfra) THEN                  q2(i, k, nsrf) = yq2(j, k)
608                  flux_g(i) = y_flux_g(j)               END DO
              ELSE  
                 flux_g(i) = 0.  
              END IF  
609            END DO            END DO
610           end IF if_knon
611         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  
612    
613      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
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.47  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21