Ignore:
Timestamp:
2017-04-23T09:30:41+02:00 (3 years ago)
Author:
gm
Message:

#1880 (HPC-09): add zdfphy (the ZDF manager) + remove all key_…

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r7646 r7953  
    33MODULE agrif_opa_sponge 
    44   !!====================================================================== 
    5    !!                ***  MODULE agrif_opa_update  *** 
    6    !! AGRIF :    
     5   !!                   ***  MODULE  agrif_opa_interp  *** 
     6   !! AGRIF: interpolation package 
    77   !!====================================================================== 
    8    !! History :   
     8   !! History :  2.0  !  2002-06  (XXX)  Original cade 
     9   !!             -   !  2005-11  (XXX)  
     10   !!            3.2  !  2009-04  (R. Benshila)  
     11   !!            3.6  !  2014-09  (R. Benshila)  
    912   !!---------------------------------------------------------------------- 
    1013#if defined key_agrif 
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_agrif'                                              AGRIF zoom 
     16   !!---------------------------------------------------------------------- 
    1117   USE par_oce 
    1218   USE oce 
    1319   USE dom_oce 
     20   ! 
    1421   USE in_out_manager 
    1522   USE agrif_oce 
     
    2431 
    2532   !!---------------------------------------------------------------------- 
    26    !! NEMO/NST 3.7 , NEMO Consortium (2015) 
     33   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    2734   !! $Id$ 
    2835   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    3138 
    3239   SUBROUTINE Agrif_Sponge_Tra 
    33       !!--------------------------------------------- 
    34       !!   *** ROUTINE Agrif_Sponge_Tra *** 
    35       !!--------------------------------------------- 
    36       REAL(wp) :: timecoeff 
    37       !!--------------------------------------------- 
     40      !!---------------------------------------------------------------------- 
     41      !!                 *** ROUTINE Agrif_Sponge_Tra *** 
     42      !!---------------------------------------------------------------------- 
     43      REAL(wp) ::   timecoeff   ! local scalar 
     44      !!---------------------------------------------------------------------- 
    3845      ! 
    3946#if defined SPONGE 
    4047      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    41  
     48      ! 
    4249      CALL Agrif_Sponge 
    43       Agrif_SpecialValue=0. 
     50      Agrif_SpecialValue    = 0._wp 
    4451      Agrif_UseSpecialValue = .TRUE. 
    45       tabspongedone_tsn = .FALSE. 
    46  
     52      tabspongedone_tsn     = .FALSE. 
     53      ! 
    4754      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 
    48  
     55      ! 
    4956      Agrif_UseSpecialValue = .FALSE. 
    5057#endif 
     
    5461 
    5562   SUBROUTINE Agrif_Sponge_dyn 
    56       !!--------------------------------------------- 
    57       !!   *** ROUTINE Agrif_Sponge_dyn *** 
    58       !!--------------------------------------------- 
    59       REAL(wp) :: timecoeff 
    60       !!--------------------------------------------- 
    61  
     63      !!---------------------------------------------------------------------- 
     64      !!                 *** ROUTINE Agrif_Sponge_dyn *** 
     65      !!---------------------------------------------------------------------- 
     66      REAL(wp) ::   timecoeff   ! local scalar 
     67      !!---------------------------------------------------------------------- 
     68      ! 
    6269#if defined SPONGE 
    6370      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    64  
    65       Agrif_SpecialValue=0. 
     71      ! 
     72      Agrif_SpecialValue    = 0._wp 
    6673      Agrif_UseSpecialValue = ln_spc_dyn 
    67  
     74      ! 
    6875      tabspongedone_u = .FALSE. 
    6976      tabspongedone_v = .FALSE.          
    7077      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 
    71  
     78      ! 
    7279      tabspongedone_u = .FALSE. 
    7380      tabspongedone_v = .FALSE. 
    7481      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 
    75  
     82      ! 
    7683      Agrif_UseSpecialValue = .FALSE. 
    7784#endif 
     
    8188 
    8289   SUBROUTINE Agrif_Sponge 
    83       !!--------------------------------------------- 
    84       !!   *** ROUTINE  Agrif_Sponge *** 
    85       !!--------------------------------------------- 
     90      !!---------------------------------------------------------------------- 
     91      !!                 *** ROUTINE  Agrif_Sponge *** 
     92      !!---------------------------------------------------------------------- 
    8693      INTEGER  :: ji,jj,jk 
    8794      INTEGER  :: ispongearea, ilci, ilcj 
     
    8996      REAL(wp) :: z1spongearea, zramp 
    9097      REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 
    91  
     98      !!---------------------------------------------------------------------- 
     99      ! 
    92100#if defined SPONGE || defined SPONGE_TOP 
    93101      ll_spdone=.TRUE. 
     
    176184               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 
    177185               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) & 
    178                                                      &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
    179             END DO 
    180          END DO 
    181  
     186                  &                                     +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
     187            END DO 
     188         END DO 
     189         ! 
    182190         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions 
    183191         CALL lbc_lnk( fsahm_spf, 'F', 1. ) 
     
    192200 
    193201 
    194    SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
    195       !!--------------------------------------------- 
    196       !!   *** ROUTINE interptsn_sponge *** 
    197       !!--------------------------------------------- 
    198       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    199       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    200       LOGICAL, INTENT(in) :: before 
     202   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     203      !!---------------------------------------------------------------------- 
     204      !!                 *** ROUTINE interptsn_sponge *** 
     205      !!---------------------------------------------------------------------- 
     206      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     207      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
     208      LOGICAL                                     , INTENT(in   ) ::  before 
    201209      ! 
    202210      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    205213      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 
    206214      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
     215      !!---------------------------------------------------------------------- 
    207216      ! 
    208217      IF( before ) THEN 
     
    258267 
    259268 
    260    SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) 
    261       !!--------------------------------------------- 
    262       !!   *** ROUTINE interpun_sponge *** 
    263       !!---------------------------------------------     
    264       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    265       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    266       LOGICAL, INTENT(in) :: before 
    267  
     269   SUBROUTINE interpun_sponge( tabres, i1, i2, j1, j2, k1, k2, before ) 
     270      !!---------------------------------------------------------------------- 
     271      !!                 *** ROUTINE interpun_sponge *** 
     272      !!---------------------------------------------------------------------- 
     273      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     274      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   tabres 
     275      LOGICAL                               , INTENT(in   ) ::  before 
     276      !! 
    268277      INTEGER :: ji,jj,jk 
    269  
    270       ! sponge parameters  
     278      INTEGER :: jmax 
    271279      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    272280      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff 
    273281      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    274       INTEGER :: jmax 
    275       !!---------------------------------------------     
     282      !!---------------------------------------------------------------------- 
    276283      ! 
    277284      IF( before ) THEN 
     
    356363 
    357364 
    358    SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir) 
    359       !!--------------------------------------------- 
    360       !!   *** ROUTINE interpvn_sponge *** 
    361       !!---------------------------------------------  
    362       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    363       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    364       LOGICAL, INTENT(in) :: before 
    365       INTEGER, INTENT(in) :: nb , ndir 
    366       ! 
    367       INTEGER  ::   ji, jj, jk 
    368       REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr 
    369       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 
    370       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    371       INTEGER :: imax 
    372       !!---------------------------------------------  
     365   SUBROUTINE interpvn_sponge( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     366      !!---------------------------------------------------------------------- 
     367      !!                 *** ROUTINE interpvn_sponge *** 
     368      !!---------------------------------------------------------------------- 
     369      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     370      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   tabres 
     371      LOGICAL                               , INTENT(in   ) ::   before 
     372      INTEGER                               , INTENT(in   ) ::   nb , ndir 
     373      ! 
     374      INTEGER ::   ji, jj, jk 
     375      INTEGER ::   imax 
     376      REAL(wp)::   ze2u, ze1v, zua, zva, zbtr 
     377      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) ::   vbdiff, rotdiff, hdivdiff 
     378      !!---------------------------------------------------------------------- 
    373379 
    374380      IF( before ) THEN  
     
    403409         !                                                 
    404410 
    405          imax = i2-1 
     411         imax = i2 - 1 
    406412         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3) 
    407413 
     
    437443 
    438444#else 
     445   !!---------------------------------------------------------------------- 
     446   !!   Empty module                                          no AGRIF zoom 
     447   !!---------------------------------------------------------------------- 
    439448CONTAINS 
    440449   SUBROUTINE agrif_opa_sponge_empty 
    441       !!--------------------------------------------- 
    442       !!   *** ROUTINE agrif_OPA_sponge_empty *** 
    443       !!--------------------------------------------- 
     450      !!---------------------------------------------------------------------- 
     451      !!                 *** ROUTINE agrif_OPA_sponge_empty *** 
     452      !!---------------------------------------------------------------------- 
    444453      WRITE(*,*)  'agrif_opa_sponge : You should not have seen this print! error?' 
    445454   END SUBROUTINE agrif_opa_sponge_empty 
Note: See TracChangeset for help on using the changeset viewer.