/[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 16 by guez, Fri Aug 1 15:37:00 2008 UTC revision 30 by guez, Thu Apr 1 09:07:28 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    
# Line 621  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 633  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 647  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 657  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 686  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 759  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 901  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 1012  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 1276  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 1304  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 1320  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 1411  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 1568  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 1843  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 1874  contains Line 1806  contains
1806      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1807           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, &
1808           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1809           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &
1810           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1811           psfl, da, phi, mp, upwd, dnwd, tr_seri)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1812    
1813      IF (offline) THEN      IF (offline) THEN
1814    
# Line 1940  contains Line 1872  contains
1872      DO i = 1, klon      DO i = 1, klon
1873         prw(i) = 0.         prw(i) = 0.
1874         DO k = 1, llm         DO k = 1, llm
1875            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  
1876         ENDDO         ENDDO
1877      ENDDO      ENDDO
1878    
# Line 1968  contains Line 1899  contains
1899      ENDIF      ENDIF
1900    
1901      ! 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:
   
1902      DO k = 1, llm      DO k = 1, llm
1903         DO i = 1, klon         DO i = 1, klon
1904            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1977  contains Line 1907  contains
1907      ENDDO      ENDDO
1908    
1909      !   Ecriture des sorties      !   Ecriture des sorties
   
1910      call write_histhf      call write_histhf
1911      call write_histday      call write_histday
1912      call write_histins      call write_histins
1913    
1914      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1915      IF (lafin) THEN      IF (lafin) THEN
1916         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1917         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
# Line 2000  contains Line 1928  contains
1928      subroutine write_histday      subroutine write_histday
1929    
1930        use grid_change, only: gr_phy_write_3d        use grid_change, only: gr_phy_write_3d
1931          integer itau_w  ! pas de temps ecriture
1932    
1933        !------------------------------------------------        !------------------------------------------------
1934    
1935        if (ok_journe) THEN        if (ok_journe) THEN
          ndex2d = 0  
          ndex3d = 0  
1936           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1937           call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))           if (nq <= 4) then
1938                call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1939                     gr_phy_write_3d(wo) * 1e3)
1940                ! (convert "wo" from kDU to DU)
1941             end if
1942           if (ok_sync) then           if (ok_sync) then
1943              call histsync(nid_day)              call histsync(nid_day)
1944           endif           endif
# Line 2022  contains Line 1952  contains
1952    
1953        ! 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
1954    
1955        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1956    
1957        call write_histhf3d        call write_histhf3d
1958    
# Line 2042  contains Line 1969  contains
1969        ! 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
1970    
1971        real zout        real zout
1972          integer itau_w  ! pas de temps ecriture
1973    
1974        !--------------------------------------------------        !--------------------------------------------------
1975    
1976        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1977           ! Champs 2D:           ! Champs 2D:
1978    
1979           zsto = pdtphys * ecrit_ins           zsto = pdtphys * ecrit_ins
# Line 2278  contains Line 2202  contains
2202    
2203        ! 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
2204    
2205        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2206        ndex3d = 0  
2207          !-------------------------------------------------------
2208    
2209        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2210    
# Line 2311  contains Line 2236  contains
2236    
2237    END SUBROUTINE physiq    END SUBROUTINE physiq
2238    
   !****************************************************  
   
   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  
   
2239  end module physiq_m  end module physiq_m
Legend:
Removed from v.16  
changed lines
  Added in v.30
  ViewVC Help
Powered by ViewVC 1.1.21