Changeset 1312


Ignore:
Timestamp:
Jul 11, 2014, 11:48:09 AM (11 years ago)
Author:
emillour
Message:

Generic and Mars GCM:
LMDZ.COMMON dynamics sends mass flux to physics and not vertical velocity.
Add the computation of vertical velocity from input mass flux in the physics,
and also modify "old" LMDZ.GENERIC and LMDZ.MARS dynamics to be consistent.
EM

Location:
trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • TabularUnified trunk/LMDZ.COMMON/libf/dyn3d/calfis.F

    r1302 r1312  
    128128      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
    129129      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
    130       REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on dynamics grid
     130      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
    131131
    132132      ! tendencies (in */s) from the physics
  • TabularUnified trunk/LMDZ.COMMON/libf/dyn3dpar/calfis_p.F

    r1302 r1312  
    138138      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
    139139      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
    140       REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on dynamics grid
     140      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
    141141
    142142      ! tendencies (in */s) from the physics
  • TabularUnified trunk/LMDZ.GENERIC/README

    r1308 r1312  
    10371037dimension.h in the physics.
    10381038
     1039== 11/07/2014 == EM
     1040- Changed the variable passed from LMDZ.GENERIC dynamics to physics:
     1041it is now a mass flux (kg/s) which is then converted to a vertical
     1042velocity (m/s) in the physics. This is to be consistent with what is
     1043done in LMDZ.COMMON.
     1044
  • TabularUnified trunk/LMDZ.GENERIC/libf/dyn3d/calfis.F

    r1216 r1312  
    4343c       pmasse          masse d'air dans chaque maille
    4444c       pts             surface temperature  (K)
    45 c       pw              flux vertical (kg m-2)
     45c       pw              flux vertical (kg/s)
    4646c
    4747c    Output :
     
    308308c On interpole "lineairement" la temperature entre les couches(FF,10/95)
    309309
    310       DO ig=1,ngridmx
    311          zvervel(ig,1)=0.
    312       END DO
    313       DO l=2,llm
    314         zvervel(1,l)=(pw(1,1,l)/apoln)
    315      &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)             
    316         ig0=2
    317        DO j=2,jjm
    318            DO i = 1, iim
    319               zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
    320      &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
    321               ig0 = ig0 + 1
    322            ENDDO
    323        ENDDO
    324         zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
    325      &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
    326       ENDDO
     310!      DO ig=1,ngridmx
     311!         zvervel(ig,1)=0.
     312!      END DO
     313!      DO l=2,llm
     314!        zvervel(1,l)=(pw(1,1,l)/apoln)
     315!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)             
     316!        ig0=2
     317!       DO j=2,jjm
     318!           DO i = 1, iim
     319!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
     320!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
     321!              ig0 = ig0 + 1
     322!           ENDDO
     323!       ENDDO
     324!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
     325!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
     326!      ENDDO
    327327
    328328c    .........  Reindexation : calcul de zvervel au MILIEU des couches
    329        DO l=1,llm-1
    330               DO ig=1,ngridmx
    331                      zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
    332           END DO
    333        END DO
     329!       DO l=1,llm-1
     330!             DO ig=1,ngridmx
     331!                    zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
     332!          END DO
     333!       END DO
    334334c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
    335335
     
    430430     ,     zplev,zplay,zphi,
    431431     ,     zufi, zvfi,ztfi, zqfi, 
    432      ,     zvervel,
     432!     ,     zvervel,
     433     ,     pw,
    433434C - sorties
    434435     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
  • TabularUnified trunk/LMDZ.GENERIC/libf/phystd/physiq.F90

    r1309 r1312  
    55                  pplev,pplay,pphi,        &
    66                  pu,pv,pt,pq,             &
    7                   pw,                      &
     7                  flxw,                    &
    88                  pdu,pdv,pdt,pdq,pdpsrf,tracerdyn)
    99 
     
    9898!    ptdyn(ngrid,nlayer)     / corresponding variables
    9999!    pqdyn(ngrid,nlayer,nq) /
    100 !    pw(ngrid,?)           vertical velocity
     100!    flxw(ngrid,nlayer)      vertical mass flux (kg/s) at layer lower boundary
    101101!
    102102!   output
     
    161161      real,intent(in) :: pt(ngrid,nlayer) ! temperature (K)
    162162      real,intent(in) :: pq(ngrid,nlayer,nq) ! tracers (.../kg_of_air)
    163       real,intent(in) :: pw(ngrid,nlayer)    ! vertical velocity (m/s)
    164 
     163      real,intent(in) :: flxw(ngrid,nlayer) ! vertical mass flux (ks/s)
     164                                            ! at lower boundary of layer
    165165
    166166
     
    210210      real aerosol(ngrid,nlayer,naerkind)
    211211      real zh(ngrid,nlayer)      ! potential temperature (K)
     212      real pw(ngrid,nlayer) ! vertical velocity (m/s) (>0 when downwards)
    212213
    213214      character*80 fichier
     
    803804      enddo
    804805
     806     ! Compute vertical velocity (m/s) from vertical mass flux
     807     ! w = F / (rho*area) and rho = r*T/P
     808     ! but first linearly interpolate mass flux to mid-layers
     809     do l=1,nlayer-1
     810       pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
     811     enddo
     812     pw(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
     813     do l=1,nlayer
     814       pw(1:ngrid,l)=(pw(1:ngrid,l)*pplay(1:ngrid,l)) /  &
     815                     (r*pt(1:ngrid,l)*area(1:ngrid))
     816     enddo
    805817
    806818!-----------------------------------------------------------------------
  • TabularUnified trunk/LMDZ.MARS/README

    r1278 r1312  
    21322132- Add possibility to use clim or MY31 dust scenarios (and realistic EUV for MY31).
    21332133
     2134== 11/07/2014 == EM
     2135- Changed the variable passed from LMDZ.MARS dynamics to physics: it is now
     2136a mass flux (kg/s) which is then converted to a vertical velocity (m/s) in
     2137the physics. This is to be consistent with what is done in LMDZ.COMMON.
     2138
  • TabularUnified trunk/LMDZ.MARS/libf/dyn3d/calfis.F

    r1130 r1312  
    4343c       pmasse          masse d'air dans chaque maille
    4444c       pts             surface temperature  (K)
    45 c       pw              flux vertical (kg m-2)
     45c       pw              flux vertical (kg/s)
    4646c
    4747c    Output :
     
    305305c On interpole "lineairement" la temperature entre les couches(FF,10/95)
    306306
    307       DO ig=1,ngridmx
    308          zvervel(ig,1)=0.
    309       END DO
    310       DO l=2,llm
    311         zvervel(1,l)=(pw(1,1,l)/apoln)
    312      &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)             
    313         ig0=2
    314        DO j=2,jjm
    315            DO i = 1, iim
    316               zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
    317      &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
    318               ig0 = ig0 + 1
    319            ENDDO
    320        ENDDO
    321         zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
    322      &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
    323       ENDDO
     307!      DO ig=1,ngridmx
     308!         zvervel(ig,1)=0.
     309!      END DO
     310!      DO l=2,llm
     311!        zvervel(1,l)=(pw(1,1,l)/apoln)
     312!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)             
     313!        ig0=2
     314!       DO j=2,jjm
     315!           DO i = 1, iim
     316!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
     317!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
     318!              ig0 = ig0 + 1
     319!           ENDDO
     320!       ENDDO
     321!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
     322!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)             
     323!      ENDDO
    324324
    325325c    .........  Reindexation : calcul de zvervel au MILIEU des couches
    326        DO l=1,llm-1
    327               DO ig=1,ngridmx
    328                      zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
    329           END DO
    330        END DO
     326!       DO l=1,llm-1
     327!             DO ig=1,ngridmx
     328!                    zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
     329!          END DO
     330!       END DO
    331331c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
    332332
     
    426426     ,     zplev,zplay,zphi,
    427427     ,     zufi, zvfi,ztfi, zqfi, 
    428      ,     zvervel,
     428!     ,     zvervel,
     429     ,     pw,
    429430C - sorties
    430431     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
  • TabularUnified trunk/LMDZ.MARS/libf/phymars/physiq.F

    r1292 r1312  
    55     $            ,pplev,pplay,pphi
    66     $            ,pu,pv,pt,pq
    7      $            ,pw
     7     $            ,flxw
    88     $            ,pdu,pdv,pdt,pdq,pdpsrf,tracerdyn)
    99
     
    128128c    ptdyn(ngrid,nlayer)    | corresponding variables
    129129c    pqdyn(ngrid,nlayer,nq) |
    130 c    pw(ngrid,?)           vertical velocity
     130c    flxw(ngrid,nlayer)      vertical mass flux (kg/s) at layer lower boundary
    131131c
    132132c   output:
     
    159159c   inputs:
    160160c   -------
    161       INTEGER ngrid,nlayer,nq
    162       REAL ptimestep
    163       REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
    164       REAL pphi(ngrid,nlayer)
    165       REAL pu(ngrid,nlayer),pv(ngrid,nlayer)
    166       REAL pt(ngrid,nlayer),pq(ngrid,nlayer,nq)
    167       REAL pw(ngrid,nlayer) !Mars pvervel transmit par dyn3d
    168       REAL zh(ngrid,nlayer)      ! potential temperature (K)
    169       LOGICAL firstcall,lastcall
    170 
    171       REAL pday
    172       REAL ptime
    173       logical tracerdyn
     161      INTEGER,INTENT(in) :: ngrid ! number of atmospheric columns
     162      INTEGER,INTENT(in) :: nlayer ! number of atmospheric layers
     163      INTEGER,INTENT(in) :: nq ! number of tracers
     164      LOGICAL,INTENT(in) :: firstcall ! signals first call to physics
     165      LOGICAL,INTENT(in) :: lastcall ! signals last call to physics
     166      REAL,INTENT(in) :: pday ! number of elapsed sols since reference Ls=0
     167      REAL,INTENT(in) :: ptime ! "universal time", given as fraction of sol (e.g.: 0.5 for noon)
     168      REAL,INTENT(in) :: ptimestep ! physics timestep (s)
     169      REAL,INTENT(in) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa)
     170      REAL,INTENT(IN) :: pplay(ngrid,nlayer) ! mid-layer pressure (Pa)
     171      REAL,INTENT(IN) :: pphi(ngrid,nlayer) ! geopotential at mid-layer (m2s-2)
     172      REAL,INTENT(in) :: pu(ngrid,nlayer) ! zonal wind component (m/s)
     173      REAL,INTENT(in) :: pv(ngrid,nlayer) ! meridional wind component (m/s)
     174      REAL,INTENT(in) :: pt(ngrid,nlayer) ! temperature (K)
     175      REAL,INTENT(in) :: pq(ngrid,nlayer,nq) ! tracers (.../kg_of_air)
     176      REAL,INTENT(in) :: flxw(ngrid,nlayer) ! vertical mass flux (ks/s)
     177                                            ! at lower boundary of layer
    174178
    175179c   outputs:
    176180c   --------
    177181c     physical tendencies
    178       REAL pdu(ngrid,nlayer),pdv(ngrid,nlayer)
    179       REAL pdt(ngrid,nlayer),pdq(ngrid,nlayer,nq)
    180       REAL pdpsrf(ngrid) ! surface pressure tendency
     182      REAL,INTENT(out) :: pdu(ngrid,nlayer) ! zonal wind tendency (m/s/s)
     183      REAL,INTENT(out) :: pdv(ngrid,nlayer) ! meridional wind tendency (m/s/s)
     184      REAL,INTENT(out) :: pdt(ngrid,nlayer) ! temperature tendency (K/s)
     185      REAL,INTENT(out) :: pdq(ngrid,nlayer,nq) ! tracer tendencies (../kg/s)
     186      REAL,INTENT(out) :: pdpsrf(ngrid) ! surface pressure tendency (Pa/s)
     187      LOGICAL,INTENT(out) :: tracerdyn ! signal to the dynamics to advect tracers or not
    181188
    182189
     
    273280      REAL ztime_fin
    274281      REAL zdh(ngrid,nlayer)
     282      REAL pw(ngrid,nlayer) ! vertical velocity (m/s) (>0 when downwards)
    275283      INTEGER length
    276284      PARAMETER (length=100)
     
    569577      endif
    570578#endif
     579
     580     ! Compute vertical velocity (m/s) from vertical mass flux
     581     ! w = F / (rho*area) and rho = r*T/P
     582     ! but first linearly interpolate mass flux to mid-layers
     583     do l=1,nlayer-1
     584       pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
     585     enddo
     586     pw(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
     587     do l=1,nlayer
     588       pw(1:ngrid,l)=(pw(1:ngrid,l)*pplay(1:ngrid,l)) /  &
     589                     (r*pt(1:ngrid,l)*area(1:ngrid))
     590       ! NB: here we use r and nor rnew since this diagnostic comes
     591       ! from the dynamics
     592     enddo
     593
    571594c-----------------------------------------------------------------------
    572595c    2. Compute radiative tendencies :
Note: See TracChangeset for help on using the changeset viewer.