/[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 17 by guez, Tue Aug 5 13:31:32 2008 UTC
# 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    
58      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
59      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
60    
61      ! Variables argument:      ! Variables argument:
62    
63      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)
64    
65      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
66      ! (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 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 218  contains Line 217  contains
217      INTEGER nout      INTEGER nout
218      PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC      PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC
219    
     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  
   
220      logical oknondef(klon, nlevSTD, nout)      logical oknondef(klon, nlevSTD, nout)
221      real tnondef(klon, nlevSTD, nout)      real tnondef(klon, nlevSTD, nout)
222      save tnondef      save tnondef
# Line 239  contains Line 230  contains
230      real vTSTD(klon, nlevSTD)      real vTSTD(klon, nlevSTD)
231      real wqSTD(klon, nlevSTD)      real wqSTD(klon, nlevSTD)
232    
     real uvsumSTD(klon, nlevSTD, nout)  
     real vqsumSTD(klon, nlevSTD, nout)  
     real vTsumSTD(klon, nlevSTD, nout)  
     real wqsumSTD(klon, nlevSTD, nout)  
   
233      real vphiSTD(klon, nlevSTD)      real vphiSTD(klon, nlevSTD)
234      real wTSTD(klon, nlevSTD)      real wTSTD(klon, nlevSTD)
235      real u2STD(klon, nlevSTD)      real u2STD(klon, nlevSTD)
236      real v2STD(klon, nlevSTD)      real v2STD(klon, nlevSTD)
237      real T2STD(klon, nlevSTD)      real T2STD(klon, nlevSTD)
238    
     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  
   
239      ! prw: precipitable water      ! prw: precipitable water
240      real prw(klon)      real prw(klon)
241    
# Line 459  contains Line 435  contains
435      REAL albsollw(klon)      REAL albsollw(klon)
436      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
437    
438      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
439    
440      ! Declaration des procedures appelees      ! Declaration des procedures appelees
441    
# Line 621  contains Line 597  contains
597      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
598    
599      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
600      real fact_cldcon      real, save:: fact_cldcon
601      real facttemps      real, save:: facttemps
602      logical ok_newmicro      logical ok_newmicro
603      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
604      real facteur      real facteur
605    
606      integer iflag_cldcon      integer iflag_cldcon
# Line 633  contains Line 608  contains
608    
609      logical ptconv(klon, llm)      logical ptconv(klon, llm)
610    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
611      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
612    
613      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 647  contains Line 618  contains
618      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
619    
620      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
621    
622      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
623      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
# Line 759  contains Line 729  contains
729      SAVE trmb2      SAVE trmb2
730      SAVE trmb3      SAVE trmb3
731    
732        real zmasse(klon, llm)
733        ! (column-density of mass of air in a cell, in kg m-2)
734    
735        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
736    
737      !----------------------------------------------------------------      !----------------------------------------------------------------
738    
739      modname = 'physiq'      modname = 'physiq'
# Line 902  contains Line 877  contains
877         !   Initialisation des sorties         !   Initialisation des sorties
878    
879         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)
880         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, presnivs, ok_journe, nid_day, nq)
881         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)
882         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
883         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
# Line 1012  contains Line 987  contains
987      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
988      if (julien == 0) julien = 360      if (julien == 0) julien = 360
989    
990        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
991    
992      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
993      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
994    
995    !!$    if (nq >= 5) then
996    !!$       wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
997    !!$    else IF (MOD(itap - 1, lmt_pas) == 0) THEN
998      IF (MOD(itap - 1, lmt_pas) == 0) THEN      IF (MOD(itap - 1, lmt_pas) == 0) THEN
999         CALL ozonecm(REAL(julien), rlat, paprs, wo)         CALL ozonecm(REAL(julien), rlat, paprs, wo)
1000      ENDIF      ENDIF
# Line 1276  contains Line 1256  contains
1256         DO k = 1, llm         DO k = 1, llm
1257            DO i = 1, klon            DO i = 1, klon
1258               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)) &
1259                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1260            ENDDO            ENDDO
1261         ENDDO         ENDDO
1262      ENDIF      ENDIF
# Line 1304  contains Line 1284  contains
1284         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1285    
1286         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1287            CALL concvl (iflag_con, &            CALL concvl (iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
                pdtphys, paprs, pplay, t_seri, q_seri, &  
1288                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1289                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1290                 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 1299  contains
1299            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1300         ELSE ! ok_cvl         ELSE ! ok_cvl
1301            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1302            CALL conema3 (pdtphys, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1303                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1304                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1305                 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 1389  contains
1389         DO k = 1, llm         DO k = 1, llm
1390            DO i = 1, klon            DO i = 1, klon
1391               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)) &
1392                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1393            ENDDO            ENDDO
1394         ENDDO         ENDDO
1395         DO i = 1, klon         DO i = 1, klon
# Line 1568  contains Line 1546  contains
1546               do i=1, klon               do i=1, klon
1547                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1548                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1549                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1550                  endif                  endif
1551               enddo               enddo
1552            enddo            enddo
# Line 1843  contains Line 1821  contains
1821      ENDDO      ENDDO
1822      DO k = 1, llm      DO k = 1, llm
1823         DO i = 1, klon         DO i = 1, klon
1824            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)
1825                 (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  
1826         ENDDO         ENDDO
1827      ENDDO      ENDDO
1828    
1829      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1830    
1831      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1832           ra, rg, romega, &           ra, rg, romega, &
1833           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1834           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1876  contains Line 1852  contains
1852           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1853           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &
1854           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1855           psfl, da, phi, mp, upwd, dnwd, tr_seri)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1856    
1857      IF (offline) THEN      IF (offline) THEN
1858    
# Line 1940  contains Line 1916  contains
1916      DO i = 1, klon      DO i = 1, klon
1917         prw(i) = 0.         prw(i) = 0.
1918         DO k = 1, llm         DO k = 1, llm
1919            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  
1920         ENDDO         ENDDO
1921      ENDDO      ENDDO
1922    
# Line 1968  contains Line 1943  contains
1943      ENDIF      ENDIF
1944    
1945      ! 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:
   
1946      DO k = 1, llm      DO k = 1, llm
1947         DO i = 1, klon         DO i = 1, klon
1948            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1977  contains Line 1951  contains
1951      ENDDO      ENDDO
1952    
1953      !   Ecriture des sorties      !   Ecriture des sorties
   
1954      call write_histhf      call write_histhf
1955      call write_histday      call write_histday
1956      call write_histins      call write_histins
1957    
1958      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1959      IF (lafin) THEN      IF (lafin) THEN
1960         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1961         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
# Line 2000  contains Line 1972  contains
1972      subroutine write_histday      subroutine write_histday
1973    
1974        use grid_change, only: gr_phy_write_3d        use grid_change, only: gr_phy_write_3d
1975          integer itau_w  ! pas de temps ecriture
1976    
1977        !------------------------------------------------        !------------------------------------------------
1978    
1979        if (ok_journe) THEN        if (ok_journe) THEN
          ndex2d = 0  
          ndex3d = 0  
1980           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1981           call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))           if (nq <= 4) then
1982                call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1983                     gr_phy_write_3d(wo) * 1e3)
1984                ! (convert "wo" from kDU to DU)
1985             end if
1986           if (ok_sync) then           if (ok_sync) then
1987              call histsync(nid_day)              call histsync(nid_day)
1988           endif           endif
# Line 2022  contains Line 1996  contains
1996    
1997        ! 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
1998    
1999        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
2000    
2001        call write_histhf3d        call write_histhf3d
2002    
# Line 2042  contains Line 2013  contains
2013        ! 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
2014    
2015        real zout        real zout
2016          integer itau_w  ! pas de temps ecriture
2017    
2018        !--------------------------------------------------        !--------------------------------------------------
2019    
2020        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
2021           ! Champs 2D:           ! Champs 2D:
2022    
2023           zsto = pdtphys * ecrit_ins           zsto = pdtphys * ecrit_ins
# Line 2278  contains Line 2246  contains
2246    
2247        ! 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
2248    
2249        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2250        ndex3d = 0  
2251          !-------------------------------------------------------
2252    
2253        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2254    
# Line 2311  contains Line 2280  contains
2280    
2281    END SUBROUTINE physiq    END SUBROUTINE physiq
2282    
   !****************************************************  
   
   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  
   
2283  end module physiq_m  end module physiq_m
Legend:
Removed from v.16  
changed lines
  Added in v.17
  ViewVC Help
Powered by ViewVC 1.1.21