/[lmdze]/trunk/libf/phylmd/physiq.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/physiq.f90

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

revision 17 by guez, Tue Aug 5 13:31:32 2008 UTC revision 32 by guez, Tue Apr 6 17:52:58 2010 UTC
# Line 10  module physiq_m Line 10  module physiq_m
10  contains  contains
11    
12    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &
13         pplay, pphi, pphis, presnivs, u, v, t, qx, omega, d_u, d_v, &         pplay, pphi, pphis, u, v, t, qx, omega, d_u, d_v, &
14         d_t, d_qx, d_ps, dudyn, PVteta)         d_t, d_qx, d_ps, dudyn, PVteta)
15    
16      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28
# Line 23  contains Line 23  contains
23      !AA                  -  stockage des moyennes des champs necessaires      !AA                  -  stockage des moyennes des champs necessaires
24      !AA                     en mode traceur off-line      !AA                     en mode traceur off-line
25    
26      USE ioipsl, only: ymds2ju, histwrite, histsync      use abort_gcm_m, only: abort_gcm
27      use dimens_m, only: jjm, iim, llm      USE calendar, only: ymds2ju
     use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &  
          clnsurf, epsfra  
     use dimphy, only: klon, nbtr  
     use conf_gcm_m, only: raz_date, offline, iphysiq  
     use dimsoil, only: nsoilmx  
     use temps, only: itau_phy, day_ref, annee_ref, itaufin  
28      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
29           cdmmax, cdhmax, &           cdmmax, cdhmax, &
30           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
31           ok_kzmin           ok_kzmin
32      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
33           cycle_diurne, new_oliq, soil_model           cycle_diurne, new_oliq, soil_model
     use iniprint, only: prt_level  
     use abort_gcm_m, only: abort_gcm  
     use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega  
34      use comgeomphy      use comgeomphy
35        use conf_gcm_m, only: raz_date, offline
36        use conf_phys_m, only: conf_phys
37      use ctherm      use ctherm
38      use phytrac_m, only: phytrac      use dimens_m, only: jjm, iim, llm
39      use oasis_m      use dimphy, only: klon, nbtr
40      use radepsi      use dimsoil, only: nsoilmx
41      use radopt      use hgardfou_m, only: hgardfou
42      use yoethf      USE histcom, only: histsync
43        USE histwrite_m, only: histwrite
44        use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
45             clnsurf, epsfra
46      use ini_hist, only: ini_histhf, ini_histday, ini_histins      use ini_hist, only: ini_histhf, ini_histday, ini_histins
47        use iniprint, only: prt_level
48        use oasis_m
49      use orbite_m, only: orbite, zenang      use orbite_m, only: orbite, zenang
50        use ozonecm_m, only: ozonecm
51      use phyetat0_m, only: phyetat0, rlat, rlon      use phyetat0_m, only: phyetat0, rlat, rlon
     use hgardfou_m, only: hgardfou  
     use conf_phys_m, only: conf_phys  
52      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
53        use phystokenc_m, only: phystokenc
54        use phytrac_m, only: phytrac
55      use qcheck_m, only: qcheck      use qcheck_m, only: qcheck
56        use radepsi
57        use radopt
58        use temps, only: itau_phy, day_ref, annee_ref
59        use yoethf
60        use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
61    
62      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
63      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
# Line 81  contains Line 85  contains
85    
86      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
87    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
88      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s
89      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s
90      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
# Line 182  contains Line 183  contains
183      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
184      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
185    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
186      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
187      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
188      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
189    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
190      !IM Amip2      !IM Amip2
191      ! variables a une pression donnee      ! variables a une pression donnee
192    
# Line 208  contains Line 201  contains
201           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
202           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
203    
     real tlevSTD(klon, nlevSTD), qlevSTD(klon, nlevSTD)  
     real rhlevSTD(klon, nlevSTD), philevSTD(klon, nlevSTD)  
     real ulevSTD(klon, nlevSTD), vlevSTD(klon, nlevSTD)  
     real wlevSTD(klon, nlevSTD)  
   
     ! nout : niveau de output des variables a une pression donnee  
     INTEGER nout  
     PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC  
   
     logical oknondef(klon, nlevSTD, nout)  
     real tnondef(klon, nlevSTD, nout)  
     save tnondef  
   
     ! les produits uvSTD, vqSTD, .., T2STD sont calcules  
     ! a partir des valeurs instantannees toutes les 6 h  
     ! qui sont moyennees sur le mois  
   
     real uvSTD(klon, nlevSTD)  
     real vqSTD(klon, nlevSTD)  
     real vTSTD(klon, nlevSTD)  
     real wqSTD(klon, nlevSTD)  
   
     real vphiSTD(klon, nlevSTD)  
     real wTSTD(klon, nlevSTD)  
     real u2STD(klon, nlevSTD)  
     real v2STD(klon, nlevSTD)  
     real T2STD(klon, nlevSTD)  
   
204      ! prw: precipitable water      ! prw: precipitable water
205      real prw(klon)      real prw(klon)
206    
# Line 244  contains Line 209  contains
209      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
210      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
211    
212      INTEGER l, kmax, lmax      INTEGER kmax, lmax
213      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
214      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
215      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 296  contains Line 261  contains
261      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
262      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
263    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
264      ! Variables propres a la physique      ! Variables propres a la physique
265    
266      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 446  contains Line 408  contains
408      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
409      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
410      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
     EXTERNAL ozonecm   ! prescrire l'ozone  
411      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
412      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
413    
# Line 627  contains Line 588  contains
588      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
589    
590      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
     REAL zx_tmp_fi3d(klon, llm) ! variable temporaire pour champs 3D  
   
591      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)
592    
593      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 656  contains Line 615  contains
615      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
616      SAVE      ip_ebil      SAVE      ip_ebil
617      DATA      ip_ebil/0/      DATA      ip_ebil/0/
618      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
619      !+jld ec_conser      !+jld ec_conser
620      REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique      REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique
621      REAL ZRCPD      REAL ZRCPD
# Line 876  contains Line 834  contains
834    
835         !   Initialisation des sorties         !   Initialisation des sorties
836    
837         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
838         call ini_histday(pdtphys, presnivs, ok_journe, nid_day, nq)         call ini_histday(pdtphys, ok_journe, nid_day, nq)
839         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
840         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
841         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
842         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 992  contains Line 950  contains
950      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
951      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
952    
953  !!$    if (nq >= 5) then      if (nq >= 5) then
954  !!$       wo = qx(:, :, 5) * zmasse / dobson_u / 1e3         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
955  !!$    else IF (MOD(itap - 1, lmt_pas) == 0) THEN      else IF (MOD(itap - 1, lmt_pas) == 0) THEN
956      IF (MOD(itap - 1, lmt_pas) == 0) THEN         wo = ozonecm(REAL(julien), paprs)
        CALL ozonecm(REAL(julien), rlat, paprs, wo)  
957      ENDIF      ENDIF
958    
959      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1284  contains Line 1241  contains
1241         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1242    
1243         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1244            CALL concvl (iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
1245                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1246                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1247                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1843  contains Line 1800  contains
1800              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1801      END IF      END IF
1802    
1803      !AA Installation de l'interface online-offline pour traceurs      ! Calcul  des tendances traceurs
   
     !   Calcul  des tendances traceurs  
   
1804      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1805           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &
1806           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1807           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &
1808           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1809           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1810    
1811      IF (offline) THEN      IF (offline) THEN
1812           call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1813         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1814         call phystokenc(pdtphys, rlon, rlat, &              pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)
             t, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             fm_therm, entr_therm, &  
             ycoefh, yu1, yv1, ftsol, pctsrf, &  
             frac_impa, frac_nucl, &  
             pphis, airephy, pdtphys, itap)  
   
1815      ENDIF      ENDIF
1816    
1817      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1818        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1819             ue, uq)
1820    
1821      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1822    
1823      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay (paprs, zxtsol, &
1824           t_seri, q_seri, u_seri, v_seri, zphi, &           t_seri, q_seri, u_seri, v_seri, zphi, &
# Line 1971  contains Line 1917  contains
1917    
1918      subroutine write_histday      subroutine write_histday
1919    
1920        use grid_change, only: gr_phy_write_3d        use gr_phy_write_3d_m, only: gr_phy_write_3d
1921        integer itau_w  ! pas de temps ecriture        integer itau_w  ! pas de temps ecriture
1922    
1923        !------------------------------------------------        !------------------------------------------------
Legend:
Removed from v.17  
changed lines
  Added in v.32
  ViewVC Help
Powered by ViewVC 1.1.21