/[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 202 by guez, Wed Jun 8 12:23:41 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, ts, 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_fall, 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)
        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    
24      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
25      ! dans la première couche, trois champs ont été créés : "zcoefh",      ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
26      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
27      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du mod\`ele.
28    
     use calendar, ONLY: ymds2ju  
29      use clqh_m, only: clqh      use clqh_m, only: clqh
30      use clvent_m, only: clvent      use clvent_m, only: clvent
31      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
32      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
33      USE conf_gcm_m, ONLY: prt_level      USE conf_gcm_m, ONLY: prt_level, lmt_pas
34      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
     USE dimens_m, ONLY: iim, jjm  
35      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
37      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  
38      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
39        USE interfoce_lim_m, ONLY: interfoce_lim
40        use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42      USE temps, ONLY: annee_ref, itau_phy      use time_phylmdz, only: itap
43      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
44      use vdif_kcay_m, only: vdif_kcay      use vdif_kcay_m, only: vdif_kcay
45      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
46    
     ! Arguments:  
   
47      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
     INTEGER, INTENT(IN):: itap ! numero du pas de temps  
     REAL, INTENT(IN):: date0 ! jour initial  
     REAL, INTENT(inout):: pctsrf(klon, nbsrf)  
48    
49      ! la nouvelle repartition des surfaces sortie de l'interface      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50      REAL, INTENT(out):: pctsrf_new(klon, nbsrf)      ! tableau des pourcentages de surface de chaque maille
51    
52      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
54      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
57        REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
58        REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59        REAL, INTENT(IN):: ksta, ksta_ter
60        LOGICAL, INTENT(IN):: ok_kzmin
61    
62        REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63        ! soil temperature of surface fraction
64    
65        REAL, INTENT(inout):: qsol(klon)
66        ! column-density of water in soil, in kg m-2
67    
68      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
69      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70      REAL, INTENT(IN):: rlon(klon)      REAL, INTENT(inout):: snow(klon, nbsrf)
71      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL qsurf(klon, nbsrf)
72      REAL cufi(klon), cvfi(klon)      REAL evap(klon, nbsrf)
73      ! cufi-----input-R- resolution des mailles en x (m)      REAL, intent(inout):: falbe(klon, nbsrf)
74      ! cvfi-----input-R- resolution des mailles en y (m)  
75        REAL fluxlat(klon, nbsrf)
76    
77        REAL, intent(in):: rain_fall(klon)
78        ! liquid water mass flux (kg/m2/s), positive down
79    
80        REAL, intent(in):: snow_f(klon)
81        ! solid water mass flux (kg/m2/s), positive down
82    
83        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 d_t(klon, klev), d_q(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
93      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
94      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
# Line 83  contains Line 96  contains
96      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
97      ! changement pour "u" et "v"      ! changement pour "u" et "v"
98    
99        REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
100    
101      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
102      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
103      !                    (orientation positive vers le bas)      !                    (orientation positive vers le bas)
104      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
     REAL dflux_t(klon), dflux_q(klon)  
     ! dflux_t derive du flux sensible  
     ! dflux_q derive du flux latent  
     !IM "slab" ocean  
     REAL flux_o(klon), flux_g(klon)  
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
     REAL y_flux_o(klon), y_flux_g(klon)  
     REAL tslab(klon), ytslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
     REAL seaice(klon), y_seaice(klon)  
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
     REAL y_fqcalving(klon), y_ffonte(klon)  
     REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
     ! 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  
     REAL run_off_lic_0(klon), y_run_off_lic_0(klon)  
105    
106      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
107      ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal      ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
108      ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal      ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
109      REAL rugmer(klon), agesno(klon, nbsrf)  
     REAL, INTENT(IN):: rugoro(klon)  
110      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
111      ! taux CO2 atmosphere                          real q2(klon, klev+1, nbsrf)
     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)  
112    
113      REAL fluxlat(klon, nbsrf)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
114        ! dflux_t derive du flux sensible
115        ! dflux_q derive du flux latent
116        ! IM "slab" ocean
117    
118        REAL, intent(out):: ycoefh(klon, klev)
119        REAL, intent(out):: zu1(klon)
120        REAL zv1(klon)
121        REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
122        REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
123    
124        ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
125        ! (Comme les autres diagnostics on cumule dans physiq ce qui
126        ! permet de sortir les grandeurs par sous-surface)
127        REAL pblh(klon, nbsrf) ! height of planetary boundary layer
128        REAL capcl(klon, nbsrf)
129        REAL oliqcl(klon, nbsrf)
130        REAL cteicl(klon, nbsrf)
131        REAL pblt(klon, nbsrf)
132        ! pblT------- T au nveau HCL
133        REAL therm(klon, nbsrf)
134        REAL trmb1(klon, nbsrf)
135        ! trmb1-------deep_cape
136        REAL trmb2(klon, nbsrf)
137        ! trmb2--------inhibition
138        REAL trmb3(klon, nbsrf)
139        ! trmb3-------Point Omega
140        REAL plcl(klon, nbsrf)
141        REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
142        ! ffonte----Flux thermique utilise pour fondre la neige
143        ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
144        !           hauteur de neige, en kg/m2/s
145        REAL run_off_lic_0(klon)
146    
147      REAL, intent(in):: rain_fall(klon), snow_f(klon)      ! Local:
     REAL fder(klon)  
148    
149      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      LOGICAL:: firstcal = .true.
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
150    
151      REAL zcoefh(klon, klev)      ! la nouvelle repartition des surfaces sortie de l'interface
152      REAL zu1(klon)      REAL, save:: pctsrf_new_oce(klon)
153      REAL zv1(klon)      REAL, save:: pctsrf_new_sic(klon)
154    
155      !$$$ PB ajout pour soil      REAL y_fqcalving(klon), y_ffonte(klon)
156      LOGICAL, INTENT(IN):: soil_model      real y_run_off_lic_0(klon)
     !IM ajout seuils cdrm, cdrh  
     REAL cdmmax, cdhmax  
157    
158      REAL ksta, ksta_ter      REAL rugmer(klon)
     LOGICAL ok_kzmin  
159    
     REAL ftsoil(klon, nsoilmx, nbsrf)  
160      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
     REAL qsol(klon)  
161    
162      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
163      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
164      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
165      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
166      ! la premiere couche      ! la premiere couche
167      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
168      REAL yrain_f(klon), ysnow_f(klon)  
169      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      real yqsol(klon)
170      REAL yfder(klon), ytaux(klon), ytauy(klon)      ! column-density of water in soil, in kg m-2
171    
172        REAL yrain_f(klon)
173        ! liquid water mass flux (kg/m2/s), positive down
174    
175        REAL ysnow_f(klon)
176        ! solid water mass flux (kg/m2/s), positive down
177    
178        REAL yfder(klon)
179      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
180    
181      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 182  contains Line 191  contains
191      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
192      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
193    
     LOGICAL ok_nonloc  
     PARAMETER (ok_nonloc=.FALSE.)  
194      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
195    
196      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
197      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
198      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
199      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1)
200      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
201    
202      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
# Line 199  contains Line 206  contains
206      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
207    
208      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
209      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
210      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
211    
212      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)  
213    
214      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
215      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
216    
217      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  
218      REAL ypblh(klon)      REAL ypblh(klon)
219      REAL ylcl(klon)      REAL ylcl(klon)
220      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 271  contains Line 236  contains
236      LOGICAL zxli      LOGICAL zxli
237      PARAMETER (zxli=.FALSE.)      PARAMETER (zxli=.FALSE.)
238    
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER(len=20):: modname = 'clmain'  
   
239      !------------------------------------------------------------      !------------------------------------------------------------
240    
241      ytherm = 0.      ytherm = 0.
242    
     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  
   
243      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
244         DO i = 1, klon         DO i = 1, klon
245            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 334  contains Line 264  contains
264      yts = 0.      yts = 0.
265      ysnow = 0.      ysnow = 0.
266      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
267      yrain_f = 0.      yrain_f = 0.
268      ysnow_f = 0.      ysnow_f = 0.
269      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
     ysollwdown = 0.  
270      yrugos = 0.      yrugos = 0.
271      yu1 = 0.      yu1 = 0.
272      yv1 = 0.      yv1 = 0.
# Line 355  contains Line 278  contains
278      yv = 0.      yv = 0.
279      yt = 0.      yt = 0.
280      yq = 0.      yq = 0.
     pctsrf_new = 0.  
281      y_flux_u = 0.      y_flux_u = 0.
282      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
283      y_dflux_t = 0.      y_dflux_t = 0.
284      y_dflux_q = 0.      y_dflux_q = 0.
285      ytsoil = 999999.      ytsoil = 999999.
286      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
287      d_ts = 0.      d_ts = 0.
     !§§§ PB  
288      yfluxlat = 0.      yfluxlat = 0.
289      flux_t = 0.      flux_t = 0.
290      flux_q = 0.      flux_q = 0.
# Line 379  contains Line 294  contains
294      d_q = 0.      d_q = 0.
295      d_u = 0.      d_u = 0.
296      d_v = 0.      d_v = 0.
297      zcoefh = 0.      ycoefh = 0.
298    
299      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
300        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
301        ! (\`a affiner)
302    
303      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
304      ! peut avoir potentiellement de la glace sur tout le domaine océanique      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
     ! (à affiner)  
   
     pctsrf_pot = pctsrf  
305      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
306      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
307    
308        ! Tester si c'est le moment de lire le fichier:
309        if (mod(itap - 1, lmt_pas) == 0) then
310           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
311        endif
312    
313        ! Boucler sur toutes les sous-fractions du sol:
314    
315      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
316         ! Chercher les indices :         ! Chercher les indices :
317         ni = 0         ni = 0
318         knon = 0         knon = 0
319         DO i = 1, klon         DO i = 1, klon
320            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
321            ! "potentielles"            ! "potentielles"
322            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
323               knon = knon + 1               knon = knon + 1
# Line 404  contains Line 325  contains
325            END IF            END IF
326         END DO         END DO
327    
        ! 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  
   
328         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
329            DO j = 1, knon            DO j = 1, knon
330               i = ni(j)               i = ni(j)
331               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
332               yts(j) = ts(i, nsrf)               yts(j) = ts(i, nsrf)
              ytslab(i) = tslab(i)  
333               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
334               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
335               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
336               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
337               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
338               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
339               yfder(j) = fder(i)               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)  
340               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
341               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
342               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
343               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
344               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
345               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
346               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))  
347            END DO            END DO
348    
349            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
350            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
351               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
352            ELSE            ELSE
353               yqsol = 0.               yqsol = 0.
354            END IF            END IF
# Line 486  contains Line 382  contains
382               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
383            END IF            END IF
384    
385            ! on seuille coefm et coefh            ! on met un seuil pour coefm et coefh
386            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
387               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
388               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
# Line 495  contains Line 391  contains
391            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
392               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
393               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
394                    coefm(:, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
395               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
396               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
397             END IF            END IF
398    
399            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
400               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
401               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
402               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
403                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
404                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 530  contains Line 426  contains
426               END DO               END DO
427    
428               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
429                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
430    
431               IF (prt_level > 9) THEN               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
                 PRINT *, 'USTAR = ', yustar  
              END IF  
   
              ! iflag_pbl peut être utilisé comme longueur de mélange  
432    
433               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
434                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
435                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
436                       yustar, iflag_pbl)                       iflag_pbl)
437               ELSE               ELSE
438                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
439                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 551  contains Line 444  contains
444            END IF            END IF
445    
446            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
447            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yu, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
448                 ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u)
449            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yv, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
450                 ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
   
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
451    
452            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
453            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat, &            CALL clqh(dtime, jour, firstcal, rlat, knon, nsrf, ni(:knon), &
454                 cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil, &                 ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, yv1, &
455                 yqsol, ok_veget, ocean, npas, nexca, rmu0, co2_ppm, yrugos, &                 coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, yrads, &
456                 yrugoro, yu1, yv1, coefh, yt, yq, yts, ypaprs, ypplay, &                 yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
457                 ydelp, yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
                yfder, ytaux, ytauy, ywindsp, ysollw, ysollwdown, ysolsw, &  
                yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &  
458                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &
459                 y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g, &                 y_fqcalving, y_ffonte, y_run_off_lic_0)
                ytslab, y_seaice)  
460    
461            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
462            yrugm = 0.            yrugm = 0.
# Line 606  contains Line 492  contains
492    
493            evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, 1, nsrf)
494    
495            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
496            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
497            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
498            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 615  contains Line 500  contains
500            DO j = 1, knon            DO j = 1, knon
501               i = ni(j)               i = ni(j)
502               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
503               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
504               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
505               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
506               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 636  contains Line 520  contains
520               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
521            END DO            END DO
522            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
523               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
524                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
525               DO j = 1, knon               DO j = 1, knon
526                  i = ni(j)                  i = ni(j)
527                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
528               END DO               END DO
529            END IF            END IF
530            !$$$ PB ajout pour soil  
531            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
532            DO k = 1, nsoilmx            DO k = 1, nsoilmx
533               DO j = 1, knon               DO j = 1, knon
# Line 663  contains Line 543  contains
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) + coefh(j, k)                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
547               END DO               END DO
548            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)
# Line 703  contains Line 583  contains
583    
584            END DO            END DO
585    
586            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t, &
587                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q, yu, yv, yt, yq, ypblh(:knon), ycapcl, yoliqcl, &
588                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
589    
590            DO j = 1, knon            DO j = 1, knon
# Line 727  contains Line 607  contains
607                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
608               END DO               END DO
609            END DO            END DO
           !IM "slab" ocean  
           IF (nsrf == is_oce) THEN  
              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  
610         end IF if_knon         end IF if_knon
611      END DO loop_surface      END DO loop_surface
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.62  
changed lines
  Added in v.202
  ViewVC Help
Powered by ViewVC 1.1.21