/[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 215 by guez, Tue Mar 28 12:46:28 2017 UTC revision 223 by guez, Fri Apr 28 13:22:36 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, mu0, ftsol, cdmmax, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10         rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
12         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &         q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)         trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
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 52  contains Line 52  contains
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):: julien ! jour de l'annee en cours
56      REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temp\'erature du sol (en K)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
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
60      LOGICAL, INTENT(IN):: ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
# Line 79  contains Line 79  contains
79      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_f(klon)
80      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
81    
82      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
83      REAL, intent(in):: fder(klon)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
     REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)  
84      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
85      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
86    
# Line 92  contains Line 91  contains
91      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
92      ! changement pour "u" et "v"      ! changement pour "u" et "v"
93    
94      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour ftsol      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
95    
96      REAL, intent(out):: flux_t(klon, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
97      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
# Line 115  contains Line 114  contains
114      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
115      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
116      REAL zv1(klon)      REAL zv1(klon)
117      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
118      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
119    
120      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
# Line 125  contains Line 124  contains
124      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
125      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
126      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
127      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
128      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
129      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
130      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 171  contains Line 169  contains
169      REAL ysnow_f(klon)      REAL ysnow_f(klon)
170      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
171    
     REAL yfder(klon)  
172      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
173      REAL yfluxlat(klon)      REAL yfluxlat(klon)
174      REAL y_d_ts(klon)      REAL y_d_ts(klon)
# Line 255  contains Line 252  contains
252      zu1 = 0.      zu1 = 0.
253      zv1 = 0.      zv1 = 0.
254      ypct = 0.      ypct = 0.
     yts = 0.  
255      yqsurf = 0.      yqsurf = 0.
256      yrain_f = 0.      yrain_f = 0.
257      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
258      yrugos = 0.      yrugos = 0.
259      yu1 = 0.      yu1 = 0.
260      yv1 = 0.      yv1 = 0.
     yrads = 0.  
261      ypaprs = 0.      ypaprs = 0.
262      ypplay = 0.      ypplay = 0.
263      ydelp = 0.      ydelp = 0.
# Line 297  contains Line 291  contains
291    
292      ! Tester si c'est le moment de lire le fichier:      ! Tester si c'est le moment de lire le fichier:
293      if (mod(itap - 1, lmt_pas) == 0) then      if (mod(itap - 1, lmt_pas) == 0) then
294         CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)         CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
295      endif      endif
296    
297      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
# Line 326  contains Line 320  contains
320               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
321               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
322               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
323               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              yrugos(j) = rugos(i, nsrf)  
324               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
325               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
326               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
327               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
328               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
329               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
330            END DO            END DO
# Line 359  contains Line 352  contains
352            END DO            END DO
353    
354            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
355            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, yu, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
356                 yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
357                   coefh(:knon, :))
358            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
359               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
360               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 435  contains Line 429  contains
429                 ypplay, ydelp, y_d_v, y_flux_v(:knon))                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
430    
431            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
432            CALL clqh(dtime, jour, firstcal, nsrf, ni(:knon), ytsoil(:knon, :), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
433                 yqsol, mu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &
434                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &
435                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfder, yfluxlat(:knon), &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &
436                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 ysnow_f, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &
437                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, &                 y_d_t, y_d_q, y_d_ts(:knon), yz0_new, y_flux_t(:knon), &
438                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_flux_q(:knon), y_dflux_t(:knon), y_dflux_q(:knon), &
439                   y_fqcalving, y_ffonte, y_run_off_lic_0)
440    
441            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
442            yrugm = 0.            yrugm = 0.
# Line 481  contains Line 476  contains
476            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
477            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
478            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
479            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
480            DO j = 1, knon            DO j = 1, knon
481               i = ni(j)               i = ni(j)
482               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
483               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
484               fsnow(i, nsrf) = snow(j)               fsnow(i, nsrf) = snow(j)
485               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
486               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
487               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
488               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
489                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
490                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
491               END IF               END IF
492               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
493               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 540  contains Line 535  contains
535               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
536               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
537               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
538                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
539               END IF               END IF
540               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
541               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 592  contains Line 587  contains
587      END DO loop_surface      END DO loop_surface
588    
589      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
590      rugos(:, is_oce) = rugmer      frugs(:, is_oce) = rugmer
591      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
592      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
593    
Legend:
Removed from v.215  
changed lines
  Added in v.223
  ViewVC Help
Powered by ViewVC 1.1.21