/[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 98 by guez, Tue May 13 17:23:16 2014 UTC revision 99 by guez, Wed Jul 2 18:39:15 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, soil_model, cdmmax, cdhmax, ksta, ksta_ter, &
9         soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &         ok_kzmin, ftsoil, qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         fluxlat, rain_fall, snow_f, solsw, sollw, fder, rlat, rugos, debut, &
11         rain_fall, snow_f, solsw, sollw, fder, rlon, rlat, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
12         rugos, debut, agesno, rugoro, d_t, d_q, d_u, d_v, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
13         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
14         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, &
15         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         tslab, seaice)
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)  
16    
17      ! 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
18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
19      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
20    
# Line 38  contains Line 37  contains
37      USE dimens_m, ONLY: iim, jjm      USE dimens_m, ONLY: iim, jjm
38      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
39      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
40      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  
41      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
42      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
     USE temps, ONLY: annee_ref, itau_phy  
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
     use ymds2ju_m, ONLY: ymds2ju  
   
     ! Arguments:  
46    
47      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
48      INTEGER, INTENT(IN):: itap ! numero du pas de temps      INTEGER, INTENT(IN):: itap ! numero du pas de temps
# Line 68  contains Line 56  contains
56      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
57      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
58      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
59      REAL co2_ppm ! taux CO2 atmosphere      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere
60      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)  
61      LOGICAL, INTENT(IN):: soil_model      LOGICAL, INTENT(IN):: soil_model
62      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
63      REAL ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
64      LOGICAL ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
65      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL ftsoil(klon, nsoilmx, nbsrf)
66      REAL qsol(klon)      REAL, INTENT(inout):: qsol(klon)
67      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
68      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
69      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
# Line 91  contains Line 77  contains
77      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon), snow_f(klon)
78      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
79      REAL fder(klon)      REAL fder(klon)
     REAL, INTENT(IN):: rlon(klon)  
80      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés
81    
82      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
# Line 123  contains Line 108  contains
108      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
109      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
110    
111      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
112      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
113      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
114      !IM "slab" ocean      !IM "slab" ocean
# Line 190  contains Line 175  contains
175      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)
176      REAL yrain_f(klon), ysnow_f(klon)      REAL yrain_f(klon), ysnow_f(klon)
177      REAL ysollw(klon), ysolsw(klon)      REAL ysollw(klon), ysolsw(klon)
178      REAL yfder(klon), ytaux(klon), ytauy(klon)      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 226  contains Line 211  contains
211    
212      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
213    
     ! 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  
   
214      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
215      REAL yustar(klon)      REAL yustar(klon)
216      ! -- LOOP      ! -- LOOP
# Line 278  contains Line 245  contains
245    
246      ytherm = 0.      ytherm = 0.
247    
     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  
   
248      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
249         DO i = 1, klon         DO i = 1, klon
250            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 336  contains Line 274  contains
274      yrain_f = 0.      yrain_f = 0.
275      ysnow_f = 0.      ysnow_f = 0.
276      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
277      ysolsw = 0.      ysolsw = 0.
278      ysollw = 0.      ysollw = 0.
279      yrugos = 0.      yrugos = 0.
# Line 354  contains Line 290  contains
290      pctsrf_new = 0.      pctsrf_new = 0.
291      y_flux_u = 0.      y_flux_u = 0.
292      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
293      y_dflux_t = 0.      y_dflux_t = 0.
294      y_dflux_q = 0.      y_dflux_q = 0.
295      ytsoil = 999999.      ytsoil = 999999.
# Line 365  contains Line 300  contains
300      ywindsp = 0.      ywindsp = 0.
301      ! -- LOOP      ! -- LOOP
302      d_ts = 0.      d_ts = 0.
     !§§§ PB  
303      yfluxlat = 0.      yfluxlat = 0.
304      flux_t = 0.      flux_t = 0.
305      flux_q = 0.      flux_q = 0.
# Line 377  contains Line 311  contains
311      d_v = 0.      d_v = 0.
312      ycoefh = 0.      ycoefh = 0.
313    
     ! Boucler sur toutes les sous-fractions du sol:  
   
314      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On considère ici qu'on
315      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine océanique
316      ! (à affiner)      ! (à affiner)
# Line 387  contains Line 319  contains
319      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
320      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
321    
322        ! Boucler sur toutes les sous-fractions du sol:
323    
324      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
325         ! Chercher les indices :         ! Chercher les indices :
326         ni = 0         ni = 0
# Line 400  contains Line 334  contains
334            END IF            END IF
335         END DO         END DO
336    
        ! 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  
   
337         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
338            DO j = 1, knon            DO j = 1, knon
339               i = ni(j)               i = ni(j)
# Line 426  contains Line 348  contains
348               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
349               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
350               yfder(j) = fder(i)               yfder(j) = fder(i)
              ytaux(j) = flux_u(i, 1, nsrf)  
              ytauy(j) = flux_v(i, 1, nsrf)  
351               ysolsw(j) = solsw(i, nsrf)               ysolsw(j) = solsw(i, nsrf)
352               ysollw(j) = sollw(i, nsrf)               ysollw(j) = sollw(i, nsrf)
353               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
# Line 442  contains Line 362  contains
362               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
363            END DO            END DO
364    
365            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
366            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
367               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
368            ELSE            ELSE
369               yqsol = 0.               yqsol = 0.
370            END IF            END IF
# Line 496  contains Line 413  contains
413            END IF            END IF
414    
415            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
416               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapté à Mars, Richard Fournier et
417               ! Frédéric Hourdin               ! Frédéric Hourdin
418               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
419                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
# Line 525  contains Line 442  contains
442               END DO               END DO
443    
444               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
445                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
              IF (prt_level > 9) THEN  
                 PRINT *, 'USTAR = ', yustar  
              END IF  
446    
447               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut être utilisé comme longueur de mélange
448    
# Line 551  contains Line 465  contains
465            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
466                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
467    
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
   
468            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
469            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &
470                 soil_model, ytsoil, yqsol, ok_veget, ocean, rmu0, co2_ppm, &                 soil_model, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, &
471                 yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, yq, yts, &                 yu1, yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
472                 ypaprs, ypplay, ydelp, yrads, yalb, yalblw, ysnow, yqsurf, &                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
473                 yrain_f, ysnow_f, yfder, ysolsw, yfluxlat, pctsrf_new, &                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &
474                 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, &
475                 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, &
476                 y_flux_o, y_flux_g, ytslab, y_seaice)                 ytslab, y_seaice)
477    
478            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
479            yrugm = 0.            yrugm = 0.
# Line 629  contains Line 539  contains
539               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
540            END DO            END DO
541            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
542               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
543                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
544               DO j = 1, knon               DO j = 1, knon
545                  i = ni(j)                  i = ni(j)
546                  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 566  contains
566               END DO               END DO
567            END DO            END DO
568    
569            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
570    
571            DO j = 1, knon            DO j = 1, knon
572               i = ni(j)               i = ni(j)
# Line 745  contains Line 651  contains
651               END DO               END DO
652    
653            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  
654         end IF if_knon         end IF if_knon
655      END DO loop_surface      END DO loop_surface
656    
Legend:
Removed from v.98  
changed lines
  Added in v.99
  ViewVC Help
Powered by ViewVC 1.1.21