/[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 16 by guez, Fri Aug 1 15:37:00 2008 UTC revision 23 by guez, Mon Dec 14 15:25:16 2009 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 28  contains Line 28  contains
28      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
29           clnsurf, epsfra           clnsurf, epsfra
30      use dimphy, only: klon, nbtr      use dimphy, only: klon, nbtr
31      use conf_gcm_m, only: raz_date, offline, iphysiq      use conf_gcm_m, only: raz_date, offline
32      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
33      use temps, only: itau_phy, day_ref, annee_ref, itaufin      use temps, only: itau_phy, day_ref, annee_ref
34      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
35           cdmmax, cdhmax, &           cdmmax, cdhmax, &
36           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
# Line 53  contains Line 53  contains
53      use hgardfou_m, only: hgardfou      use hgardfou_m, only: hgardfou
54      use conf_phys_m, only: conf_phys      use conf_phys_m, only: conf_phys
55      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
56        use qcheck_m, only: qcheck
57        use ozonecm_m, only: ozonecm
58    
59      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
60      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
61    
62      ! Variables argument:      ! Variables argument:
63    
64      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)
65    
66      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
67      ! (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 82  contains
82    
83      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
84    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
85      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
86      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
87      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
# Line 133  contains Line 132  contains
132      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
133    
134      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
135      logical ok_veget      logical, save:: ok_veget
136      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
137    
138      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
139    
# Line 183  contains Line 180  contains
180      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
181      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
182    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
183      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
184      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
185      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
186    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
187      !IM Amip2      !IM Amip2
188      ! variables a une pression donnee      ! variables a une pression donnee
189    
# Line 209  contains Line 198  contains
198           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
199           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
200    
     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  
   
201      ! prw: precipitable water      ! prw: precipitable water
202      real prw(klon)      real prw(klon)
203    
# Line 268  contains Line 206  contains
206      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
207      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
208    
209      INTEGER l, kmax, lmax      INTEGER kmax, lmax
210      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
211      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
212      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 320  contains Line 258  contains
258      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
259      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
260    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
261      ! Variables propres a la physique      ! Variables propres a la physique
262    
263      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 459  contains Line 394  contains
394      REAL albsollw(klon)      REAL albsollw(klon)
395      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
396    
397      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
398    
399      ! Declaration des procedures appelees      ! Declaration des procedures appelees
400    
# Line 470  contains Line 405  contains
405      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
406      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
407      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
     EXTERNAL ozonecm   ! prescrire l'ozone  
408      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
409      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
410    
# Line 621  contains Line 555  contains
555      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
556    
557      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
558      real fact_cldcon      real, save:: fact_cldcon
559      real facttemps      real, save:: facttemps
560      logical ok_newmicro      logical ok_newmicro
561      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
562      real facteur      real facteur
563    
564      integer iflag_cldcon      integer iflag_cldcon
# Line 633  contains Line 566  contains
566    
567      logical ptconv(klon, llm)      logical ptconv(klon, llm)
568    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
569      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
570    
571      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 647  contains Line 576  contains
576      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
577    
578      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
579    
580      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
581      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
# Line 657  contains Line 585  contains
585      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
586    
587      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  
   
588      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)
589    
590      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 686  contains Line 612  contains
612      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
613      SAVE      ip_ebil      SAVE      ip_ebil
614      DATA      ip_ebil/0/      DATA      ip_ebil/0/
615      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
616      !+jld ec_conser      !+jld ec_conser
617      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
618      REAL ZRCPD      REAL ZRCPD
# Line 759  contains Line 684  contains
684      SAVE trmb2      SAVE trmb2
685      SAVE trmb3      SAVE trmb3
686    
687        real zmasse(klon, llm)
688        ! (column-density of mass of air in a cell, in kg m-2)
689    
690        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
691    
692      !----------------------------------------------------------------      !----------------------------------------------------------------
693    
694      modname = 'physiq'      modname = 'physiq'
# Line 901  contains Line 831  contains
831    
832         !   Initialisation des sorties         !   Initialisation des sorties
833    
834         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
835         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, ok_journe, nid_day, nq)
836         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
837         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
838         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
839         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 1012  contains Line 942  contains
942      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
943      if (julien == 0) julien = 360      if (julien == 0) julien = 360
944    
945        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
946    
947      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
948      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
949    
950      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nq >= 5) then
951         CALL ozonecm(REAL(julien), rlat, paprs, wo)         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
952        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
953           wo = ozonecm(REAL(julien), paprs)
954      ENDIF      ENDIF
955    
956      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1276  contains Line 1210  contains
1210         DO k = 1, llm         DO k = 1, llm
1211            DO i = 1, klon            DO i = 1, klon
1212               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)) &
1213                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1214            ENDDO            ENDDO
1215         ENDDO         ENDDO
1216      ENDIF      ENDIF
# Line 1304  contains Line 1238  contains
1238         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1239    
1240         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1241            CALL concvl (iflag_con, &            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
                pdtphys, paprs, pplay, t_seri, q_seri, &  
1242                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1243                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1244                 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 1320  contains Line 1253  contains
1253            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1254         ELSE ! ok_cvl         ELSE ! ok_cvl
1255            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1256            CALL conema3 (pdtphys, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1257                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1258                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1259                 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 1411  contains Line 1343  contains
1343         DO k = 1, llm         DO k = 1, llm
1344            DO i = 1, klon            DO i = 1, klon
1345               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)) &
1346                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1347            ENDDO            ENDDO
1348         ENDDO         ENDDO
1349         DO i = 1, klon         DO i = 1, klon
# Line 1568  contains Line 1500  contains
1500               do i=1, klon               do i=1, klon
1501                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1502                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1503                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1504                  endif                  endif
1505               enddo               enddo
1506            enddo            enddo
# Line 1843  contains Line 1775  contains
1775      ENDDO      ENDDO
1776      DO k = 1, llm      DO k = 1, llm
1777         DO i = 1, klon         DO i = 1, klon
1778            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)
1779                 (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  
1780         ENDDO         ENDDO
1781      ENDDO      ENDDO
1782    
1783      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1784    
1785      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1786           ra, rg, romega, &           ra, rg, romega, &
1787           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1788           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1874  contains Line 1804  contains
1804      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &      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, &
1808           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1809           psfl, da, phi, mp, upwd, dnwd, tr_seri)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1810    
1811      IF (offline) THEN      IF (offline) THEN
1812    
# Line 1940  contains Line 1870  contains
1870      DO i = 1, klon      DO i = 1, klon
1871         prw(i) = 0.         prw(i) = 0.
1872         DO k = 1, llm         DO k = 1, llm
1873            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  
1874         ENDDO         ENDDO
1875      ENDDO      ENDDO
1876    
# Line 1968  contains Line 1897  contains
1897      ENDIF      ENDIF
1898    
1899      ! 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:
   
1900      DO k = 1, llm      DO k = 1, llm
1901         DO i = 1, klon         DO i = 1, klon
1902            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1977  contains Line 1905  contains
1905      ENDDO      ENDDO
1906    
1907      !   Ecriture des sorties      !   Ecriture des sorties
   
1908      call write_histhf      call write_histhf
1909      call write_histday      call write_histday
1910      call write_histins      call write_histins
1911    
1912      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1913      IF (lafin) THEN      IF (lafin) THEN
1914         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1915         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
# Line 2000  contains Line 1926  contains
1926      subroutine write_histday      subroutine write_histday
1927    
1928        use grid_change, only: gr_phy_write_3d        use grid_change, only: gr_phy_write_3d
1929          integer itau_w  ! pas de temps ecriture
1930    
1931        !------------------------------------------------        !------------------------------------------------
1932    
1933        if (ok_journe) THEN        if (ok_journe) THEN
          ndex2d = 0  
          ndex3d = 0  
1934           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1935           call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))           if (nq <= 4) then
1936                call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1937                     gr_phy_write_3d(wo) * 1e3)
1938                ! (convert "wo" from kDU to DU)
1939             end if
1940           if (ok_sync) then           if (ok_sync) then
1941              call histsync(nid_day)              call histsync(nid_day)
1942           endif           endif
# Line 2022  contains Line 1950  contains
1950    
1951        ! 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
1952    
1953        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1954    
1955        call write_histhf3d        call write_histhf3d
1956    
# Line 2042  contains Line 1967  contains
1967        ! 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
1968    
1969        real zout        real zout
1970          integer itau_w  ! pas de temps ecriture
1971    
1972        !--------------------------------------------------        !--------------------------------------------------
1973    
1974        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1975           ! Champs 2D:           ! Champs 2D:
1976    
1977           zsto = pdtphys * ecrit_ins           zsto = pdtphys * ecrit_ins
# Line 2278  contains Line 2200  contains
2200    
2201        ! 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
2202    
2203        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2204        ndex3d = 0  
2205          !-------------------------------------------------------
2206    
2207        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2208    
# Line 2311  contains Line 2234  contains
2234    
2235    END SUBROUTINE physiq    END SUBROUTINE physiq
2236    
   !****************************************************  
   
   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  
   
2237  end module physiq_m  end module physiq_m
Legend:
Removed from v.16  
changed lines
  Added in v.23
  ViewVC Help
Powered by ViewVC 1.1.21