/[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 15 by guez, Fri Aug 1 15:24:12 2008 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, 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, 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
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 nq ! input 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 80  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)
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 133  contains Line 135  contains
135      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
136    
137      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
138      logical ok_veget      logical, save:: ok_veget
139      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
140    
141      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
142    
# Line 183  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 209  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  
   
     REAL tsumSTD(klon, nlevSTD, nout)  
     REAL usumSTD(klon, nlevSTD, nout), vsumSTD(klon, nlevSTD, nout)  
     REAL wsumSTD(klon, nlevSTD, nout), phisumSTD(klon, nlevSTD, nout)  
     REAL qsumSTD(klon, nlevSTD, nout), rhsumSTD(klon, nlevSTD, nout)  
   
     SAVE tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD,  &  
          qsumSTD, rhsumSTD  
   
     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 uvsumSTD(klon, nlevSTD, nout)  
     real vqsumSTD(klon, nlevSTD, nout)  
     real vTsumSTD(klon, nlevSTD, nout)  
     real wqsumSTD(klon, nlevSTD, nout)  
   
     real vphiSTD(klon, nlevSTD)  
     real wTSTD(klon, nlevSTD)  
     real u2STD(klon, nlevSTD)  
     real v2STD(klon, nlevSTD)  
     real T2STD(klon, nlevSTD)  
   
     real vphisumSTD(klon, nlevSTD, nout)  
     real wTsumSTD(klon, nlevSTD, nout)  
     real u2sumSTD(klon, nlevSTD, nout)  
     real v2sumSTD(klon, nlevSTD, nout)  
     real T2sumSTD(klon, nlevSTD, nout)  
   
     SAVE uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD  
     SAVE vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD  
     !MI Amip2  
   
204      ! prw: precipitable water      ! prw: precipitable water
205      real prw(klon)      real prw(klon)
206    
# Line 268  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 320  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 459  contains Line 397  contains
397      REAL albsollw(klon)      REAL albsollw(klon)
398      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
399    
400      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
401    
402      ! Declaration des procedures appelees      ! Declaration des procedures appelees
403    
# Line 470  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    
     EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression  
   
     EXTERNAL undefSTD  
     ! (somme les valeurs definies d'1 var a 1 niveau de pression)  
   
414      ! Variables locales      ! Variables locales
415    
416      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 626  contains Line 558  contains
558      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
559    
560      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
561      real fact_cldcon      real, save:: fact_cldcon
562      real facttemps      real, save:: facttemps
563      logical ok_newmicro      logical ok_newmicro
564      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
565      real facteur      real facteur
566    
567      integer iflag_cldcon      integer iflag_cldcon
# Line 638  contains Line 569  contains
569    
570      logical ptconv(klon, llm)      logical ptconv(klon, llm)
571    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
572      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
573    
574      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 652  contains Line 579  contains
579      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
580    
581      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
582    
583      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
584      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
# Line 662  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 691  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 764  contains Line 687  contains
687      SAVE trmb2      SAVE trmb2
688      SAVE trmb3      SAVE trmb3
689    
690        real zmasse(klon, llm)
691        ! (column-density of mass of air in a cell, in kg m-2)
692    
693        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
694    
695      !----------------------------------------------------------------      !----------------------------------------------------------------
696    
697      modname = 'physiq'      modname = 'physiq'
# Line 773  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 906  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)         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)
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 926  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 949  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 1017  contains Line 945  contains
945      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
946      if (julien == 0) julien = 360      if (julien == 0) julien = 360
947    
948        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
949    
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 (MOD(itap - 1, lmt_pas) == 0) THEN      if (nqmx >= 5) then
954         CALL ozonecm(REAL(julien), rlat, paprs, wo)         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
955        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
956           wo = ozonecm(REAL(julien), paprs)
957      ENDIF      ENDIF
958    
959      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1281  contains Line 1213  contains
1213         DO k = 1, llm         DO k = 1, llm
1214            DO i = 1, klon            DO i = 1, klon
1215               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &
1216                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1217            ENDDO            ENDDO
1218         ENDDO         ENDDO
1219      ENDIF      ENDIF
# Line 1309  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, &            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
                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 1325  contains Line 1256  contains
1256            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1257         ELSE ! ok_cvl         ELSE ! ok_cvl
1258            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1259            CALL conema3 (pdtphys, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1260                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1261                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1262                 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 1416  contains Line 1346  contains
1346         DO k = 1, llm         DO k = 1, llm
1347            DO i = 1, klon            DO i = 1, klon
1348               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &
1349                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1350            ENDDO            ENDDO
1351         ENDDO         ENDDO
1352         DO i = 1, klon         DO i = 1, klon
# Line 1573  contains Line 1503  contains
1503               do i=1, klon               do i=1, klon
1504                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1505                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1506                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1507                  endif                  endif
1508               enddo               enddo
1509            enddo            enddo
# Line 1848  contains Line 1778  contains
1778      ENDDO      ENDDO
1779      DO k = 1, llm      DO k = 1, llm
1780         DO i = 1, klon         DO i = 1, klon
1781            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* &            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)
1782                 (paprs(i, k)-paprs(i, k+1))/rg            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)
           zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* &  
                (paprs(i, k)-paprs(i, k+1))/rg  
1783         ENDDO         ENDDO
1784      ENDDO      ENDDO
1785    
1786      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1787    
1788      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1789           ra, rg, romega, &           ra, rg, romega, &
1790           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1791           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1872  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, presnivs, 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)           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 1945  contains Line 1862  contains
1862      DO i = 1, klon      DO i = 1, klon
1863         prw(i) = 0.         prw(i) = 0.
1864         DO k = 1, llm         DO k = 1, llm
1865            prw(i) = prw(i) + &            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)
                q_seri(i, k)*(paprs(i, k)-paprs(i, k+1))/RG  
1866         ENDDO         ENDDO
1867      ENDDO      ENDDO
1868    
# Line 1962  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 1973  contains Line 1889  contains
1889      ENDIF      ENDIF
1890    
1891      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
   
1892      DO k = 1, llm      DO k = 1, llm
1893         DO i = 1, klon         DO i = 1, klon
1894            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1982  contains Line 1897  contains
1897      ENDDO      ENDDO
1898    
1899      !   Ecriture des sorties      !   Ecriture des sorties
   
1900      call write_histhf      call write_histhf
1901      call write_histday      call write_histday
1902      call write_histins      call write_histins
1903    
1904      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1905      IF (lafin) THEN      IF (lafin) THEN
1906         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1907         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
# Line 2004  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
1922    
1923        !------------------------------------------------        !------------------------------------------------
1924    
1925        if (ok_journe) THEN        if (ok_journe) THEN
          ndex2d = 0  
          ndex3d = 0  
1926           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1927           call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))           if (nqmx <= 4) then
1928                call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1929                     gr_phy_write_3d(wo) * 1e3)
1930                ! (convert "wo" from kDU to DU)
1931             end if
1932           if (ok_sync) then           if (ok_sync) then
1933              call histsync(nid_day)              call histsync(nid_day)
1934           endif           endif
# Line 2027  contains Line 1942  contains
1942    
1943        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09
1944    
1945        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1946    
1947        call write_histhf3d        call write_histhf3d
1948    
# Line 2047  contains Line 1959  contains
1959        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09
1960    
1961        real zout        real zout
1962          integer itau_w  ! pas de temps ecriture
1963    
1964        !--------------------------------------------------        !--------------------------------------------------
1965    
1966        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1967           ! Champs 2D:           ! Champs 2D:
1968    
1969           zsto = pdtphys * ecrit_ins           zsto = pdtphys * ecrit_ins
# Line 2283  contains Line 2192  contains
2192    
2193        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09
2194    
2195        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2196        ndex3d = 0  
2197          !-------------------------------------------------------
2198    
2199        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2200    
# Line 2316  contains Line 2226  contains
2226    
2227    END SUBROUTINE physiq    END SUBROUTINE physiq
2228    
   !****************************************************  
   
   FUNCTION qcheck(klon, klev, paprs, q, ql, aire)  
   
     ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28  
   
     use YOMCST  
     IMPLICIT none  
   
     ! Calculer et imprimer l'eau totale. A utiliser pour verifier  
     ! la conservation de l'eau  
   
     INTEGER klon, klev  
     REAL, intent(in):: paprs(klon, klev+1)  
     real q(klon, klev), ql(klon, klev)  
     REAL aire(klon)  
     REAL qtotal, zx, qcheck  
     INTEGER i, k  
   
     zx = 0.0  
     DO i = 1, klon  
        zx = zx + aire(i)  
     ENDDO  
     qtotal = 0.0  
     DO k = 1, klev  
        DO i = 1, klon  
           qtotal = qtotal + (q(i, k)+ql(i, k)) * aire(i) &  
                *(paprs(i, k)-paprs(i, k+1))/RG  
        ENDDO  
     ENDDO  
   
     qcheck = qtotal/zx  
   
   END FUNCTION qcheck  
   
2229  end module physiq_m  end module physiq_m
Legend:
Removed from v.15  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.21