/[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 69 by guez, Thu Jul 26 14:37:37 2012 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 11  contains Line 11  contains
11         rain_fall, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi, &         rain_fall, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi, &
12         cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v, &         cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v, &
13         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &
14         dflux_t, dflux_q, zcoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &
15         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &
16         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)
17    
# Line 25  contains Line 25  contains
25      ! sol.      ! sol.
26    
27      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'échanges et le vent
28      ! dans la première couche, trois champs ont été créés : "zcoefh",      ! dans la première couche, trois champs ont été créés : "ycoefh",
29      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois
30      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du modèle.
31    
# Line 69  contains Line 69  contains
69      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
70      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
71      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
72        REAL co2_ppm ! taux CO2 atmosphere
73        LOGICAL ok_veget
74        CHARACTER(len=*), INTENT(IN):: ocean
75        INTEGER npas, nexca
76        REAL ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)
77        LOGICAL, INTENT(IN):: soil_model
78        REAL cdmmax, cdhmax ! seuils cdrm, cdrh
79        REAL ksta, ksta_ter
80        LOGICAL ok_kzmin
81        REAL ftsoil(klon, nsoilmx, nbsrf)
82        REAL qsol(klon)
83      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
84      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
85        REAL snow(klon, nbsrf)
86        REAL qsurf(klon, nbsrf)
87        REAL evap(klon, nbsrf)
88        REAL albe(klon, nbsrf)
89        REAL alblw(klon, nbsrf)
90    
91        REAL fluxlat(klon, nbsrf)
92    
93        REAL, intent(in):: rain_fall(klon), snow_f(klon)
94        REAL solsw(klon, nbsrf), sollw(klon, nbsrf), sollwdown(klon)
95        REAL fder(klon)
96      REAL, INTENT(IN):: rlon(klon)      REAL, INTENT(IN):: rlon(klon)
97      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés
98    
99      REAL cufi(klon), cvfi(klon)      REAL cufi(klon), cvfi(klon)
100      ! cufi-----input-R- resolution des mailles en x (m)      ! cufi-----input-R- resolution des mailles en x (m)
101      ! cvfi-----input-R- resolution des mailles en y (m)      ! cvfi-----input-R- resolution des mailles en y (m)
102    
103        REAL rugos(klon, nbsrf)
104        ! rugos----input-R- longeur de rugosite (en m)
105    
106        LOGICAL, INTENT(IN):: debut
107        LOGICAL, INTENT(IN):: lafin
108        real agesno(klon, nbsrf)
109        REAL, INTENT(IN):: rugoro(klon)
110    
111      REAL d_t(klon, klev), d_q(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
112      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
113      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
# Line 83  contains Line 115  contains
115      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
116      ! changement pour "u" et "v"      ! changement pour "u" et "v"
117    
118        REAL d_ts(klon, nbsrf)
119        ! d_ts-----output-R- le changement pour "ts"
120    
121      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
122      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
123      !                    (orientation positive vers le bas)      !                    (orientation positive vers le bas)
124      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
125    
126        REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
127        ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
128        ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
129    
130        REAL, INTENT(out):: cdragh(klon), cdragm(klon)
131        real q2(klon, klev+1, nbsrf)
132    
133      REAL dflux_t(klon), dflux_q(klon)      REAL dflux_t(klon), dflux_q(klon)
134      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
135      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
136      !IM "slab" ocean      !IM "slab" ocean
137      REAL flux_o(klon), flux_g(klon)  
138      !IM "slab" ocean      REAL, intent(out):: ycoefh(klon, klev)
139      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      REAL, intent(out):: zu1(klon)
140      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      REAL zv1(klon)
141      REAL y_flux_o(klon), y_flux_g(klon)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
142      REAL tslab(klon), ytslab(klon)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
143      ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
144      ! uniqmnt pour slab      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds
145      REAL seaice(klon), y_seaice(klon)      ! physiq ce qui permet de sortir les grdeurs par sous surface)
146      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      REAL pblh(klon, nbsrf)
147      REAL y_fqcalving(klon), y_ffonte(klon)      ! pblh------- HCL
148        REAL capcl(klon, nbsrf)
149        REAL oliqcl(klon, nbsrf)
150        REAL cteicl(klon, nbsrf)
151        REAL pblt(klon, nbsrf)
152        ! pblT------- T au nveau HCL
153        REAL therm(klon, nbsrf)
154        REAL trmb1(klon, nbsrf)
155        ! trmb1-------deep_cape
156        REAL trmb2(klon, nbsrf)
157        ! trmb2--------inhibition
158        REAL trmb3(klon, nbsrf)
159        ! trmb3-------Point Omega
160        REAL plcl(klon, nbsrf)
161      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
162      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
163      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
164      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
165      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon)
   
     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)  
     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
     REAL rugmer(klon), agesno(klon, nbsrf)  
     REAL, INTENT(IN):: rugoro(klon)  
     REAL, INTENT(out):: cdragh(klon), cdragm(klon)  
     ! taux CO2 atmosphere                      
     REAL co2_ppm  
     LOGICAL, INTENT(IN):: debut  
     LOGICAL, INTENT(IN):: lafin  
     LOGICAL ok_veget  
     CHARACTER(len=*), INTENT(IN):: ocean  
     INTEGER npas, nexca  
166    
167      REAL ts(klon, nbsrf)      REAL flux_o(klon), flux_g(klon)
168      ! ts-------input-R- temperature du sol (en Kelvin)      !IM "slab" ocean
169      REAL d_ts(klon, nbsrf)      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')
170      ! d_ts-----output-R- le changement pour "ts"      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')
     REAL snow(klon, nbsrf)  
     REAL qsurf(klon, nbsrf)  
     REAL evap(klon, nbsrf)  
     REAL albe(klon, nbsrf)  
     REAL alblw(klon, nbsrf)  
   
     REAL fluxlat(klon, nbsrf)  
171    
172      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL tslab(klon)
173      REAL fder(klon)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
174        ! uniqmnt pour slab
175    
176      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL seaice(klon)
177      REAL rugos(klon, nbsrf)      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')
     ! rugos----input-R- longeur de rugosite (en m)  
178    
179      REAL zcoefh(klon, klev)      ! Local:
     REAL zu1(klon)  
     REAL zv1(klon)  
180    
181      !$$$ PB ajout pour soil      REAL y_flux_o(klon), y_flux_g(klon)
182      LOGICAL, INTENT(IN):: soil_model      real ytslab(klon)
183      !IM ajout seuils cdrm, cdrh      real y_seaice(klon)
184      REAL cdmmax, cdhmax      REAL y_fqcalving(klon), y_ffonte(klon)
185        real y_run_off_lic_0(klon)
186    
187      REAL ksta, ksta_ter      REAL rugmer(klon)
     LOGICAL ok_kzmin  
188    
     REAL ftsoil(klon, nsoilmx, nbsrf)  
189      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
     REAL qsol(klon)  
190    
191      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
192      REAL yalb(klon)      REAL yalb(klon)
# Line 189  contains Line 220  contains
220      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
221      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
222      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
223      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1)
224      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
225    
226      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
# Line 221  contains Line 252  contains
252      DATA first_appel/ .TRUE./      DATA first_appel/ .TRUE./
253      LOGICAL:: debugindex = .FALSE.      LOGICAL:: debugindex = .FALSE.
254      INTEGER idayref      INTEGER idayref
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf)  
255    
256      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
257      REAL yustar(klon)      REAL yustar(klon)
# Line 233  contains Line 262  contains
262      ! -- LOOP      ! -- LOOP
263    
264      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
     !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds  
     ! physiq ce qui permet de sortir les grdeurs par sous surface)  
     REAL pblh(klon, nbsrf)  
     ! pblh------- HCL  
     REAL plcl(klon, nbsrf)  
     REAL capcl(klon, nbsrf)  
     REAL oliqcl(klon, nbsrf)  
     REAL cteicl(klon, nbsrf)  
     REAL pblt(klon, nbsrf)  
     ! pblT------- T au nveau HCL  
     REAL therm(klon, nbsrf)  
     REAL trmb1(klon, nbsrf)  
     ! trmb1-------deep_cape  
     REAL trmb2(klon, nbsrf)  
     ! trmb2--------inhibition  
     REAL trmb3(klon, nbsrf)  
     ! trmb3-------Point Omega  
265      REAL ypblh(klon)      REAL ypblh(klon)
266      REAL ylcl(klon)      REAL ylcl(klon)
267      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 379  contains Line 391  contains
391      d_q = 0.      d_q = 0.
392      d_u = 0.      d_u = 0.
393      d_v = 0.      d_v = 0.
394      zcoefh = 0.      ycoefh = 0.
395    
396      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
397    
# Line 486  contains Line 498  contains
498               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
499            END IF            END IF
500    
501            ! on seuille coefm et coefh            ! on met un seuil pour coefm et coefh
502            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
503               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
504               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
# Line 495  contains Line 507  contains
507            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
508               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
509               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
510                    coefm(:, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
511               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
512               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
513             END IF             END IF
# Line 551  contains Line 563  contains
563            END IF            END IF
564    
565            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
566            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yu, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
567                 ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u)
568            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yv, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
569                 ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
570    
571            ! pour le couplage            ! pour le couplage
572            ytaux = y_flux_u(:, 1)            ytaux = y_flux_u(:, 1)
573            ytauy = y_flux_v(:, 1)            ytauy = y_flux_v(:, 1)
574    
575            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
576            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat, &            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, &
577                 cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil, &                 rlat, cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, &
578                 yqsol, ok_veget, ocean, npas, nexca, rmu0, co2_ppm, yrugos, &                 ytsoil, yqsol, ok_veget, ocean, npas, nexca, rmu0, &
579                 yrugoro, yu1, yv1, coefh, yt, yq, yts, ypaprs, ypplay, &                 co2_ppm, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), &
580                 ydelp, yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, &                 yt, yq, yts, ypaprs, ypplay, ydelp, yrads, yalb, &
581                 yfder, ytaux, ytauy, ywindsp, ysollw, ysollwdown, ysolsw, &                 yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, ytaux, &
582                 yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 ytauy, ywindsp, ysollw, ysollwdown, ysolsw, yfluxlat, &
583                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, &
584                 y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g, &                 y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, y_fqcalving, &
585                 ytslab, y_seaice)                 y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g, ytslab, &
586                   y_seaice)
587    
588            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
589            yrugm = 0.            yrugm = 0.
# Line 663  contains Line 676  contains
676                  d_q(i, k) = d_q(i, k) + y_d_q(j, k)                  d_q(i, k) = d_q(i, k) + y_d_q(j, k)
677                  d_u(i, k) = d_u(i, k) + y_d_u(j, k)                  d_u(i, k) = d_u(i, k) + y_d_u(j, k)
678                  d_v(i, k) = d_v(i, k) + y_d_v(j, k)                  d_v(i, k) = d_v(i, k) + y_d_v(j, k)
679                  zcoefh(i, k) = zcoefh(i, k) + coefh(j, k)                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
680               END DO               END DO
681            END DO            END DO
682    
Legend:
Removed from v.69  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.21