/[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/phylmd/clmain.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/clmain.f revision 214 by guez, Wed Mar 22 13:40:27 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, mu0, ftsol, cdmmax, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, ts, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, snow, &
9         soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         rain_fall, snow_f, solsw, sollw, fder, rlon, rlat, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         rugos, debut, 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, ycoefh, 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 : "ycoefh",      ! 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(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):: mu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temp\'erature du sol (en K)
     LOGICAL ok_veget  
     CHARACTER(len=*), INTENT(IN):: ocean  
     REAL ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)  
     LOGICAL, INTENT(IN):: soil_model  
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
60      LOGICAL ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
61      REAL ftsoil(klon, nsoilmx, nbsrf)  
62      REAL qsol(klon)      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 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)
74      REAL alblw(klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
75    
76      REAL fluxlat(klon, nbsrf)      REAL, intent(in):: rain_fall(klon)
77        ! liquid water mass flux (kg/m2/s), positive down
78    
79      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: snow_f(klon)
80      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      ! solid water mass flux (kg/m2/s), positive down
     REAL fder(klon)  
     REAL, INTENT(IN):: rlon(klon)  
     REAL, INTENT(IN):: rlat(klon) ! latitude en degrés  
81    
82      REAL rugos(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
83      ! rugos----input-R- longeur de rugosite (en m)      REAL, intent(in):: fder(klon)
84        REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
     LOGICAL, INTENT(IN):: debut  
85      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
86      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
87    
# Line 108  contains Line 92  contains
92      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
93      ! changement pour "u" et "v"      ! changement pour "u" et "v"
94    
95      REAL d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour ftsol
     ! d_ts-----output-R- le changement pour "ts"  
96    
97      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
98      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
99      !                    (orientation positive vers le bas)      ! le bas) à la surface
100      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
101        REAL, intent(out):: flux_q(klon, nbsrf)
102      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      ! flux de vapeur d'eau (kg/m2/s) à la surface
103      ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
104      ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
105        ! tension du vent à la surface, en Pa
106    
107      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
108      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
109    
110      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
111      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
112      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
113      !IM "slab" ocean      ! IM "slab" ocean
114    
115      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
116      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
# Line 134  contains Line 118  contains
118      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
119      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
120    
121      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
122      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
123      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
124      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
125      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
126      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
127      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
# Line 157  contains Line 141  contains
141      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
142      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
143    
144      REAL flux_o(klon), flux_g(klon)      ! Local:
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
   
     REAL tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
145    
146      REAL seaice(klon)      LOGICAL:: firstcal = .true.
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
147    
148      ! Local:      ! la nouvelle repartition des surfaces sortie de l'interface
149        REAL, save:: pctsrf_new_oce(klon)
150        REAL, save:: pctsrf_new_sic(klon)
151    
     REAL y_flux_o(klon), y_flux_g(klon)  
     real ytslab(klon)  
     real y_seaice(klon)  
152      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
153      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
154      REAL rugmer(klon)      REAL rugmer(klon)
   
155      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
156      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
157      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
158      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
159      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
160      ! la premiere couche      ! la premiere couche
161      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
     REAL yrain_f(klon), ysnow_f(klon)  
     REAL ysollw(klon), ysolsw(klon)  
     REAL yfder(klon), ytaux(klon), ytauy(klon)  
     REAL yrugm(klon), yrads(klon), yrugoro(klon)  
162    
163      REAL yfluxlat(klon)      real yqsol(klon)
164        ! column-density of water in soil, in kg m-2
165    
166        REAL yrain_f(klon)
167        ! liquid water mass flux (kg/m2/s), positive down
168    
169        REAL ysnow_f(klon)
170        ! solid water mass flux (kg/m2/s), positive down
171    
172        REAL yfder(klon)
173        REAL yrugm(klon), yrads(klon), yrugoro(klon)
174        REAL yfluxlat(klon)
175      REAL y_d_ts(klon)      REAL y_d_ts(klon)
176      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
177      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
178      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
179      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
180      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
181      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
182      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 221  contains Line 198  contains
198      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
199    
200      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
201      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
202      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
203    
204      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  
205    
206      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
207      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
208    
209      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
210      REAL ypblh(klon)      REAL ypblh(klon)
# Line 278  contains Line 232  contains
232    
233      ytherm = 0.      ytherm = 0.
234    
     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  
   
235      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
236         DO i = 1, klon         DO i = 1, klon
237            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 331  contains Line 256  contains
256      yts = 0.      yts = 0.
257      ysnow = 0.      ysnow = 0.
258      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
259      yrain_f = 0.      yrain_f = 0.
260      ysnow_f = 0.      ysnow_f = 0.
261      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
262      yrugos = 0.      yrugos = 0.
263      yu1 = 0.      yu1 = 0.
264      yv1 = 0.      yv1 = 0.
# Line 351  contains Line 270  contains
270      yv = 0.      yv = 0.
271      yt = 0.      yt = 0.
272      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
     !$$ PB  
273      y_dflux_t = 0.      y_dflux_t = 0.
274      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
275      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
276      d_ts = 0.      d_ts = 0.
     !§§§ PB  
     yfluxlat = 0.  
277      flux_t = 0.      flux_t = 0.
278      flux_q = 0.      flux_q = 0.
279      flux_u = 0.      flux_u = 0.
280      flux_v = 0.      flux_v = 0.
281        fluxlat = 0.
282      d_t = 0.      d_t = 0.
283      d_q = 0.      d_q = 0.
284      d_u = 0.      d_u = 0.
285      d_v = 0.      d_v = 0.
286      ycoefh = 0.      ycoefh = 0.
287    
288      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
289        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
290      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! (\`a affiner)
     ! peut avoir potentiellement de la glace sur tout le domaine océanique  
     ! (à affiner)  
291    
292      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
293        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
294      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
295      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
296    
297        ! Tester si c'est le moment de lire le fichier:
298        if (mod(itap - 1, lmt_pas) == 0) then
299           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
300        endif
301    
302        ! Boucler sur toutes les sous-fractions du sol:
303    
304      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
305         ! Chercher les indices :         ! Chercher les indices :
306         ni = 0         ni = 0
307         knon = 0         knon = 0
308         DO i = 1, klon         DO i = 1, klon
309            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
310            ! "potentielles"            ! "potentielles"
311            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
312               knon = knon + 1               knon = knon + 1
# Line 400  contains Line 314  contains
314            END IF            END IF
315         END DO         END DO
316    
        ! 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  
   
317         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
318            DO j = 1, knon            DO j = 1, knon
319               i = ni(j)               i = ni(j)
320               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
321               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
              ytslab(i) = tslab(i)  
322               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
323               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
324               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
325               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
326               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
327               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
328               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)  
329               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
330               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
331               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
332               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
333               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
334               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
335               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))  
336            END DO            END DO
337    
338            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
339            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
340               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
341            ELSE            ELSE
342               yqsol = 0.               yqsol = 0.
343            END IF            END IF
344    
345            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  
346    
347            DO k = 1, klev            DO k = 1, klev
348               DO j = 1, knon               DO j = 1, knon
# Line 473  contains Line 358  contains
358            END DO            END DO
359    
360            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
361            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, yu, &
362                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))
363            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
364               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
365               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 493  contains Line 378  contains
378                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
379               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
380               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
381             END IF            END IF
382    
383            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
384               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
385               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
386               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
387                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
388                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 525  contains Line 410  contains
410               END DO               END DO
411    
412               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
413                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
414    
415               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  
416    
417               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
418                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
419                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
420                       yustar, iflag_pbl)                       iflag_pbl)
421               ELSE               ELSE
422                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
423                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 547  contains Line 429  contains
429    
430            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
431            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
432                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
433            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
434                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
   
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
435    
436            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
437            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, jour, firstcal, nsrf, ni(:knon), ytsoil(:knon, :), &
438                 soil_model, ytsoil, yqsol, ok_veget, ocean, rmu0, co2_ppm, &                 yqsol, mu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
439                 yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, yq, yts, &                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &
440                 ypaprs, ypplay, ydelp, yrads, yalb, yalblw, ysnow, yqsurf, &                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat(:knon), &
441                 yrain_f, ysnow_f, yfder, ysolsw, yfluxlat, pctsrf_new, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
442                 yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, y_flux_t, y_flux_q, &                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, &
443                 y_dflux_t, y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, &                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
                y_flux_o, y_flux_g, ytslab, y_seaice)  
444    
445            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
446            yrugm = 0.            yrugm = 0.
# Line 588  contains Line 465  contains
465                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
466                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
467                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)
                 flux_t(i, k, nsrf) = y_flux_t(j, k)  
                 flux_q(i, k, nsrf) = y_flux_q(j, k)  
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
468                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
469                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
470               END DO               END DO
471            END DO            END DO
472    
473            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
474              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
475              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
476              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
477    
478              evap(:, nsrf) = -flux_q(:, nsrf)
479    
480            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
481            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
482            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
483            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
484            DO j = 1, knon            DO j = 1, knon
485               i = ni(j)               i = ni(j)
486               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
487               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
488               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
489               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
490               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 629  contains Line 504  contains
504               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
505            END DO            END DO
506            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
507               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
508                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
509               DO j = 1, knon               DO j = 1, knon
510                  i = ni(j)                  i = ni(j)
511                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
512               END DO               END DO
513            END IF            END IF
514            !$$$ PB ajout pour soil  
515            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
516            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  
517    
518            DO j = 1, knon            DO j = 1, knon
519               i = ni(j)               i = ni(j)
# Line 660  contains Line 526  contains
526               END DO               END DO
527            END DO            END DO
528    
529            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
530    
531            DO j = 1, knon            DO j = 1, knon
532               i = ni(j)               i = ni(j)
# Line 693  contains Line 559  contains
559               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
560               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
561               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
   
562            END DO            END DO
563    
564            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
565                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
566                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
567    
568            DO j = 1, knon            DO j = 1, knon
569               i = ni(j)               i = ni(j)
# Line 720  contains Line 585  contains
585                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
586               END DO               END DO
587            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  
588         end IF if_knon         end IF if_knon
589      END DO loop_surface      END DO loop_surface
590    
591      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
592      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
593      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
594        pctsrf(:, is_sic) = pctsrf_new_sic
595    
596        firstcal = .false.
597    
598    END SUBROUTINE clmain    END SUBROUTINE clmain
599    

Legend:
Removed from v.82  
changed lines
  Added in v.214

  ViewVC Help
Powered by ViewVC 1.1.21