/[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 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, 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, 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 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 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 81  contains Line 84  contains
84    
85      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
86    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
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 182  contains Line 184  contains
184      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
185      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
186    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
187      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
188      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
189      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
190    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
191      !IM Amip2      !IM Amip2
192      ! variables a une pression donnee      ! variables a une pression donnee
193    
# Line 208  contains Line 202  contains
202           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
203           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
204    
     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)  
   
205      ! prw: precipitable water      ! prw: precipitable water
206      real prw(klon)      real prw(klon)
207    
# Line 244  contains Line 210  contains
210      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
211      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
212    
213      INTEGER l, kmax, lmax      INTEGER kmax, lmax
214      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
215      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
216      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 296  contains Line 262  contains
262      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
263      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
264    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
265      ! Variables propres a la physique      ! Variables propres a la physique
266    
267      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 446  contains Line 409  contains
409      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
410      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
411      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
     EXTERNAL ozonecm   ! prescrire l'ozone  
412      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
413      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
414    
# Line 627  contains Line 589  contains
589      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
590    
591      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  
   
592      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)
593    
594      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 656  contains Line 616  contains
616      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
617      SAVE      ip_ebil      SAVE      ip_ebil
618      DATA      ip_ebil/0/      DATA      ip_ebil/0/
619      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
620      !+jld ec_conser      !+jld ec_conser
621      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
622      REAL ZRCPD      REAL ZRCPD
# Line 743  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 876  contains Line 835  contains
835    
836         !   Initialisation des sorties         !   Initialisation des sorties
837    
838         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
839         call ini_histday(pdtphys, presnivs, ok_journe, nid_day, nq)         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)
840         call ini_histins(pdtphys, presnivs, 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
843         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 896  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 919  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 992  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      IF (MOD(itap - 1, lmt_pas) == 0) THEN         wo = ozonecm(REAL(julien), paprs)
        CALL ozonecm(REAL(julien), rlat, paprs, wo)  
958      ENDIF      ENDIF
959    
960      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1284  contains Line 1242  contains
1242         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1243    
1244         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1245            CALL concvl (iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
1246                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1247                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1248                 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 1801  contains
1801              , 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)
1802      END IF      END IF
1803    
1804      !AA Installation de l'interface online-offline pour traceurs      ! Calcul  des tendances traceurs
1805        call phytrac(rnpb, itap, lmt_pas, julien, gmtime, firstcal, lafin, &
1806      !   Calcul  des tendances traceurs           nqmx-2, pdtphys, u, t, paprs, pplay, pmfu, pmfd, pen_u, pde_u, &
1807             pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1808      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &           frac_impa, frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &
1809           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1810           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           tr_seri, zmasse)
          frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &  
          rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &  
          psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)  
1811    
1812      IF (offline) THEN      IF (offline) THEN
1813           call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1814         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1815         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)  
   
1816      ENDIF      ENDIF
1817    
1818      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1819        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1820             ue, uq)
1821    
1822      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1823    
1824      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay (paprs, zxtsol, &
1825           t_seri, q_seri, u_seri, v_seri, zphi, &           t_seri, q_seri, u_seri, v_seri, zphi, &
# Line 1932  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 1967  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.17  
changed lines
  Added in v.35
  ViewVC Help
Powered by ViewVC 1.1.21