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