/[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 213 by guez, Mon Feb 27 15:44:55 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, snow, &         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 67  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, INTENT(inout):: snow(klon, nbsrf)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
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)
74        REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
     REAL fluxlat(klon, nbsrf)  
75    
76      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
77      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg/m2/s), positive down
# Line 80  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 93  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 116  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 126  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 156  contains Line 153  contains
153      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
154      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
155      REAL yalb(klon)      REAL yalb(klon)
156    
157      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
158      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! On ajoute en output yu1 et yv1 qui sont les vents dans
159      ! la premiere couche      ! la premi\`ere couche.
160      REAL ysnow(klon), yqsurf(klon), yagesno(klon)      
161        REAL snow(klon), yqsurf(klon), yagesno(klon)
162    
163      real yqsol(klon)      real yqsol(klon)
164      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
# Line 170  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)
175      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
176      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
# Line 256  contains Line 252  contains
252      zu1 = 0.      zu1 = 0.
253      zv1 = 0.      zv1 = 0.
254      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 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 277  contains Line 269  contains
269      y_dflux_q = 0.      y_dflux_q = 0.
270      yrugoro = 0.      yrugoro = 0.
271      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
272      flux_t = 0.      flux_t = 0.
273      flux_q = 0.      flux_q = 0.
274      flux_u = 0.      flux_u = 0.
275      flux_v = 0.      flux_v = 0.
276        fluxlat = 0.
277      d_t = 0.      d_t = 0.
278      d_q = 0.      d_q = 0.
279      d_u = 0.      d_u = 0.
# Line 299  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 322  contains Line 314  contains
314               i = ni(j)               i = ni(j)
315               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
316               yts(j) = ftsol(i, nsrf)               yts(j) = ftsol(i, nsrf)
317               ysnow(j) = snow(i, nsrf)               snow(j) = fsnow(i, nsrf)
318               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
319               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
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 361  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 437  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                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &                 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 473  contains Line 466  contains
466               END DO               END DO
467            END DO            END DO
468    
469            DO j = 1, knon            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
470               i = ni(j)            flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
471               flux_t(i, nsrf) = y_flux_t(j)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
472               flux_q(i, nsrf) = y_flux_q(j)            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
              flux_u(i, nsrf) = y_flux_u(j)  
              flux_v(i, nsrf) = y_flux_v(j)  
           END DO  
473    
474            evap(:, nsrf) = -flux_q(:, nsrf)            evap(:, nsrf) = -flux_q(:, nsrf)
475    
476            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
477            snow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
478            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
479            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, 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               snow(i, nsrf) = ysnow(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 546  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 581  contains
581                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
582               END DO               END DO
583            END DO            END DO
584           else
585              fsnow(:, nsrf) = 0.
586         end IF if_knon         end IF if_knon
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.213  
changed lines
  Added in v.223
  ViewVC Help
Powered by ViewVC 1.1.21