/[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 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 155 by guez, Wed Jul 8 17:03:45 2015 UTC
# Line 4  module physiq_m Line 4  module physiq_m
4    
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, dayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)         qx, omega, d_u, d_v, d_t, d_qx)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (subversion revision 678)
12    
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z. X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
16    
# Line 25  contains Line 25  contains
25           ok_orodr, ok_orolf           ok_orodr, ok_orolf
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
27      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
28      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use comconst, only: dtphys
29        USE comgeomphy, ONLY: airephy
30      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
31      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq
32      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
33      use conflx_m, only: conflx      use conflx_m, only: conflx
34      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
# Line 70  contains Line 71  contains
71      ! current day number, based at value 1 on January 1st of annee_ref      ! current day number, based at value 1 on January 1st of annee_ref
72    
73      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
74    
75      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
76      ! pression pour chaque inter-couche, en Pa      ! pression pour chaque inter-couche, en Pa
# Line 248  contains Line 248  contains
248      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
249    
250      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
251      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
     REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface  
252    
253      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
254      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 319  contains Line 318  contains
318      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
319      SAVE dlw      SAVE dlw
320      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
321      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
322      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
323      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
324      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 335  contains Line 333  contains
333      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
334      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
335      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
336      REAL, save:: albsol(klon) ! albedo du sol total      REAL, save:: albsol(klon) ! albedo du sol total visible
     REAL, save:: albsollw(klon) ! albedo du sol total  
337      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
338    
339      ! Declaration des procedures appelees      ! Declaration des procedures appelees
# Line 370  contains Line 367  contains
367      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
368      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
369      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
370      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
371      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
372      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
373      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
374      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
375      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
376      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
377      REAL albpla(klon)      REAL, save:: albpla(klon)
378      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
379      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
     SAVE albpla  
     SAVE heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
380    
381      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
382      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
# Line 503  contains Line 495  contains
495      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
496      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.
497    
     REAL zsto  
498      real date0      real date0
499    
500      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
# Line 633  contains Line 624  contains
624    
625         frugs = 0.         frugs = 0.
626         itap = 0         itap = 0
        itaprad = 0  
627         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &
628              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, &
629              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
630              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
631              run_off_lic_0, sig1, w01)              run_off_lic_0, sig1, w01)
# Line 643  contains Line 633  contains
633         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
634         q2 = 1e-8         q2 = 1e-8
635    
636         radpas = NINT(86400. / dtphys / nbapp_rad)         lmt_pas = day_step / iphysiq
637           print *, 'Number of time steps of "physics" per day: ', lmt_pas
638    
639           radpas = lmt_pas / nbapp_rad
640    
641         ! on remet le calendrier a zero         ! On remet le calendrier a zero
642         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
643    
644         CALL printflag(radpas, ok_journe, ok_instan, ok_region)         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
645    
        IF (dtphys * radpas > 21600. .AND. cycle_diurne) THEN  
           print *, "Au minimum 4 appels par jour si cycle diurne"  
           call abort_gcm('physiq', &  
                "Nombre d'appels au rayonnement insuffisant", 1)  
        ENDIF  
   
646         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
647         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
648            ibas_con = 1            ibas_con = 1
# Line 669  contains Line 656  contains
656            rugoro = 0.            rugoro = 0.
657         ENDIF         ENDIF
658    
        lmt_pas = NINT(86400. / dtphys) ! tous les jours  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
659         ecrit_ins = NINT(ecrit_ins/dtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
660         ecrit_hf = NINT(ecrit_hf/dtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
661         ecrit_mth = NINT(ecrit_mth/dtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
# Line 783  contains Line 767  contains
767    
768      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
769      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
     albsollw = sum(falblw * pctsrf, dim = 2)  
770    
771      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
772      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
# Line 799  contains Line 782  contains
782      ! Couche limite:      ! Couche limite:
783    
784      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
785           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, &           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &
786           ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &
787           fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &
788           fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
789           d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &
790           q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &
791           capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &
792           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)           run_off_lic_0, fluxo, fluxg, tslab)
793    
794      ! Incr\'ementation des flux      ! Incr\'ementation des flux
795    
# Line 1252  contains Line 1235  contains
1235              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
1236      endif      endif
1237    
1238      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
1239         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1240         DO i = 1, klon         ! Calcul de l'abedo moyen par maille
1241            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         albsol = sum(falbe * pctsrf, dim = 2)
1242                 + falbe(i, is_lic) * pctsrf(i, is_lic) &  
                + falbe(i, is_ter) * pctsrf(i, is_ter) &  
                + falbe(i, is_sic) * pctsrf(i, is_sic)  
           albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &  
                + falblw(i, is_lic) * pctsrf(i, is_lic) &  
                + falblw(i, is_ter) * pctsrf(i, is_ter) &  
                + falblw(i, is_sic) * pctsrf(i, is_sic)  
        ENDDO  
1243         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
1244         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &
1245              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
1246              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
1247              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
1248              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &
1249              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              solswad, cldtaupi, topswai, solswai)
        itaprad = 0  
1250      ENDIF      ENDIF
1251    
     itaprad = itaprad + 1  
   
1252      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1253    
1254      DO k = 1, llm      DO k = 1, llm
# Line 1325  contains Line 1298  contains
1298         ENDDO         ENDDO
1299    
1300         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1301              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1302              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1303    
1304         ! ajout des tendances         ! ajout des tendances
1305         DO k = 1, llm         DO k = 1, llm
# Line 1475  contains Line 1448  contains
1448      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1449      IF (lafin) THEN      IF (lafin) THEN
1450         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1451         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &
1452              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              fqsurf, qsol, fsnow, falbe, fevap, rain_fall, snow_fall, &
1453              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
1454              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
1455              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)              run_off_lic_0, sig1, w01)
1456      ENDIF      ENDIF
1457    
1458      firstcal = .FALSE.      firstcal = .FALSE.
# Line 1494  contains Line 1467  contains
1467        USE histsync_m, ONLY: histsync        USE histsync_m, ONLY: histsync
1468        USE histwrite_m, ONLY: histwrite        USE histwrite_m, ONLY: histwrite
1469    
1470        real zout        integer i, itau_w ! pas de temps ecriture
       integer itau_w ! pas de temps ecriture  
1471        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1472    
1473        !--------------------------------------------------        !--------------------------------------------------
# Line 1503  contains Line 1475  contains
1475        IF (ok_instan) THEN        IF (ok_instan) THEN
1476           ! Champs 2D:           ! Champs 2D:
1477    
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1478           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1479    
          i = NINT(zout/zsto)  
1480           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
1481           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1482    
          i = NINT(zout/zsto)  
1483           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
1484           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1485    
# Line 1643  contains Line 1611  contains
1611              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1612                   zx_tmp_2d)                   zx_tmp_2d)
1613    
1614              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(:, nsrf)
1615              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1616              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1617                   zx_tmp_2d)                   zx_tmp_2d)
# Line 1651  contains Line 1619  contains
1619           END DO           END DO
1620           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1621           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)  
1622    
1623           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1624           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
Legend:
Removed from v.134  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21