/[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 18 by guez, Thu Aug 7 12:29:13 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 474  contains Line 450  contains
450      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
451      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
452    
     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)  
   
453      ! Variables locales      ! Variables locales
454    
455      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 626  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 638  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 652  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 691  contains Line 656  contains
656      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
657      SAVE      ip_ebil      SAVE      ip_ebil
658      DATA      ip_ebil/0/      DATA      ip_ebil/0/
659      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
660      !+jld ec_conser      !+jld ec_conser
661      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
662      REAL ZRCPD      REAL ZRCPD
# Line 764  contains Line 728  contains
728      SAVE trmb2      SAVE trmb2
729      SAVE trmb3      SAVE trmb3
730    
731        real zmasse(klon, llm)
732        ! (column-density of mass of air in a cell, in kg m-2)
733    
734        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
735    
736      !----------------------------------------------------------------      !----------------------------------------------------------------
737    
738      modname = 'physiq'      modname = 'physiq'
# Line 907  contains Line 876  contains
876         !   Initialisation des sorties         !   Initialisation des sorties
877    
878         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)
879         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, presnivs, ok_journe, nid_day, nq)
880         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)
881         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
882         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
# Line 1017  contains Line 986  contains
986      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
987      if (julien == 0) julien = 360      if (julien == 0) julien = 360
988    
989        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
990    
991      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
992      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
993    
994      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nq >= 5) then
995           wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
996        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
997         CALL ozonecm(REAL(julien), rlat, paprs, wo)         CALL ozonecm(REAL(julien), rlat, paprs, wo)
998      ENDIF      ENDIF
999    
# Line 1281  contains Line 1254  contains
1254         DO k = 1, llm         DO k = 1, llm
1255            DO i = 1, klon            DO i = 1, klon
1256               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)) &
1257                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1258            ENDDO            ENDDO
1259         ENDDO         ENDDO
1260      ENDIF      ENDIF
# Line 1309  contains Line 1282  contains
1282         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1283    
1284         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1285            CALL concvl (iflag_con, &            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
                pdtphys, paprs, pplay, t_seri, q_seri, &  
1286                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1287                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1288                 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 1297  contains
1297            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1298         ELSE ! ok_cvl         ELSE ! ok_cvl
1299            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1300            CALL conema3 (pdtphys, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1301                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1302                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1303                 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 1387  contains
1387         DO k = 1, llm         DO k = 1, llm
1388            DO i = 1, klon            DO i = 1, klon
1389               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)) &
1390                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1391            ENDDO            ENDDO
1392         ENDDO         ENDDO
1393         DO i = 1, klon         DO i = 1, klon
# Line 1573  contains Line 1544  contains
1544               do i=1, klon               do i=1, klon
1545                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1546                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1547                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1548                  endif                  endif
1549               enddo               enddo
1550            enddo            enddo
# Line 1848  contains Line 1819  contains
1819      ENDDO      ENDDO
1820      DO k = 1, llm      DO k = 1, llm
1821         DO i = 1, klon         DO i = 1, klon
1822            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)
1823                 (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  
1824         ENDDO         ENDDO
1825      ENDDO      ENDDO
1826    
1827      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1828    
1829      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1830           ra, rg, romega, &           ra, rg, romega, &
1831           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1832           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1881  contains Line 1850  contains
1850           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1851           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &
1852           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1853           psfl, da, phi, mp, upwd, dnwd, tr_seri)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1854    
1855      IF (offline) THEN      IF (offline) THEN
1856    
# Line 1945  contains Line 1914  contains
1914      DO i = 1, klon      DO i = 1, klon
1915         prw(i) = 0.         prw(i) = 0.
1916         DO k = 1, llm         DO k = 1, llm
1917            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  
1918         ENDDO         ENDDO
1919      ENDDO      ENDDO
1920    
# Line 1973  contains Line 1941  contains
1941      ENDIF      ENDIF
1942    
1943      ! 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:
   
1944      DO k = 1, llm      DO k = 1, llm
1945         DO i = 1, klon         DO i = 1, klon
1946            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1982  contains Line 1949  contains
1949      ENDDO      ENDDO
1950    
1951      !   Ecriture des sorties      !   Ecriture des sorties
   
1952      call write_histhf      call write_histhf
1953      call write_histday      call write_histday
1954      call write_histins      call write_histins
1955    
1956      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1957      IF (lafin) THEN      IF (lafin) THEN
1958         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1959         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
# Line 2005  contains Line 1970  contains
1970      subroutine write_histday      subroutine write_histday
1971    
1972        use grid_change, only: gr_phy_write_3d        use grid_change, only: gr_phy_write_3d
1973          integer itau_w  ! pas de temps ecriture
1974    
1975        !------------------------------------------------        !------------------------------------------------
1976    
1977        if (ok_journe) THEN        if (ok_journe) THEN
          ndex2d = 0  
          ndex3d = 0  
1978           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1979           call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))           if (nq <= 4) then
1980                call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1981                     gr_phy_write_3d(wo) * 1e3)
1982                ! (convert "wo" from kDU to DU)
1983             end if
1984           if (ok_sync) then           if (ok_sync) then
1985              call histsync(nid_day)              call histsync(nid_day)
1986           endif           endif
# Line 2027  contains Line 1994  contains
1994    
1995        ! 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
1996    
1997        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1998    
1999        call write_histhf3d        call write_histhf3d
2000    
# Line 2047  contains Line 2011  contains
2011        ! 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
2012    
2013        real zout        real zout
2014          integer itau_w  ! pas de temps ecriture
2015    
2016        !--------------------------------------------------        !--------------------------------------------------
2017    
2018        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
2019           ! Champs 2D:           ! Champs 2D:
2020    
2021           zsto = pdtphys * ecrit_ins           zsto = pdtphys * ecrit_ins
# Line 2283  contains Line 2244  contains
2244    
2245        ! 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
2246    
2247        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2248        ndex3d = 0  
2249          !-------------------------------------------------------
2250    
2251        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2252    
# Line 2316  contains Line 2278  contains
2278    
2279    END SUBROUTINE physiq    END SUBROUTINE physiq
2280    
   !****************************************************  
   
   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  
   
2281  end module physiq_m  end module physiq_m
Legend:
Removed from v.15  
changed lines
  Added in v.18
  ViewVC Help
Powered by ViewVC 1.1.21