/[lmdze]/trunk/Sources/phylmd/physiq.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/physiq.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 204 by guez, Wed Jun 8 15:27:32 2016 UTC revision 205 by guez, Tue Jun 21 15:16:03 2016 UTC
# Line 56  contains Line 56  contains
56      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
59      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
60      use yoegwd, only: sugwd      use yoegwd, only: sugwd
61      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
# Line 107  contains Line 106  contains
106    
107      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
108    
     LOGICAL, PARAMETER:: check = .FALSE.  
     ! Verifier la conservation du modele en eau  
   
109      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
110      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
111    
# Line 129  contains Line 125  contains
125    
126      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
127    
128      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
129      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
130      SAVE swdn0, swdn, swup0, swup  
131        REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
132      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
133    
134      ! prw: precipitable water      ! prw: precipitable water
135      real prw(klon)      real prw(klon)
# Line 151  contains Line 145  contains
145      ! Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
146      ! "physiq".      ! "physiq".
147    
148      REAL radsol(klon)      REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
149    
150      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
151    
# Line 160  contains Line 153  contains
153      ! soil temperature of surface fraction      ! soil temperature of surface fraction
154    
155      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
156      REAL fluxlat(klon, nbsrf)      REAL, save:: fluxlat(klon, nbsrf)
     SAVE fluxlat  
157    
158      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
159      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
# Line 200  contains Line 192  contains
192      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
193      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
194      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
     REAL ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige  
195    
196      REAL fqcalving(klon, nbsrf)      REAL, save:: ffonte(klon, nbsrf)
197        ! flux thermique utilise pour fondre la neige
198    
199        REAL, save:: fqcalving(klon, nbsrf)
200      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
201      ! hauteur de neige, en kg / m2 / s      ! hauteur de neige, en kg / m2 / s
202    
203      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
204    
205      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
206      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
207      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
208      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
209      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
210      save pfrac_1nucl  
211      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
212      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
213    
# Line 227  contains Line 221  contains
221    
222      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon), devap(klon) ! evaporation and its derivative
223      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
224      REAL dlw(klon) ! derivee infra rouge      REAL, save:: dlw(klon) ! derivee infra rouge
     SAVE dlw  
225      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
226      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
227      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
# Line 287  contains Line 280  contains
280      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
281      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
282    
283      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
284    
285      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
286      real longi      real longi
287      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
288      REAL za, zb      REAL zb
289      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
290      real zqsat(klon, llm)      real zqsat(klon, llm)
291      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
# Line 322  contains Line 315  contains
315      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
316      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
317      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
318      REAL cape(klon) ! CAPE      REAL, save:: cape(klon)
     SAVE cape  
319    
320      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
321    
# Line 335  contains Line 327  contains
327      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
328      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
329      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
330      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
331      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
332      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
333      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 351  contains Line 343  contains
343      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
344      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
345    
346      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
347        real rain_lsc(klon)
348      REAL, save:: snow_con(klon) ! neige (mm / s)      REAL, save:: snow_con(klon) ! neige (mm / s)
349      real snow_lsc(klon)      real snow_lsc(klon)
350      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
# Line 397  contains Line 390  contains
390      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
391    
392      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
393      REAL ztsol(klon)      REAL ztsol(klon)
394    
395      REAL d_t_ec(klon, llm)      REAL d_t_ec(klon, llm)
# Line 406  contains Line 397  contains
397    
398      REAL ZRCPD      REAL ZRCPD
399    
400      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
401      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! temperature and humidity at 2 m
402    
403        REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
404      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
405      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
406    
# Line 428  contains Line 421  contains
421      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
422      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
423    
424      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
425      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
426    
427      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
428      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 439  contains Line 432  contains
432      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
433      ! concentration.      ! concentration.
434    
     SAVE u10m  
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
435      real zmasse(klon, llm)      real zmasse(klon, llm)
436      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
437    
# Line 705  contains Line 684  contains
684      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
685    
686      ftsol = ftsol + d_ts      ftsol = ftsol + d_ts
687      zxtsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
688      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
689         DO i = 1, klon         DO i = 1, klon
690            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)
# Line 730  contains Line 709  contains
709         ENDDO         ENDDO
710      ENDDO      ENDDO
711    
712      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
713      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
714         DO i = 1, klon         DO i = 1, klon
715            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
716                 ftsol(i, nsrf) = ztsol(i)
717            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
718            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
719            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
720            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
721            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
722            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
723                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
724            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
725            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
726            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
727            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
728            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
729            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
730            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
731            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
732            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
733            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
734         ENDDO         ENDDO
735      ENDDO      ENDDO
736    
737      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
738    
739      DO i = 1, klon      DO i = 1, klon
740         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
741      ENDDO      ENDDO
742    
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
   
743      ! Appeler la convection      ! Appeler la convection
744    
745      if (conv_emanuel) then      if (conv_emanuel) then
        da = 0.  
        mp = 0.  
        phi = 0.  
746         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
747              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
748              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
# Line 818  contains Line 792  contains
792         ENDDO         ENDDO
793      ENDDO      ENDDO
794    
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "aprescon = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i) / REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i)) * airephy(i) / REAL(klon)  
        ENDDO  
        zx_t = zx_t / za * dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
795      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
796         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
797         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 917  contains Line 877  contains
877            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
878         ENDDO         ENDDO
879      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "apresilp = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i) / REAL(klon)  
           zx_t = zx_t + (rain_lsc(i) &  
                + snow_lsc(i)) * airephy(i) / REAL(klon)  
        ENDDO  
        zx_t = zx_t / za * dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
880    
881      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
882    
# Line 1048  contains Line 995  contains
995         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
996    
997         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
998         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
999              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
1000              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
1001              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1228  contains Line 1175  contains
1175      CALL histwrite_phy("precip", rain_fall + snow_fall)      CALL histwrite_phy("precip", rain_fall + snow_fall)
1176      CALL histwrite_phy("plul", rain_lsc + snow_lsc)      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1177      CALL histwrite_phy("pluc", rain_con + snow_con)      CALL histwrite_phy("pluc", rain_con + snow_con)
1178      CALL histwrite_phy("tsol", zxtsol)      CALL histwrite_phy("tsol", ztsol)
1179      CALL histwrite_phy("t2m", zt2m)      CALL histwrite_phy("t2m", zt2m)
1180      CALL histwrite_phy("q2m", zq2m)      CALL histwrite_phy("q2m", zq2m)
1181      CALL histwrite_phy("u10m", zu10m)      CALL histwrite_phy("u10m", zu10m)
Legend:
Removed from v.204  
changed lines
  Added in v.205
  ViewVC Help
Powered by ViewVC 1.1.21