Ignore:
Timestamp:
Jul 24, 2013, 1:36:44 PM (11 years ago)
Author:
emillour
Message:

Common dynamics: Improved sponge layer scheme (top_bound):

  • Sponge tendencies are now computed analytically, instead of using a Forward Euler approximation.
  • Sponge tendencies are now added within top_bound.

EM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/dyn3dpar/top_bound_p.F

    r124 r1010  
    1       SUBROUTINE top_bound_p( vcov,ucov,teta,phi,masse, du,dv,dh )
     1!
     2! $Id: top_bound_p.F 1793 2013-07-18 07:13:18Z emillour $
     3!
     4      SUBROUTINE top_bound_p(vcov,ucov,teta,masse,dt,ducov)
    25      USE parallel
    36      IMPLICIT NONE
    … …  
    2528c
    2629c=======================================================================
    27 c-----------------------------------------------------------------------
    28 c   Declarations:
    29 c   -------------
     30
     31! top_bound sponge layer model:
     32! Quenching is modeled as: A(t)=Am+A0*exp(-lambda*dt)
     33! where Am is the zonal average of the field (or zero), and lambda the inverse
     34! of the characteristic quenching/relaxation time scale
     35! Thus, assuming Am to be time-independent, field at time t+dt is given by:
     36! A(t+dt)=A(t)-(A(t)-Am)*(1-exp(-lambda*t))
     37! Moreover lambda can be a function of model level (see below), and relaxation
     38! can be toward the average zonal field or just zero (see below).
     39
     40! NB: top_bound sponge is only called from leapfrog if ok_strato=.true.
     41
     42! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst.h)
     43!    iflag_top_bound=0 for no sponge
     44!    iflag_top_bound=1 for sponge over 4 topmost layers
     45!    iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
     46!    mode_top_bound=0: no relaxation
     47!    mode_top_bound=1: u and v relax towards 0
     48!    mode_top_bound=2: u and v relax towards their zonal mean
     49!    mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
     50!    tau_top_bound : inverse of charactericstic relaxation time scale at
     51!                       the topmost layer (Hz)
     52
    3053
    3154#include "comdissipn.h"
     55#include "iniprint.h"
    3256
    3357c   Arguments:
    3458c   ----------
    3559
    36       REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
    37       REAL phi(iip1,jjp1,llm)                  ! geopotentiel
    38       REAL masse(iip1,jjp1,llm)
    39       REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
     60      real,intent(inout) :: ucov(iip1,jjp1,llm) ! covariant zonal wind
     61      real,intent(inout) :: vcov(iip1,jjm,llm) ! covariant meridional wind
     62      real,intent(inout) :: teta(iip1,jjp1,llm) ! potential temperature
     63      real,intent(in) :: masse(iip1,jjp1,llm) ! mass of atmosphere
     64      real,intent(in) :: dt ! time step (s) of sponge model
     65      real,intent(out) :: ducov(iip1,jjp1,llm) ! increment on ucov due to sponge
    4066
    4167c   Local:
    … …  
    4470      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
    4571     
    46       INTEGER NDAMP
    47       PARAMETER (NDAMP=4)
    4872      integer i
    49       REAL,SAVE :: rdamp(llm)
    50 !     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
     73      REAL,SAVE :: rdamp(llm) ! quenching coefficient
     74      real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
    5175      LOGICAL,SAVE :: first=.true.
    52      
    53       REAL zkm
    5476      INTEGER j,l,jjb,jje
    5577
    5678
    5779      if (iflag_top_bound == 0) return
     80
    5881      if (first) then
    5982c$OMP BARRIER
    6083c$OMP MASTER
    6184         if (iflag_top_bound == 1) then
    62 ! couche eponge dans les 4 dernieres couches du modele
    63              rdamp(:)=0.
    64              rdamp(llm)=tau_top_bound
    65              rdamp(llm-1)=tau_top_bound/2.
    66              rdamp(llm-2)=tau_top_bound/4.
    67              rdamp(llm-3)=tau_top_bound/8.
     85! sponge quenching over the topmost 4 atmospheric layers
     86             lambda(:)=0.
     87             lambda(llm)=tau_top_bound
     88             lambda(llm-1)=tau_top_bound/2.
     89             lambda(llm-2)=tau_top_bound/4.
     90             lambda(llm-3)=tau_top_bound/8.
    6891         else if (iflag_top_bound == 2) then
    69 ! couche eponge dans toutes les couches de pression plus faible que
    70 ! 100 fois la pression de la derniere couche
    71              rdamp(:)=tau_top_bound
     92! sponge quenching over topmost layers down to pressures which are
     93! higher than 100 times the topmost layer pressure
     94             lambda(:)=tau_top_bound
    7295     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
    7396         endif
    74          first=.false.
    75          print*,'TOP_BOUND mode',mode_top_bound
    76          print*,'Coeffs pour la couche eponge a l equateur'
    77          print*,'p (Pa)  z(km)  tau (s)'
     97
     98! quenching coefficient rdamp(:)
     99!         rdamp(:)=dt*lambda(:) ! Explicit Euler approx.
     100         rdamp(:)=1.-exp(-lambda(:)*dt)
     101
     102         write(lunout,*)'TOP_BOUND mode',mode_top_bound
     103         write(lunout,*)'Sponge layer coefficients'
     104         write(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
    78105         do l=1,llm
    79106           if (rdamp(l).ne.0.) then
    80             zkm        = phi(iip1/2,jjp1/2,l)/(1000*g)
    81           print*,presnivs(l),zkm,1./rdamp(l)
     107             write(lunout,'(6(1pe12.4,1x))')
     108     &        presnivs(l),log(preff/presnivs(l))*scaleheight,
     109     &           1./lambda(l),lambda(l)
    82110           endif
    83111         enddo
     112         first=.false.
    84113c$OMP END MASTER
    85114c$OMP BARRIER
    86       endif
     115      endif ! of if (first)
    87116
    88117
    89118      CALL massbar_p(masse,massebx,masseby)
    90119
    91 c   mode = 0 : pas de sponge
    92 c   mode = 1 : u et v -> 0
    93 c   mode = 2 : u et v -> moyenne zonale
    94 c   mode = 3 : u, v et h -> moyenne zonale
    95 
    96 C POUR V
    97 
    98 C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
    99 
    100       jjb=jj_begin
    101       jje=jj_end
    102       IF (pole_sud) jje=jj_end-1
    103 
     120      ! compute zonal average of vcov (or set it to zero)
    104121      if (mode_top_bound.ge.2) then
    105 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     122       jjb=jj_begin
     123       jje=jj_end
     124       IF (pole_sud) jje=jj_end-1
     125c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    106126       do l=1,llm
    107127        do j=jjb,jje
    … …  
    109129          vzon(j,l)=0
    110130          do i=1,iim
    111 ! Rm: on peut travailler directement avec la moyenne zonale de vcov
    112 ! plutot qu'avec celle de v car le coefficient cv qui relie les deux
    113 ! ne varie qu'en latitude
     131! NB: we can work using vcov zonal mean rather than v since the
     132! cv coefficient (which relates the two) only varies with latitudes
    114133            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
    115134            zm=zm+masseby(i,j,l)
    … …  
    118137        enddo
    119138       enddo
    120 !$OMP END DO NOWAIT   
     139c$OMP END DO NOWAIT   
    121140      else
    122 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    123        do l=1,llm
    124         do j=jjb,jje
    125           vzon(j,l)=0.
    126         enddo
    127        enddo
    128 !$OMP END DO NOWAIT
    129       endif
    130 
    131 C   AMORTISSEMENTS LINEAIRES:
    132 
    133       if (mode_top_bound.ge.1) then
    134 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    135        do l=1,llm
    136         do j=jjb,jje
    137           do i=1,iip1
    138             dv(i,j,l)= -rdamp(l)*(vcov(i,j,l)-vzon(j,l))
    139           enddo
    140         enddo
    141        enddo
    142 !$OMP END DO NOWAIT
    143       endif
    144 
    145 C POUR U ET H
    146 
    147 C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
    148 
    149       jjb=jj_begin
    150       jje=jj_end
    151       IF (pole_nord) jjb=jj_begin+1
    152       IF (pole_sud)  jje=jj_end-1
    153 
     141c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     142       do l=1,llm
     143         vzon(:,l)=0.
     144       enddo
     145c$OMP END DO NOWAIT
     146      endif ! of if (mode_top_bound.ge.2)
     147
     148      ! compute zonal average of u (or set it to zero)
    154149      if (mode_top_bound.ge.2) then
    155 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     150       jjb=jj_begin
     151       jje=jj_end
     152       IF (pole_nord) jjb=jj_begin+1
     153       IF (pole_sud)  jje=jj_end-1
     154c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    156155       do l=1,llm
    157156        do j=jjb,jje
    … …  
    165164        enddo
    166165       enddo
    167 !$OMP END DO NOWAIT
     166c$OMP END DO NOWAIT
    168167      else
    169 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    170        do l=1,llm
    171         do j=jjb,jje
    172           uzon(j,l)=0.
    173         enddo
    174        enddo
    175 !$OMP END DO NOWAIT
    176       endif
    177 
     168c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     169       do l=1,llm
     170         uzon(:,l)=0.
     171       enddo
     172c$OMP END DO NOWAIT
     173      endif ! of if (mode_top_bound.ge.2)
     174
     175      ! compute zonal average of potential temperature, if necessary
    178176      if (mode_top_bound.ge.3) then
    179 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     177       jjb=jj_begin
     178       jje=jj_end
     179       IF (pole_nord) jjb=jj_begin+1
     180       IF (pole_sud)  jje=jj_end-1
     181c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    180182       do l=1,llm
    181183        do j=jjb,jje
    … …  
    189191        enddo
    190192       enddo
    191 !$OMP END DO NOWAIT
    192       endif
    193 
    194 C   AMORTISSEMENTS LINEAIRES:
     193c$OMP END DO NOWAIT
     194      endif ! of if (mode_top_bound.ge.3)
    195195
    196196      if (mode_top_bound.ge.1) then
    197 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     197       ! Apply sponge quenching on vcov:
     198       jjb=jj_begin
     199       jje=jj_end
     200       IF (pole_sud) jje=jj_end-1
     201
     202c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    198203       do l=1,llm
    199204        do j=jjb,jje
    200205          do i=1,iip1
    201             du(i,j,l)= -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
    202           enddo
    203         enddo
    204        enddo
    205 !$OMP END DO NOWAIT
    206       endif
    207      
    208       if (mode_top_bound.ge.3) then
    209 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     206            vcov(i,j,l)=vcov(i,j,l)
     207     &                  -rdamp(l)*(vcov(i,j,l)-vzon(j,l))
     208          enddo
     209        enddo
     210       enddo
     211c$OMP END DO NOWAIT
     212
     213       ! Apply sponge quenching on ucov:
     214       jjb=jj_begin
     215       jje=jj_end
     216       IF (pole_nord) jjb=jj_begin+1
     217       IF (pole_sud)  jje=jj_end-1
     218
     219c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    210220       do l=1,llm
    211221        do j=jjb,jje
    212222          do i=1,iip1
    213             dh(i,j,l)= -rdamp(l)*(teta(i,j,l)-tzon(j,l))
    214           enddo
    215         enddo
    216        enddo
    217 !$OMP END DO NOWAIT
    218       endif     
    219 
    220 !$OMP BARRIER
    221       RETURN
     223            ducov(i,j,l)=-rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
     224            ucov(i,j,l)=ucov(i,j,l)
     225     &                  +ducov(i,j,l)
     226          enddo
     227       enddo
     228       enddo
     229c$OMP END DO NOWAIT
     230      endif ! of if (mode_top_bound.ge.1)
     231
     232      if (mode_top_bound.ge.3) then   
     233       ! Apply sponge quenching on teta:
     234       jjb=jj_begin
     235       jje=jj_end
     236       IF (pole_nord) jjb=jj_begin+1
     237       IF (pole_sud)  jje=jj_end-1
     238
     239c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     240       do l=1,llm
     241        do j=jjb,jje
     242          do i=1,iip1
     243            teta(i,j,l)=teta(i,j,l)
     244     &                  -rdamp(l)*(teta(i,j,l)-tzon(j,l))
     245          enddo
     246       enddo
     247       enddo
     248c$OMP END DO NOWAIT
     249      endif ! of if (mode_top_bond.ge.3)
     250
    222251      END
Note: See TracChangeset for help on using the changeset viewer.