/[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 155 by guez, Wed Jul 8 17:03:45 2015 UTC 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, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, rmu0, ts, cdmmax, &
8         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, snow, &
9         paprs, pplay, snow, qsurf, evap, falbe, fluxlat, rain_fall, snow_f, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, d_q, d_u, &         rlat, rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, capcl, &         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, fqcalving, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        ffonte, run_off_lic_0, flux_o, flux_g, tslab)  
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
# Line 31  contains Line 30  contains
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
37      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
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      use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42        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    
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):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
     REAL, intent(in):: co2_ppm ! taux CO2 atmosphere  
57      REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)      REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL, INTENT(IN):: ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
# Line 70  contains Line 67  contains
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, intent(inout):: falbe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
# Line 87  contains Line 84  contains
84      REAL, intent(in):: fder(klon)      REAL, intent(in):: fder(klon)
85      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
86    
87      REAL rugos(klon, nbsrf)      REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
     ! rugos----input-R- longeur de rugosite (en m)  
88    
     LOGICAL, INTENT(IN):: debut  
89      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
90      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
91    
# Line 118  contains Line 113  contains
113      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
114      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
115      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
116      !IM "slab" ocean      ! IM "slab" ocean
117    
118      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
119      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
# Line 126  contains Line 121  contains
121      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
122      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
123    
124      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
125      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
126      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
127      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
128      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
129      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
130      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
# Line 149  contains Line 144  contains
144      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
145      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
146    
     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 tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
   
147      ! Local:      ! Local:
148    
149      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
150      real ytslab(klon)  
151        ! la nouvelle repartition des surfaces sortie de l'interface
152        REAL, save:: pctsrf_new_oce(klon)
153        REAL, save:: pctsrf_new_sic(klon)
154    
155      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
156      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
157    
# Line 185  contains Line 175  contains
175      REAL ysnow_f(klon)      REAL ysnow_f(klon)
176      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
177    
     REAL ysollw(klon), ysolsw(klon)  
178      REAL yfder(klon)      REAL yfder(klon)
179      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
180    
# Line 220  contains Line 209  contains
209      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "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
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)
218      REAL ypblh(klon)      REAL ypblh(klon)
# Line 283  contains Line 267  contains
267      yrain_f = 0.      yrain_f = 0.
268      ysnow_f = 0.      ysnow_f = 0.
269      yfder = 0.      yfder = 0.
     ysolsw = 0.  
     ysollw = 0.  
270      yrugos = 0.      yrugos = 0.
271      yu1 = 0.      yu1 = 0.
272      yv1 = 0.      yv1 = 0.
# Line 296  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.
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.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
287      d_ts = 0.      d_ts = 0.
288      yfluxlat = 0.      yfluxlat = 0.
289      flux_t = 0.      flux_t = 0.
# Line 322  contains Line 300  contains
300      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
301      ! (\`a affiner)      ! (\`a affiner)
302    
303      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
304        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
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:      ! Boucler sur toutes les sous-fractions du sol:
314    
315      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 346  contains Line 330  contains
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) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
# Line 354  contains Line 337  contains
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)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
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            ! For continent, copy soil water content            ! For continent, copy soil water content
# Line 472  contains Line 450  contains
450                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
451    
452            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
453            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, jour, firstcal, rlat, knon, nsrf, ni(:knon), &
454                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &                 ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, yv1, &
455                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, yrads, &
456                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
457                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
458                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &
459                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &                 y_fqcalving, y_ffonte, y_run_off_lic_0)
                y_flux_g)  
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 583  contains
583    
584            END DO            END DO
585    
586            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, 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 630  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\`ere 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  
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.155  
changed lines
  Added in v.202
  ViewVC Help
Powered by ViewVC 1.1.21