/[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 33 by guez, Tue Apr 6 17:52:58 2010 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 35  contains Line 35  contains
35      use conf_gcm_m, only: raz_date, offline      use conf_gcm_m, only: raz_date, offline
36      use conf_phys_m, only: conf_phys      use conf_phys_m, only: conf_phys
37      use ctherm      use ctherm
38      use dimens_m, only: jjm, iim, llm      use dimens_m, only: jjm, iim, llm, nqmx
39      use dimphy, only: klon, nbtr      use dimphy, only: klon, nbtr
40      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
41      use hgardfou_m, only: hgardfou      use hgardfou_m, only: hgardfou
# Line 43  contains Line 43  contains
43      USE histwrite_m, only: histwrite      USE histwrite_m, only: histwrite
44      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
45           clnsurf, epsfra           clnsurf, epsfra
46      use ini_hist, only: ini_histhf, ini_histday, ini_histins      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      use iniprint, only: prt_level
50      use oasis_m      use oasis_m
51      use orbite_m, only: orbite, zenang      use orbite_m, only: orbite, zenang
# Line 64  contains Line 66  contains
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 89  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 701  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 835  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 854  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 877  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 950  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 1801  contains Line 1801  contains
1801      END IF      END IF
1802    
1803      ! 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, nqmx-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, &         call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
# Line 1878  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 1924  contains Line 1924  contains
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.33  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.21