/[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 22 by guez, Fri Jul 31 15:18:47 2009 UTC revision 34 by guez, Wed Jun 2 11:01:12 2010 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &
13         pplay, pphi, pphis, 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    
# 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, nqmx
39        use dimphy, only: klon, nbtr
40        use dimsoil, only: nsoilmx
41        use hgardfou_m, only: hgardfou
42        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_histhf_m, only: ini_histhf
47        use ini_histday_m, only: ini_histday
48        use ini_histins_m, only: ini_histins
49        use iniprint, only: prt_level
50      use oasis_m      use oasis_m
     use radepsi  
     use radopt  
     use yoethf  
     use ini_hist, only: ini_histhf, ini_histday, ini_histins  
51      use orbite_m, only: orbite, zenang      use orbite_m, only: orbite, zenang
52        use ozonecm_m, only: ozonecm
53      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  
54      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
55        use phystokenc_m, only: phystokenc
56        use phytrac_m, only: phytrac
57      use qcheck_m, only: qcheck      use qcheck_m, only: qcheck
58      use ozonecm_m, only: ozonecm      use radepsi
59        use radopt
60        use temps, only: itau_phy, day_ref, annee_ref
61        use yoethf
62        use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
63    
64      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
65      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
66    
67      ! Variables argument:      ! Variables argument:
68    
     INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)  
   
69      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
70      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
71    
# Line 86  contains Line 89  contains
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)
91    
92      REAL, intent(in):: qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nqmx)
93      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
94    
95      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
96      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)
97      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)
98      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)
99      REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)      REAL d_qx(klon, llm, nqmx)  ! output tendance physique de "qx" (kg/kg/s)
100      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL d_ps(klon)  ! output tendance physique de la pression au sol
101    
102      INTEGER nbteta      INTEGER nbteta
# Line 180  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 206  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 242  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 294  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 624  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 739  contains Line 701  contains
701         END DO         END DO
702      END IF      END IF
703      ok_sync=.TRUE.      ok_sync=.TRUE.
704      IF (nq  <  2) THEN      IF (nqmx  <  2) THEN
705         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
706         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
707      ENDIF      ENDIF
# Line 873  contains Line 835  contains
835         !   Initialisation des sorties         !   Initialisation des sorties
836    
837         call ini_histhf(pdtphys, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
838         call ini_histday(pdtphys, ok_journe, nid_day, nq)         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)
839         call ini_histins(pdtphys, 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
# Line 892  contains Line 854  contains
854            d_v(i, k) = 0.0            d_v(i, k) = 0.0
855         ENDDO         ENDDO
856      ENDDO      ENDDO
857      DO iq = 1, nq      DO iq = 1, nqmx
858         DO k = 1, llm         DO k = 1, llm
859            DO i = 1, klon            DO i = 1, klon
860               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
# Line 915  contains Line 877  contains
877            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
878         ENDDO         ENDDO
879      ENDDO      ENDDO
880      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
881         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
882      ELSE      ELSE
883         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
884      ENDIF      ENDIF
# Line 988  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 (nqmx >= 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         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
# Line 1838  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
1804        call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nqmx-2, &
     !   Calcul  des tendances traceurs  
   
     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, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &
1808           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1809           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           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 1927  contains Line 1878  contains
1878         ENDDO         ENDDO
1879      ENDDO      ENDDO
1880    
1881      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1882         DO iq = 3, nq         DO iq = 3, nqmx
1883            DO  k = 1, llm            DO  k = 1, llm
1884               DO  i = 1, klon               DO  i = 1, klon
1885                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys
# Line 1966  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        !------------------------------------------------        !------------------------------------------------
1924    
1925        if (ok_journe) THEN        if (ok_journe) THEN
1926           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1927           if (nq <= 4) then           if (nqmx <= 4) then
1928              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1929                   gr_phy_write_3d(wo) * 1e3)                   gr_phy_write_3d(wo) * 1e3)
1930              ! (convert "wo" from kDU to DU)              ! (convert "wo" from kDU to DU)
Legend:
Removed from v.22  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.21