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 13600 – NEMO

Changeset 13600


Ignore:
Timestamp:
2020-10-14T17:55:14+02:00 (4 years ago)
Author:
techene
Message:

#2385 adapted for SWE: clean unnecessary USE, remove unwanted features (AGRIF, coupling,...), add constants

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/SWE/nemogcm.F90

    r12983 r13600  
    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, "OPA") ! 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  
Note: See TracChangeset for help on using the changeset viewer.