/[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 15 by guez, Fri Aug 1 15:24:12 2008 UTC revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC
# Line 10  module physiq_m Line 10  module physiq_m
10  contains  contains
11    
12    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(nq, 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 calendar, only: ymds2ju
27        USE histwrite_m, only: histwrite
28        USE histcom, only: histsync
29      use dimens_m, only: jjm, iim, llm      use dimens_m, only: jjm, iim, llm
30      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
31           clnsurf, epsfra           clnsurf, epsfra
32      use dimphy, only: klon, nbtr      use dimphy, only: klon, nbtr
33      use conf_gcm_m, only: raz_date, offline, iphysiq      use conf_gcm_m, only: raz_date, offline
34      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
35      use temps, only: itau_phy, day_ref, annee_ref, itaufin      use temps, only: itau_phy, day_ref, annee_ref
36      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
37           cdmmax, cdhmax, &           cdmmax, cdhmax, &
38           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
# Line 53  contains Line 55  contains
55      use hgardfou_m, only: hgardfou      use hgardfou_m, only: hgardfou
56      use conf_phys_m, only: conf_phys      use conf_phys_m, only: conf_phys
57      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
58        use qcheck_m, only: qcheck
59        use ozonecm_m, only: ozonecm
60    
61      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
62      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
63    
64      ! Variables argument:      ! Variables argument:
65    
66      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)
67    
68      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
69      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
# Line 80  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 v(klon, llm)  ! input vitesse Y (de S a N) en m/s
89      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
# Line 133  contains Line 134  contains
134      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
135    
136      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
137      logical ok_veget      logical, save:: ok_veget
138      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
139    
140      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
141    
# Line 183  contains Line 182  contains
182      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
183      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
184    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
185      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
186      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
187      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
188    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
189      !IM Amip2      !IM Amip2
190      ! variables a une pression donnee      ! variables a une pression donnee
191    
# Line 209  contains Line 200  contains
200           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
201           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
202    
     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  
   
203      ! prw: precipitable water      ! prw: precipitable water
204      real prw(klon)      real prw(klon)
205    
# Line 268  contains Line 208  contains
208      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
209      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
210    
211      INTEGER l, kmax, lmax      INTEGER kmax, lmax
212      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
213      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
214      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 320  contains Line 260  contains
260      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
261      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
262    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
263      ! Variables propres a la physique      ! Variables propres a la physique
264    
265      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 459  contains Line 396  contains
396      REAL albsollw(klon)      REAL albsollw(klon)
397      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
398    
399      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
400    
401      ! Declaration des procedures appelees      ! Declaration des procedures appelees
402    
# Line 470  contains Line 407  contains
407      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
408      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
409      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
     EXTERNAL ozonecm   ! prescrire l'ozone  
410      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
411      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
412    
     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)  
   
413      ! Variables locales      ! Variables locales
414    
415      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 626  contains Line 557  contains
557      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
558    
559      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
560      real fact_cldcon      real, save:: fact_cldcon
561      real facttemps      real, save:: facttemps
562      logical ok_newmicro      logical ok_newmicro
563      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
564      real facteur      real facteur
565    
566      integer iflag_cldcon      integer iflag_cldcon
# Line 638  contains Line 568  contains
568    
569      logical ptconv(klon, llm)      logical ptconv(klon, llm)
570    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
571      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
572    
573      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 652  contains Line 578  contains
578      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
579    
580      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
581    
582      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
583      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
# Line 662  contains Line 587  contains
587      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
588    
589      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  
   
590      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)
591    
592      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 691  contains Line 614  contains
614      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
615      SAVE      ip_ebil      SAVE      ip_ebil
616      DATA      ip_ebil/0/      DATA      ip_ebil/0/
617      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
618      !+jld ec_conser      !+jld ec_conser
619      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
620      REAL ZRCPD      REAL ZRCPD
# Line 764  contains Line 686  contains
686      SAVE trmb2      SAVE trmb2
687      SAVE trmb3      SAVE trmb3
688    
689        real zmasse(klon, llm)
690        ! (column-density of mass of air in a cell, in kg m-2)
691    
692        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
693    
694      !----------------------------------------------------------------      !----------------------------------------------------------------
695    
696      modname = 'physiq'      modname = 'physiq'
# Line 906  contains Line 833  contains
833    
834         !   Initialisation des sorties         !   Initialisation des sorties
835    
836         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
837         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, ok_journe, nid_day, nq)
838         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
839         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
840         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
841         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 1017  contains Line 944  contains
944      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
945      if (julien == 0) julien = 360      if (julien == 0) julien = 360
946    
947        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
948    
949      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
950      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
951    
952      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nq >= 5) then
953         CALL ozonecm(REAL(julien), rlat, paprs, wo)         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
954        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
955           wo = ozonecm(REAL(julien), paprs)
956      ENDIF      ENDIF
957    
958      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1281  contains Line 1212  contains
1212         DO k = 1, llm         DO k = 1, llm
1213            DO i = 1, klon            DO i = 1, klon
1214               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)) &
1215                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1216            ENDDO            ENDDO
1217         ENDDO         ENDDO
1218      ENDIF      ENDIF
# Line 1309  contains Line 1240  contains
1240         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1241    
1242         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1243            CALL concvl (iflag_con, &            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
                pdtphys, paprs, pplay, t_seri, q_seri, &  
1244                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1245                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1246                 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 1255  contains
1255            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1256         ELSE ! ok_cvl         ELSE ! ok_cvl
1257            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1258            CALL conema3 (pdtphys, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1259                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1260                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1261                 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 1345  contains
1345         DO k = 1, llm         DO k = 1, llm
1346            DO i = 1, klon            DO i = 1, klon
1347               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)) &
1348                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1349            ENDDO            ENDDO
1350         ENDDO         ENDDO
1351         DO i = 1, klon         DO i = 1, klon
# Line 1573  contains Line 1502  contains
1502               do i=1, klon               do i=1, klon
1503                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1504                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1505                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1506                  endif                  endif
1507               enddo               enddo
1508            enddo            enddo
# Line 1848  contains Line 1777  contains
1777      ENDDO      ENDDO
1778      DO k = 1, llm      DO k = 1, llm
1779         DO i = 1, klon         DO i = 1, klon
1780            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)
1781                 (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  
1782         ENDDO         ENDDO
1783      ENDDO      ENDDO
1784    
1785      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1786    
1787      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1788           ra, rg, romega, &           ra, rg, romega, &
1789           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1790           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1872  contains Line 1799  contains
1799              , 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)
1800      END IF      END IF
1801    
1802      !AA Installation de l'interface online-offline pour traceurs      ! Calcul  des tendances traceurs
   
     !   Calcul  des tendances traceurs  
   
1803      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1804           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, &
1805           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1806           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &
1807           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1808           psfl, da, phi, mp, upwd, dnwd, tr_seri)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1809    
1810      IF (offline) THEN      IF (offline) THEN
1811           call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1812         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1813         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)  
   
1814      ENDIF      ENDIF
1815    
1816      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1817        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1818             ue, uq)
1819    
1820      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1821    
1822      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay (paprs, zxtsol, &
1823           t_seri, q_seri, u_seri, v_seri, zphi, &           t_seri, q_seri, u_seri, v_seri, zphi, &
# Line 1945  contains Line 1861  contains
1861      DO i = 1, klon      DO i = 1, klon
1862         prw(i) = 0.         prw(i) = 0.
1863         DO k = 1, llm         DO k = 1, llm
1864            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  
1865         ENDDO         ENDDO
1866      ENDDO      ENDDO
1867    
# Line 1973  contains Line 1888  contains
1888      ENDIF      ENDIF
1889    
1890      ! 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:
   
1891      DO k = 1, llm      DO k = 1, llm
1892         DO i = 1, klon         DO i = 1, klon
1893            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1982  contains Line 1896  contains
1896      ENDDO      ENDDO
1897    
1898      !   Ecriture des sorties      !   Ecriture des sorties
   
1899      call write_histhf      call write_histhf
1900      call write_histday      call write_histday
1901      call write_histins      call write_histins
1902    
1903      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1904      IF (lafin) THEN      IF (lafin) THEN
1905         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1906         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
# Line 2005  contains Line 1917  contains
1917      subroutine write_histday      subroutine write_histday
1918    
1919        use grid_change, only: gr_phy_write_3d        use grid_change, only: gr_phy_write_3d
1920          integer itau_w  ! pas de temps ecriture
1921    
1922        !------------------------------------------------        !------------------------------------------------
1923    
1924        if (ok_journe) THEN        if (ok_journe) THEN
          ndex2d = 0  
          ndex3d = 0  
1925           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1926           call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))           if (nq <= 4) then
1927                call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1928                     gr_phy_write_3d(wo) * 1e3)
1929                ! (convert "wo" from kDU to DU)
1930             end if
1931           if (ok_sync) then           if (ok_sync) then
1932              call histsync(nid_day)              call histsync(nid_day)
1933           endif           endif
# Line 2027  contains Line 1941  contains
1941    
1942        ! 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
1943    
1944        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1945    
1946        call write_histhf3d        call write_histhf3d
1947    
# Line 2047  contains Line 1958  contains
1958        ! 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
1959    
1960        real zout        real zout
1961          integer itau_w  ! pas de temps ecriture
1962    
1963        !--------------------------------------------------        !--------------------------------------------------
1964    
1965        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1966           ! Champs 2D:           ! Champs 2D:
1967    
1968           zsto = pdtphys * ecrit_ins           zsto = pdtphys * ecrit_ins
# Line 2283  contains Line 2191  contains
2191    
2192        ! 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
2193    
2194        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2195        ndex3d = 0  
2196          !-------------------------------------------------------
2197    
2198        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2199    
# Line 2316  contains Line 2225  contains
2225    
2226    END SUBROUTINE physiq    END SUBROUTINE physiq
2227    
   !****************************************************  
   
   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  
   
2228  end module physiq_m  end module physiq_m
Legend:
Removed from v.15  
changed lines
  Added in v.31
  ViewVC Help
Powered by ViewVC 1.1.21