/[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

revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC revision 101 by guez, Mon Jul 7 17:45:21 2014 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, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, ts, &         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
9         soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &
11         rain_fall, snow_f, solsw, sollw, fder, rlon, rlat, &         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &
12         rugos, debut, agesno, rugoro, d_t, d_q, d_u, d_v, &         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &
        d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &  
        dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &  
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &
14         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)
15    
16      ! 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
17      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
18      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
19    
# Line 29  contains Line 27  contains
27      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois
28      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du modèle.
29    
     use calendar, ONLY: ymds2ju  
30      use clqh_m, only: clqh      use clqh_m, only: clqh
31      use clvent_m, only: clvent      use clvent_m, only: clvent
32      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
# Line 39  contains Line 36  contains
36      USE dimens_m, ONLY: iim, jjm      USE dimens_m, ONLY: iim, jjm
37      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
38      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
39      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  
40      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
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
     USE temps, ONLY: annee_ref, itau_phy  
42      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
43      use vdif_kcay_m, only: vdif_kcay      use vdif_kcay_m, only: vdif_kcay
44      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
45    
     ! Arguments:  
   
46      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
47      INTEGER, INTENT(IN):: itap ! numero du pas de temps      INTEGER, INTENT(IN):: itap ! numero du pas de temps
48      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
# Line 68  contains Line 55  contains
55      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
56      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
57      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
58      REAL co2_ppm ! taux CO2 atmosphere      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere
59      LOGICAL ok_veget      REAL, INTENT(IN):: ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)
     CHARACTER(len=*), INTENT(IN):: ocean  
     REAL ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)  
     LOGICAL, INTENT(IN):: soil_model  
60      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
61      REAL ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
62      LOGICAL ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
63      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL ftsoil(klon, nsoilmx, nbsrf)
64      REAL qsol(klon)  
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 snow(klon, nbsrf)
# Line 88  contains Line 75  contains
75    
76      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
77    
78      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon)
79        ! liquid water mass flux (kg/m2/s), positive down
80    
81        REAL, intent(in):: snow_f(klon)
82        ! solid water mass flux (kg/m2/s), positive down
83    
84      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
85      REAL fder(klon)      REAL fder(klon)
     REAL, INTENT(IN):: rlon(klon)  
86      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés
87    
88      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
# Line 123  contains Line 114  contains
114      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
115      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
116    
117      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
118      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
119      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
120      !IM "slab" ocean      !IM "slab" ocean
# Line 166  contains Line 157  contains
157      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
158      ! uniqmnt pour slab      ! uniqmnt pour slab
159    
     REAL seaice(klon)  
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
   
160      ! Local:      ! Local:
161    
162      REAL y_flux_o(klon), y_flux_g(klon)      REAL y_flux_o(klon), y_flux_g(klon)
163      real ytslab(klon)      real ytslab(klon)
     real y_seaice(klon)  
164      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
165      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
166    
# Line 187  contains Line 174  contains
174      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
175      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
176      ! la premiere couche      ! la premiere couche
177      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
178      REAL yrain_f(klon), ysnow_f(klon)  
179        real yqsol(klon)
180        ! column-density of water in soil, in kg m-2
181    
182        REAL yrain_f(klon)
183        ! liquid water mass flux (kg/m2/s), positive down
184    
185        REAL ysnow_f(klon)
186        ! solid water mass flux (kg/m2/s), positive down
187    
188      REAL ysollw(klon), ysolsw(klon)      REAL ysollw(klon), ysolsw(klon)
189      REAL yfder(klon), ytaux(klon), ytauy(klon)      REAL yfder(klon)
190      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
191    
192      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 226  contains Line 222  contains
222    
223      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
224    
     ! 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  
   
225      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
226      REAL yustar(klon)      REAL yustar(klon)
227      ! -- LOOP      ! -- LOOP
# Line 278  contains Line 256  contains
256    
257      ytherm = 0.      ytherm = 0.
258    
     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  
   
259      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
260         DO i = 1, klon         DO i = 1, klon
261            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 336  contains Line 285  contains
285      yrain_f = 0.      yrain_f = 0.
286      ysnow_f = 0.      ysnow_f = 0.
287      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
288      ysolsw = 0.      ysolsw = 0.
289      ysollw = 0.      ysollw = 0.
290      yrugos = 0.      yrugos = 0.
# Line 354  contains Line 301  contains
301      pctsrf_new = 0.      pctsrf_new = 0.
302      y_flux_u = 0.      y_flux_u = 0.
303      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
304      y_dflux_t = 0.      y_dflux_t = 0.
305      y_dflux_q = 0.      y_dflux_q = 0.
306      ytsoil = 999999.      ytsoil = 999999.
# Line 365  contains Line 311  contains
311      ywindsp = 0.      ywindsp = 0.
312      ! -- LOOP      ! -- LOOP
313      d_ts = 0.      d_ts = 0.
     !§§§ PB  
314      yfluxlat = 0.      yfluxlat = 0.
315      flux_t = 0.      flux_t = 0.
316      flux_q = 0.      flux_q = 0.
# Line 377  contains Line 322  contains
322      d_v = 0.      d_v = 0.
323      ycoefh = 0.      ycoefh = 0.
324    
     ! Boucler sur toutes les sous-fractions du sol:  
   
325      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On considère ici qu'on
326      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine océanique
327      ! (à affiner)      ! (à affiner)
# Line 387  contains Line 330  contains
330      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
331      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
332    
333        ! Boucler sur toutes les sous-fractions du sol:
334    
335      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
336         ! Chercher les indices :         ! Chercher les indices :
337         ni = 0         ni = 0
# Line 400  contains Line 345  contains
345            END IF            END IF
346         END DO         END DO
347    
        ! 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  
   
348         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
349            DO j = 1, knon            DO j = 1, knon
350               i = ni(j)               i = ni(j)
# Line 426  contains Line 359  contains
359               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
360               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
361               yfder(j) = fder(i)               yfder(j) = fder(i)
              ytaux(j) = flux_u(i, 1, nsrf)  
              ytauy(j) = flux_v(i, 1, nsrf)  
362               ysolsw(j) = solsw(i, nsrf)               ysolsw(j) = solsw(i, nsrf)
363               ysollw(j) = sollw(i, nsrf)               ysollw(j) = sollw(i, nsrf)
364               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
# Line 442  contains Line 373  contains
373               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
374            END DO            END DO
375    
376            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
377            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
378               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
379            ELSE            ELSE
380               yqsol = 0.               yqsol = 0.
381            END IF            END IF
# Line 493  contains Line 421  contains
421                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
422               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
423               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
424             END IF            END IF
425    
426            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
427               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapté à Mars, Richard Fournier et
428               ! Frédéric Hourdin               ! Frédéric Hourdin
429               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
430                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
# Line 525  contains Line 453  contains
453               END DO               END DO
454    
455               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
456                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
              IF (prt_level > 9) THEN  
                 PRINT *, 'USTAR = ', yustar  
              END IF  
457    
458               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut être utilisé comme longueur de mélange
459    
# Line 551  contains Line 476  contains
476            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
477                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
478    
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
   
479            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
480            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &
481                 soil_model, ytsoil, yqsol, ok_veget, ocean, rmu0, co2_ppm, &                 ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, &
482                 yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, yq, yts, &                 yu1, yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
483                 ypaprs, ypplay, ydelp, yrads, yalb, yalblw, ysnow, yqsurf, &                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
484                 yrain_f, ysnow_f, yfder, ysolsw, yfluxlat, pctsrf_new, &                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &
485                 yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, y_flux_t, y_flux_q, &                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &
486                 y_dflux_t, y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, &                 y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g)
                y_flux_o, y_flux_g, ytslab, y_seaice)  
487    
488            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
489            yrugm = 0.            yrugm = 0.
# Line 629  contains Line 549  contains
549               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
550            END DO            END DO
551            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
552               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
553                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
554               DO j = 1, knon               DO j = 1, knon
555                  i = ni(j)                  i = ni(j)
556                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
# Line 660  contains Line 576  contains
576               END DO               END DO
577            END DO            END DO
578    
579            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
580    
581            DO j = 1, knon            DO j = 1, knon
582               i = ni(j)               i = ni(j)
# Line 745  contains Line 661  contains
661               END DO               END DO
662    
663            END IF            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  
664         end IF if_knon         end IF if_knon
665      END DO loop_surface      END DO loop_surface
666    
Legend:
Removed from v.82  
changed lines
  Added in v.101
  ViewVC Help
Powered by ViewVC 1.1.21