New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14053 for NEMO/trunk/src/SWE – NEMO

Changeset 14053 for NEMO/trunk/src/SWE


Ignore:
Timestamp:
2020-12-03T14:48:38+01:00 (3 years ago)
Author:
techene
Message:

#2385 added to the trunk

Location:
NEMO/trunk/src/SWE
Files:
17 deleted
3 edited
4 copied

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/SWE/domzgr_substitute.h90

    r12983 r14053  
    1616#   define  e3v(i,j,k,t)   (e3v_0(i,j,k)*(1._wp+r3v(i,j,t))) 
    1717#   define  e3f(i,j,k)     (e3f_0(i,j,k)*(1._wp+r3f(i,j))) 
     18#   define  e3f_vor(i,j,k) (e3f_0vor(i,j,k)*(1._wp+r3f(i,j))) 
    1819#   define  e3w(i,j,k,t)   (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 
    1920#   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 
  • NEMO/trunk/src/SWE/nemogcm.F90

    r13970 r14053  
    44   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice) 
    55   !!====================================================================== 
    6    !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
    7    !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    8    !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
    10    !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    11    !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
    12    !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    13    !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    14    !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    15    !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  sea-ice model 
    16    !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
    17    !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    18    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
    19    !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
    20    !!             -   ! 2004-08  (C. Talandier) New trends organization 
    21    !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility 
    22    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    23    !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation 
    24    !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization 
    25    !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    26    !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
    27    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    28    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    29    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
    32    !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
    33    !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     6   !! History :  4.0  !  2020-05  (A. Nasser, G. Madec)  Original code from 4.0.2 
     7   !!             -   !  2020-10  (S. Techene, G. Madec)  cleanning 
    348   !!---------------------------------------------------------------------- 
    359 
     
    4216   !!---------------------------------------------------------------------- 
    4317   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     18   ! 
    4419   USE phycst         ! physical constant                  (par_cst routine) 
    4520   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
    46    USE closea         ! treatment of closed seas (for ln_closea) 
    4721   USE usrdef_nam     ! user defined configuration 
    48    USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdy_oce,  ONLY : ln_bdy 
    5022   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    5123   USE istate         ! initial state setting          (istate_init routine) 
    52    USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine) 
    53    USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    54    USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    55    USE asminc         ! assimilation increments      
    56    USE asmbkg         ! writing out state trajectory 
    57    USE diaptr         ! poleward transports           (dia_ptr_init routine) 
    58    USE diadct         ! sections transports           (dia_dct_init routine) 
    59    USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    60    USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    61    USE diamlr         ! IOM context management for multiple-linear-regression analysis 
     24   USE trd_oce , ONLY : l_trddyn         ! dynamical trend logical 
    6225#if defined key_RK3 
    63    USE stpRK3 
    64 #elif defined key_qco 
    65    USE stpLF 
     26   USE stprk3         ! NEMO time-stepping               (stp_RK3   routine) 
    6627#else 
    67    USE step           ! NEMO time-stepping                 (stp     routine) 
    68 #endif 
    69    USE isfstp         ! ice shelf                     (isf_stp_init routine) 
    70    USE icbini         ! handle bergs, initialisation 
    71    USE icbstp         ! handle bergs, calving, themodynamics and transport 
    72    USE cpl_oasis3     ! OASIS3 coupling 
    73    USE c1d            ! 1D configuration 
    74    USE step_c1d       ! Time stepping loop for the 1D configuration 
    75    USE dyndmp         ! Momentum damping 
    76    USE stopar         ! Stochastic param.: ??? 
    77    USE stopts         ! Stochastic param.: ??? 
    78    USE diu_layers     ! diurnal bulk SST and coolskin 
    79    USE crsini         ! initialise grid coarsening utility 
    80    USE dia25h         ! 25h mean output 
    81    USE diadetide      ! Weights computation for daily detiding of model diagnostics 
    82    USE sbc_oce , ONLY : lk_oasis 
    83    USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
    84 #if defined key_top 
    85    USE trcini         ! passive tracer initialisation 
    86 #endif 
    87 #if defined key_nemocice_decomp 
    88    USE ice_domain_size, only: nx_global, ny_global 
     28   USE stpmlf         ! NEMO time-stepping               (stp_MLF   routine) 
    8929#endif 
    9030   ! 
    9131   USE lib_mpp        ! distributed memory computing 
    9232   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    93    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     33   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    9434   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    95 #if defined key_iomput 
    96    USE xios           ! xIOserver 
    97 #endif 
    98 #if defined key_agrif 
    99    USE agrif_all_update   ! Master Agrif update 
    100 #endif 
     35   USE halo_mng       ! Halo manager 
    10136 
    10237   IMPLICIT NONE 
     
    13974      !!---------------------------------------------------------------------- 
    14075      ! 
    141 #if defined key_agrif 
    142       CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    143 #endif 
    14476      !                            !-----------------------! 
    14577      CALL nemo_init               !==  Initialisations  ==! 
    14678      !                            !-----------------------! 
    147        
    148 #if defined key_agrif 
    149       Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    150       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    151       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    152 # if defined key_top 
    153       CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    154 # endif 
    155 # if defined key_si3 
    156       CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice 
    157 # endif 
    158 #endif 
    15979      ! check that all process are still there... If some process have an error, 
    16080      ! they will never enter in step and other processes will wait until the end of the cpu time! 
     81      ! 
     82      !                                 ! SWE case: only with key_qco 
     83#if ! defined key_qco   
     84      CALL ctl_stop( 'nemo_gcm (SWE): shallow water model requires key_qco' ) 
     85#endif 
     86      ! 
    16187      CALL mpp_max( 'nemogcm', nstop ) 
    16288 
     
    174100      ! 
    175101      DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    176  
     102         ! 
    177103         ncom_stp = istp 
    178104         IF( ln_timing ) THEN 
     
    181107            IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time 
    182108         ENDIF 
     109         !  
    183110#if defined key_RK3 
    184111         CALL stp_RK3    ( istp ) 
    185 #elif defined key_qco 
    186          CALL stp_LF     ( istp ) 
    187112#else 
    188          CALL stp        ( istp ) 
     113         CALL stp_MLF     ( istp ) 
    189114#endif 
    190115         istp = istp + 1 
    191  
     116         ! 
    192117         IF( lwp .AND. ln_timing )   WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 
    193  
     118         ! 
    194119      END DO 
    195120      ! 
     
    232157      INTEGER ::   ios, ilocal_comm   ! local integers 
    233158      !! 
    234       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    235          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    236          &             ln_timing, ln_diacfl 
     159      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, nn_isplt, nn_jsplt , nn_ictls,   & 
     160         &                                             nn_ictle, nn_jctls , nn_jctle 
    237161      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    238162      !!---------------------------------------------------------------------- 
     
    246170      ! 
    247171#if defined key_iomput 
    248       IF( Agrif_Root() ) THEN 
    249          IF( lk_oasis ) THEN 
    250             CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
    251             CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios 
    252          ELSE 
    253             CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    254          ENDIF 
    255       ENDIF 
     172      CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    256173      CALL mpp_start( ilocal_comm ) 
    257174#else 
    258       IF( lk_oasis ) THEN 
    259          IF( Agrif_Root() ) THEN 
    260             CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
    261          ENDIF 
    262          CALL mpp_start( ilocal_comm ) 
    263       ELSE 
    264          CALL mpp_start( ) 
    265       ENDIF 
     175      CALL mpp_start( ) 
    266176#endif 
    267177      ! 
     
    292202      ! 
    293203      ! finalize the definition of namctl variables 
    294       IF( sn_cfctl%l_allon ) THEN 
    295          ! Turn on all options. 
    296          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    297          ! Ensure all processors are active 
    298          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    299       ELSEIF( sn_cfctl%l_config ) THEN 
    300          ! Activate finer control of report outputs 
    301          ! optionally switch off output from selected areas (note this only 
    302          ! applies to output which does not involve global communications) 
    303          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    304            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    305            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    306       ELSE 
    307          ! turn off all options. 
    308          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    309       ENDIF 
     204      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     205         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    310206      ! 
    311207      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    336232         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    337233         WRITE(numout,*) 
     234          
     235         ! Print the working precision to ocean.output 
     236         IF (wp == dp) THEN 
     237            WRITE(numout,*) "Working precision = double-precision" 
     238         ELSE 
     239            WRITE(numout,*) "Working precision = single-precision" 
     240         ENDIF 
     241         WRITE(numout,*) 
    338242         ! 
    339243         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     
    353257      ! 
    354258      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    355          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     259         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    356260      ELSE                              ! user-defined namelist 
    357          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     261         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    358262      ENDIF 
    359263      ! 
     
    365269      CALL mpp_init 
    366270 
     271      CALL halo_mng_init() 
    367272      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    368273      CALL nemo_alloc() 
    369274 
    370275      ! Initialise time level indices 
    371       Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    372  
     276      Nbb = 1   ;   Nnn = 2   ;   Naa = 3   ;  Nrhs = Naa 
     277       
    373278      !                             !-------------------------------! 
    374279      !                             !  NEMO general initialization  ! 
     
    382287      ! 
    383288                           CALL     phy_cst         ! Physical constants 
    384                             
     289      ! 
     290      !                                             ! SWE: Set rho0 and associated variables (eosbn2 not used) 
     291                           rho0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     292                           rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
     293                           rho0_rcp    = rho0 * rcp  
     294                           r1_rho0     = 1._wp / rho0 
     295                           r1_rcp      = 1._wp / rcp 
     296                           r1_rho0_rcp = 1._wp / rho0_rcp  
     297      ! 
    385298                           CALL     dom_init( Nbb, Nnn, Naa ) ! Domain 
    386299 
     
    391304 
    392305      !                                      ! external forcing  
    393                            CALL    tide_init                     ! tidal harmonics 
    394  
    395306                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    396                             
    397307 
    398308      !                                      ! Ocean physics                                     
     
    400310                           CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    401311                            
    402                             
    403312      !                                      ! Dynamics 
    404313                           CALL dyn_adv_init         ! advection (vector or flux form) 
    405  
    406314                           CALL dyn_vor_init         ! vorticity term including Coriolis 
    407  
    408315                           CALL dyn_ldf_init         ! lateral mixing 
    409316 
    410                            CALL dyn_spg_init         ! surface pressure gradient 
    411  
    412317      !                                      ! Diagnostics 
    413                            CALL     flo_init( Nnn )    ! drifting Floats 
    414                             
    415318      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics 
    416  
    417                            CALL     trd_init( Nnn )    ! Mixed-layer/Vorticity/Integral constraints trends 
    418  
     319      !                                         ! Trends diag: switched off 
     320                           l_trddyn = .FALSE.        ! No trend diagnostics 
    419321 
    420322      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
     
    422324      IF( ln_timing    )   CALL timing_stop( 'nemo_init') 
    423325      ! 
    424  
    425326   END SUBROUTINE nemo_init 
    426327 
     
    440341         WRITE(numout,*) '~~~~~~~~' 
    441342         WRITE(numout,*) '   Namelist namctl' 
    442          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    443          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    444          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    445343         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    446344         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    454352         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    455353         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    456          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    457          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    458          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    459          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    460          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    461          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    462          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    463354         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    464355         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    465356      ENDIF 
    466357      ! 
    467       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    468       nictls    = nn_ictls 
    469       nictle    = nn_ictle 
    470       njctls    = nn_jctls 
    471       njctle    = nn_jctle 
    472       isplt     = nn_isplt 
    473       jsplt     = nn_jsplt 
    474  
     358      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    475359      IF(lwp) THEN                  ! control print 
    476360         WRITE(numout,*) 
     
    482366         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    483367         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    484       ENDIF 
    485       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    486       ! 
    487       !                             ! Parameter control 
    488       ! 
    489       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    490          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    491             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    492          ELSE 
    493             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    494                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    495                   &           ' - the print control will be done over the whole domain' ) 
    496             ENDIF 
    497             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    498          ENDIF 
    499          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    500          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    501          ! 
    502          !                              ! indices used for the SUM control 
    503          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    504             lsp_area = .FALSE. 
    505          ELSE                                             ! print control done over a specific  area 
    506             lsp_area = .TRUE. 
    507             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    508                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    509                nictls = 1 
    510             ENDIF 
    511             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    512                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    513                nictle = jpiglo 
    514             ENDIF 
    515             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    516                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    517                njctls = 1 
    518             ENDIF 
    519             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    520                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    521                njctle = jpjglo 
    522             ENDIF 
    523          ENDIF 
    524368      ENDIF 
    525369      ! 
     
    571415      USE diawri    , ONLY : dia_wri_alloc 
    572416      USE dom_oce   , ONLY : dom_oce_alloc 
    573       USE trc_oce   , ONLY : trc_oce_alloc 
    574       USE bdy_oce   , ONLY : bdy_oce_alloc 
    575417      ! 
    576418      INTEGER :: ierr 
    577419      !!---------------------------------------------------------------------- 
    578420      ! 
    579       ierr =        oce_alloc    ()    ! ocean  
     421      ierr =        oce_SWE_alloc()    ! ocean  
    580422      ierr = ierr + dia_wri_alloc() 
    581423      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    582424      ierr = ierr + zdf_oce_alloc()    ! ocean vertical physics 
    583       ierr = ierr + trc_oce_alloc()    ! shared TRC / TRA arrays 
    584       ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization) 
    585425      ! 
    586426      CALL mpp_sum( 'nemogcm', ierr ) 
     
    590430 
    591431    
    592    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     432   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    593433      !!---------------------------------------------------------------------- 
    594434      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    595435      !! 
    596436      !! ** Purpose :   Set elements of the output control structure to setto. 
    597       !!                for_all should be .false. unless all areas are to be 
    598       !!                treated identically. 
    599437      !! 
    600438      !! ** Method  :   Note this routine can be used to switch on/off some 
    601       !!                types of output for selected areas but any output types 
    602       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    603       !!                should be protected from selective switching by the 
    604       !!                for_all argument 
    605       !!---------------------------------------------------------------------- 
    606       LOGICAL :: setto, for_all 
    607       TYPE(sn_ctl) :: sn_cfctl 
    608       !!---------------------------------------------------------------------- 
    609       IF( for_all ) THEN 
    610          sn_cfctl%l_runstat = setto 
    611          sn_cfctl%l_trcstat = setto 
    612       ENDIF 
     439      !!                types of output for selected areas. 
     440      !!---------------------------------------------------------------------- 
     441      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     442      LOGICAL     , INTENT(in   ) :: setto 
     443      !!---------------------------------------------------------------------- 
     444      sn_cfctl%l_runstat = setto 
     445      sn_cfctl%l_trcstat = setto 
    613446      sn_cfctl%l_oceout  = setto 
    614447      sn_cfctl%l_layout  = setto 
     
    620453   !!====================================================================== 
    621454END MODULE nemogcm 
    622  
  • NEMO/trunk/src/SWE/stpctl.F90

    r13458 r14053  
    33   !!                       ***  MODULE  stpctl  *** 
    44   !! Ocean run control :  gross check of the ocean time stepping 
     5   !!              *** Shallow Water Equation (SWE) case *** 
     6   !!               ( No test on temperature and salinity ) 
    57   !!====================================================================== 
    6    !! History :  OPA  ! 1991-03  (G. Madec) Original code 
    7    !!            6.0  ! 1992-06  (M. Imbard) 
    8    !!            8.0  ! 1997-06  (A.M. Treguier) 
    9    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    10    !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting 
    11    !!            3.7  ! 2016-09  (G. Madec)  Remove solver 
    12    !!            4.0  ! 2017-04  (G. Madec)  regroup global communications 
     8   !! History :  SWE  ! 2020-09  (A. Nasser, S. Techene ) OCE/stpctl adaptated to SWE 
    139   !!---------------------------------------------------------------------- 
    1410 
     
    2117   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    2218   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    23    !   
     19   ! 
    2420   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    2521   USE in_out_manager  ! I/O manager 
    2622   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2723   USE lib_mpp         ! distributed memory computing 
    28    ! 
    2924   USE netcdf          ! NetCDF library 
     25 
    3026   IMPLICIT NONE 
    3127   PRIVATE 
     
    3531   INTEGER                ::   nrunid   ! netcdf file id 
    3632   INTEGER, DIMENSION(2)  ::   nvarid   ! netcdf variable id 
     33 
     34#  include "domzgr_substitute.h90" 
    3735   !!---------------------------------------------------------------------- 
    3836   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4947      !! 
    5048      !! ** Method  : - Save the time step in numstp 
     49      !!              - Print it each 50 time steps 
    5150      !!              - Stop the run IF problem encountered by setting nstop > 0 
    52       !!                Problems checked: negative sea surface height  
     51      !!                Problems checked: e3t0+ssh minimum smaller that 0 
    5352      !!                                  |U|   maximum larger than 10 m/s  
     53      !!                                  ( not for SWE : negative sea surface salinity ) 
    5454      !! 
    5555      !! ** Actions :   "time.step" file = last ocean time-step 
     
    6363      INTEGER                         ::   idtime, istatus 
    6464      INTEGER , DIMENSION(3)          ::   iareasum, iareamin, iareamax 
    65       INTEGER , DIMENSION(3,2)        ::   iloc                                  ! min/max loc indices 
     65      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
    6666      REAL(wp)                        ::   zzz                                   ! local real  
    6767      REAL(wp), DIMENSION(3)          ::   zmax, zmaxlocal 
     
    7070      CHARACTER(len=20)               ::   clname 
    7171      !!---------------------------------------------------------------------- 
     72      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     73      ! 
    7274      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
    7375      ! 
     
    109111      !                                   !==            test of local extrema           ==! 
    110112      !                                   !==  done by all processes at every time step  ==! 
    111       ! 
    112       llmsk(   1:Nis1,:,:) = .FALSE.                                              ! exclude halos from the checked region 
    113       llmsk(Nie1: jpi,:,:) = .FALSE. 
    114       llmsk(:,   1:Njs1,:) = .FALSE. 
    115       llmsk(:,Nje1: jpj,:) = .FALSE. 
    116       ! 
     113      zmax(1) = MINVAL( e3t_0(:,:,1)+ssh(:,:,Kmm)  )                              ! e3t_Kmm min 
     114      llmsk(:,:,:) = umask(:,:,:) == 1._wp 
     115      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk )                     ! velocity max (zonal only) 
     116      zmax(3) = REAL( nstop , wp )                                            ! stop indicator 
     117      !                                   !==               get global extrema             ==! 
     118      !                                   !==  done by all processes if writting run.stat  ==! 
    117119      llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
    118120      zmax(1) = MAXVAL(     -e3t(:,:,1,Kmm) ), mask = llmsk(:,:,1) )      ! ssh max 
     
    131133      IF( ll_wrtruns ) THEN 
    132134         WRITE(numrun,9500) kt, zmax(1), zmax(2) 
    133          istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ -zmax(1)/), (/kt/), (/1/) ) 
    134          istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/  zmax(2)/), (/kt/), (/1/) ) 
     135         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     136         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
    135137         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    136       END IF 
     138      ENDIF 
    137139      !                                   !==               error handling               ==! 
    138140      !                                   !==  done by all processes at every time step  ==! 
    139141      ! 
    140       IF(   zmax(1) >  0._wp           .OR.   &               ! negative sea surface height  
    141          &  zmax(2) > 10._wp           .OR.   &               ! too large velocity ( > 10 m/s) 
     142!!SWE specific : start 
     143      IF(   zmax(1) <=   0._wp .OR.           &               ! negative e3t_Kmm 
     144         &  zmax(2) >   10._wp .OR.           &               ! too large velocity ( > 10 m/s) 
    142145         &  ISNAN( zmax(1) + zmax(2) ) .OR.   &               ! NaN encounter in the tests 
    143146         &  ABS(   zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     
    148151            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
    149152            ! get global loc on the min/max 
    150             llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
    151             CALL mpp_maxloc( 'stpctl',   -e3t(:,:,1,Kmm) , llmsk(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
    152             llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
    153             CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) ) 
     153            CALL mpp_minloc( 'stpctl', e3t_0(:,:,1) + ssh(:,:,Kmm), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     154            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,Kmm))        ,  umask(:,:,:), zzz, iloc(1:3,2) ) 
    154155            ! find which subdomain has the max. 
    155156            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     
    164165         ELSE                    ! find local min and max locations: 
    165166            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
    166             llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp         ! define only the inner domain 
    167             iloc(1:2,1) = MAXLOC(   -e3t(:,:,1,Kmm) , mask = llmsk(:,:,1) ) 
    168             llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp        ! define only the inner domain 
    169             iloc(1:3,2) = MAXLOC( ABS(uu(:,:,:,Kmm)), mask = llmsk(:,:,:) ) 
    170             DO ji = 1, 2   ! local domain indices ==> global domain indices, excluding halos 
    171                iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
    172             END DO 
     167            iloc(1:2,1) = MINLOC( e3t_0(:,:,1) + ssh(:,:,Kmm), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /) 
     168            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    173169            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
    174170         ENDIF 
    175171         ! 
    176          WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    177          CALL wrt_line( ctmp2, kt, '|e3t| min', -zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
    178          CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     172         WRITE(ctmp1,*) ' stp_ctl:  e3t0+ssh < 0 m  or  |U| > 10 m/s  or  NaN encounter in the tests' 
     173         CALL wrt_line( ctmp2, kt, 'e3t0+ssh min',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     174         CALL wrt_line( ctmp3, kt, '|U|   max'   ,  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
    179175         IF( Agrif_Root() ) THEN 
    180176            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
     
    194190         ! 
    195191      ENDIF 
     192!!SWE specific : end 
    196193      ! 
    197194      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     
    200197      ENDIF 
    201198      ! 
    202 9500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
     1999500  FORMAT(' it :', i8, '      e3t_min: ', D23.16, ' |U|_max: ', D23.16) 
    203200      ! 
    204201   END SUBROUTINE stp_ctl 
Note: See TracChangeset for help on using the changeset viewer.