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

Diff of /trunk/phylmd/physiq.f

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

revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC revision 35 by guez, Tue Jun 8 15:37:21 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(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    
16      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
17    
18      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18
19    
# 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 abort_gcm_m, only: abort_gcm
27      USE calendar, only: ymds2ju      USE calendar, only: ymds2ju
     USE histwrite_m, only: histwrite  
     USE histcom, only: histsync  
     use dimens_m, only: jjm, iim, llm  
     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  
     use dimsoil, only: nsoilmx  
     use temps, only: itau_phy, day_ref, annee_ref  
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    
72      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour
73      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
74      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
75    
76      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
# Line 85  contains Line 85  contains
85      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
86    
87      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
88      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL, intent(in):: v(klon, llm)  ! vitesse Y (de S a N) en m/s
89      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
90    
91      REAL, intent(in):: qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nqmx)
92      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
93    
94      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
95      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)
96      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)
97      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)
98      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)
99      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL d_ps(klon)  ! output tendance physique de la pression au sol
100    
101        LOGICAL:: firstcal = .true.
102    
103      INTEGER nbteta      INTEGER nbteta
104      PARAMETER(nbteta=3)      PARAMETER(nbteta=3)
105    
# Line 700  contains Line 702  contains
702         END DO         END DO
703      END IF      END IF
704      ok_sync=.TRUE.      ok_sync=.TRUE.
705      IF (nq  <  2) THEN      IF (nqmx  <  2) THEN
706         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
707         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
708      ENDIF      ENDIF
# Line 834  contains Line 836  contains
836         !   Initialisation des sorties         !   Initialisation des sorties
837    
838         call ini_histhf(pdtphys, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
839         call ini_histday(pdtphys, ok_journe, nid_day, nq)         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)
840         call ini_histins(pdtphys, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
841         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
842         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
# Line 853  contains Line 855  contains
855            d_v(i, k) = 0.0            d_v(i, k) = 0.0
856         ENDDO         ENDDO
857      ENDDO      ENDDO
858      DO iq = 1, nq      DO iq = 1, nqmx
859         DO k = 1, llm         DO k = 1, llm
860            DO i = 1, klon            DO i = 1, klon
861               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
# Line 876  contains Line 878  contains
878            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
879         ENDDO         ENDDO
880      ENDDO      ENDDO
881      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
882         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
883      ELSE      ELSE
884         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
885      ENDIF      ENDIF
# Line 949  contains Line 951  contains
951      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
952      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
953    
954      if (nq >= 5) then      if (nqmx >= 5) then
955         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
956      else IF (MOD(itap - 1, lmt_pas) == 0) THEN      else IF (MOD(itap - 1, lmt_pas) == 0) THEN
957         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
# Line 1800  contains Line 1802  contains
1802      END IF      END IF
1803    
1804      ! Calcul  des tendances traceurs      ! Calcul  des tendances traceurs
1805      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien, gmtime, firstcal, lafin, &
1806           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &           nqmx-2, pdtphys, u, t, paprs, pplay, pmfu, pmfd, pen_u, pde_u, &
1807           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1808           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa, frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &
1809           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1810           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           tr_seri, zmasse)
1811    
1812      IF (offline) THEN      IF (offline) THEN
1813         call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
# Line 1877  contains Line 1879  contains
1879         ENDDO         ENDDO
1880      ENDDO      ENDDO
1881    
1882      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1883         DO iq = 3, nq         DO iq = 3, nqmx
1884            DO  k = 1, llm            DO  k = 1, llm
1885               DO  i = 1, klon               DO  i = 1, klon
1886                  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 1912  contains Line 1914  contains
1914              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
1915      ENDIF      ENDIF
1916    
1917        firstcal = .FALSE.
1918    
1919    contains    contains
1920    
1921      subroutine write_histday      subroutine write_histday
1922    
1923        use grid_change, only: gr_phy_write_3d        use gr_phy_write_3d_m, only: gr_phy_write_3d
1924        integer itau_w  ! pas de temps ecriture        integer itau_w  ! pas de temps ecriture
1925    
1926        !------------------------------------------------        !------------------------------------------------
1927    
1928        if (ok_journe) THEN        if (ok_journe) THEN
1929           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1930           if (nq <= 4) then           if (nqmx <= 4) then
1931              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1932                   gr_phy_write_3d(wo) * 1e3)                   gr_phy_write_3d(wo) * 1e3)
1933              ! (convert "wo" from kDU to DU)              ! (convert "wo" from kDU to DU)
Legend:
Removed from v.31  
changed lines
  Added in v.35
  ViewVC Help
Powered by ViewVC 1.1.21