Changeset 9213

Timestamp:

2018-01-12T10:38:50+01:00 (6 years ago)

Author:

gm

Message:

dev_merge_2017: nemogcm.F90 : updated in SAS & OFF + data assimilation initial calls (asm_bkg_wri , tra_asm_inc ...) moved to asm_inc_init + closed sea : restructure namcfg & its control print + set ln_closea = false if domcfg file not read (ln_domcfg=F

Location:

branches/2017/dev_merge_2017/NEMOGCM

Files:

• CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg (modified) (3 diffs)
• CONFIG/SHARED/namelist_ref (modified) (2 diffs)
• NEMO/OFF_SRC/nemogcm.F90 (modified) (28 diffs)
• NEMO/OPA_SRC/ASM/asminc.F90 (modified) (14 diffs)
• NEMO/OPA_SRC/nemogcm.F90 (modified) (20 diffs)
• NEMO/OPA_SRC/step_oce.F90 (modified) (2 diffs)
• NEMO/SAS_SRC/nemogcm.F90 (modified) (28 diffs)

branches/2017/dev_merge_2017/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg

@@ -16 +16 @@
       !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
       cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename
-      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
-   ln_closea    = .false.  !  T => keep closed seas (defined by closea_mask field) in the domain and apply
-      !                    !       special treatment of freshwater fluxes.
-      !                    !  F => suppress closed seas (defined by closea_mask field) from the bathymetry
-      !                    !       at runtime.
-      !                    !  If there is no closea_mask field in the domain_cfg file or we do not use
-      !                    !  a domain_cfg file then this logical does nothing.
+      !
+      ln_closea    = .false.    !  T => keep closed seas (defined by closea_mask field) in the  
+      !                         !       domain and apply special treatment of freshwater fluxes.
+      !                         !  F => suppress closed seas (defined by closea_mask field) 
+      !                         !       from the bathymetry at runtime.
+      !                         !  If closea_mask field doesn't exist in the domain_cfg file
+      !                         !       then this logical does nothing.
 /
 !-----------------------------------------------------------------------
@@ -28 +28 @@
 !-----------------------------------------------------------------------
    ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   rn_rdt      = 5760.     !  time step for the dynamics and tracer
+   rn_atfp     =    0.1    !  asselin time filter parameter
 /
 !-----------------------------------------------------------------------
@@ -299 +301 @@
 /
 !-----------------------------------------------------------------------
-&namctl        !   Control prints & Benchmark
-!-----------------------------------------------------------------------
+&namctl        !   Control prints 
+!-----------------------------------------------------------------------
+   ln_ctl      = .false.   !  trends control print (expensive!)
+   nn_print    =    0      !  level of print (0 no extra print)
+   ln_timing   = .false.   !  timing by routine write out in timing.output file
+   ln_diacfl   = .false.   !  CFL diagnostics write out in cfl_diagnostics.ascii
 /
 !-----------------------------------------------------------------------

branches/2017/dev_merge_2017/NEMOGCM/CONFIG/SHARED/namelist_ref

@@ -74 +74 @@
    ln_read_cfg = .false.   !  (=T) read the domain configuration file
       !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
-      cn_domcfg = "domain_cfg"         ! domain configuration filename
+      cn_domcfg = "domain_cfg"  ! domain configuration filename
       !
+      ln_closea    = .false.    !  T => keep closed seas (defined by closea_mask field) in the  
+      !                         !       domain and apply special treatment of freshwater fluxes.
+      !                         !  F => suppress closed seas (defined by closea_mask field) 
+      !                         !       from the bathymetry at runtime.
+      !                         !  If closea_mask field doesn't exist in the domain_cfg file
+      !                         !       then this logical does nothing.
    ln_write_cfg= .false.   !  (=T) create the domain configuration file
       cn_domcfg_out = "domain_cfg_out" ! newly created domain configuration filename
@@ -81 +87 @@
    ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present
    !                       !  in netcdf input files, as the start j-row for reading
-   ln_closea    = .true.   !  T => keep closed seas (defined by closea_mask field) in the domain and apply
-      !                    !       special treatment of freshwater fluxes.
-      !                    !  F => suppress closed seas (defined by closea_mask field) from the bathymetry
-      !                    !       at runtime.
-      !                    !  If there is no closea_mask field in the domain_cfg file or we do not use
-      !                    !  a domain_cfg file then this logical does nothing.
 /
 !-----------------------------------------------------------------------

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

@@ -10 +10 @@
 
    !!----------------------------------------------------------------------
-   !!   nemo_gcm        : off-line: solve ocean tracer only
-   !!   nemo_init       : initialization of the nemo model
-   !!   nemo_ctl        : initialisation of algorithm flag 
-   !!   nemo_closefile  : close remaining files
+   !!   nemo_gcm      : off-line: solve ocean tracer only
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
+   !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
+   !!   istate_init   : simple initialization to zero of ocean fields
+   !!   stp_ctl       : reduced step control (no dynamics in off-line)
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space domain variables
-   USE oce             ! dynamics and tracers variables
-   USE trc_oce         ! Shared ocean/passive tracers variables
-   USE c1d             ! 1D configuration
-   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine)
-   USE usrdef_nam      ! user defined configuration
-   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE dom_oce        ! ocean space domain variables
+   USE oce            ! dynamics and tracers variables
+   USE trc_oce        ! Shared ocean/passive tracers variables
+   USE c1d            ! 1D configuration
+   USE domain         ! domain initialization from coordinate & bathymetry (dom_init routine)
+   USE closea         ! treatment of closed seas (for ln_closea)
+   USE usrdef_nam     ! user defined configuration
+   USE eosbn2         ! equation of state            (eos bn2 routine)
    !              ! ocean physics
-   USE ldftra          ! lateral diffusivity setting    (ldf_tra_init routine)
-   USE ldfslp          ! slopes of neutral surfaces     (ldf_slp_init routine)
-   USE traqsr          ! solar radiation penetration    (tra_qsr_init routine)
-   USE trabbl          ! bottom boundary layer          (tra_bbl_init routine)
-   USE traldf          ! lateral physics                (tra_ldf_init routine)
-   USE sbcmod          ! surface boundary condition     (sbc_init     routine)
-   USE phycst          ! physical constant                   (par_cst routine)
-   USE dtadyn          ! Lecture and Interpolation of the dynamical fields
-   USE trcini          ! Initilization of the passive tracers
-   USE daymod          ! calendar                            (day     routine)
-   USE trcstp          ! passive tracer time-stepping        (trc_stp routine)
-   USE dtadyn          ! Lecture and interpolation of the dynamical fields
+   USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine)
+   USE ldfslp         ! slopes of neutral surfaces     (ldf_slp_init routine)
+   USE traqsr         ! solar radiation penetration    (tra_qsr_init routine)
+   USE trabbl         ! bottom boundary layer          (tra_bbl_init routine)
+   USE traldf         ! lateral physics                (tra_ldf_init routine)
+   USE sbcmod         ! surface boundary condition     (sbc_init     routine)
+   USE phycst         ! physical constant                   (par_cst routine)
+   USE dtadyn         ! Lecture and Interpolation of the dynamical fields
+   USE trcini         ! Initilization of the passive tracers
+   USE daymod         ! calendar                            (day     routine)
+   USE trcstp         ! passive tracer time-stepping        (trc_stp routine)
+   USE dtadyn         ! Lecture and interpolation of the dynamical fields
    !              ! Passive tracers needs
-   USE trc             ! passive tracer : variables
-   USE trcnam          ! passive tracer : namelist
-   USE trcrst          ! passive tracer restart
-   USE diaptr          ! Need to initialise this as some variables are used in if statements later
-   USE sbc_oce  , ONLY : ln_rnf
-   USE sbcrnf          ! surface boundary condition : runoffs
+   USE trc            ! passive tracer : variables
+   USE trcnam         ! passive tracer : namelist
+   USE trcrst         ! passive tracer restart
+   USE diaptr         ! Need to initialise this as some variables are used in if statements later
+   USE sbc_oce , ONLY : ln_rnf
+   USE sbcrnf         ! surface boundary condition : runoffs
    !              ! I/O & MPP
-   USE iom             ! I/O library
-   USE in_out_manager  ! I/O manager
-   USE mppini          ! shared/distributed memory setting (mpp_init routine)
-   USE lib_mpp         ! distributed memory computing
+   USE iom            ! I/O library
+   USE in_out_manager ! I/O manager
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE lib_mpp        ! distributed memory computing
 #if defined key_iomput
-   USE xios
+   USE xios           ! xIOserver
 #endif 
-   USE prtctl          ! Print control                    (prt_ctl_init routine)
-   USE timing          ! Timing
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
-
-
+   USE prtctl         ! Print control                    (prt_ctl_init routine)
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges
 
    IMPLICIT NONE
@@ -65 +71 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! NEMO/OFF 4.0 , NEMO Consortium (2018)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -75 +81 @@
       !!                     ***  ROUTINE nemo_gcm  ***
       !!
-      !! ** Purpose :   nemo solves the primitive equations on an orthogonal
-      !!      curvilinear mesh on the sphere.
+      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
+      !!              curvilinear mesh on the sphere.
       !!
       !! ** Method  : - model general initialization
@@ -99 +105 @@
       istp = nit000
       !
-      ! Initialize arrays of runoffs structures and read data from the namelist
-      IF ( ln_rnf ) CALL sbc_rnf(istp)
+      IF( ln_rnf )   CALL sbc_rnf(istp)   ! runoffs initialization 
       ! 
-      CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      CALL iom_init( cxios_context )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
       ! 
-      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping
+      DO WHILE ( istp <= nitend .AND. nstop == 0 )    !==  OFF time-stepping  ==!
          !
          IF( istp /= nit000 )   CALL day        ( istp )         ! Calendar (day was already called at nit000 in day_init)
@@ -114 +119 @@
                                 CALL stp_ctl    ( istp, indic )  ! Time loop: control and print
          istp = istp + 1
-         IF( lk_mpp )   CALL mpp_max( nstop )
       END DO
+      !
 #if defined key_iomput
       CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
@@ -127 +132 @@
       IF( nstop /= 0 .AND. lwp ) THEN                 ! error print
          WRITE(numout,cform_err)
-         WRITE(numout,*) nstop, ' error have been found'
+         WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
+         WRITE(numout,*)
       ENDIF
       !
@@ -134 +140 @@
       CALL nemo_closefile
       !
-# if defined key_iomput
-      CALL xios_finalize             ! end mpp communications
-# else
-      IF( lk_mpp )   CALL mppstop       ! end mpp communications
-# endif
+#if defined key_iomput
+                     CALL xios_finalize   ! end mpp communications with xios
+#else
+      IF( lk_mpp )   CALL mppstop         ! end mpp communications
+#endif
       !
    END SUBROUTINE nemo_gcm
@@ -145 +151 @@
    SUBROUTINE nemo_init
       !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE nemo_init ***
+      !!                     ***  ROUTINE nemo_init  ***
       !!
       !! ** Purpose :   initialization of the nemo model in off-line mode
       !!----------------------------------------------------------------------
       INTEGER  ::   ji                 ! dummy loop indices
-      INTEGER  ::   ilocal_comm        ! local integer
-      INTEGER  ::   ios, inum          ! local integers
-      INTEGER  ::   iiarea, ijarea     ! local integers
-      INTEGER  ::   iirest, ijrest     ! local integers
-      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   ! local scalars
+      INTEGER  ::   ios, ilocal_comm   ! local integers
+      INTEGER  ::   iiarea, ijarea     !   -       -
+      INTEGER  ::   iirest, ijrest     !   -       -
       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
       !!
-      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
-         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
+      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   &
          &             ln_timing, ln_diacfl
-
-      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr
-      !!----------------------------------------------------------------------
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
       cltxt  = ''
       cltxt2 = ''
@@ -172 +176 @@
       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
       !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
-      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
-
-      !
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
-      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
 
-
       !                             !--------------------------!
       !                             !  Set global domain size  !   (control print return in cltxt2)
-      !
+      !                             !--------------------------!
       IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
          CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
@@ -198 +200 @@
       ENDIF
       !
-      !
-      l_offline = .true.            !  passive tracers are run offline
+      l_offline = .true.                  ! passive tracers are run offline
       !
       !                             !--------------------------------------------!
@@ -219 +220 @@
       lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
 
-      IF(lwm) THEN
-         ! write merged namelists from earlier to output namelist now that the
-         ! file has been opened in call to mynode. nammpp has already been
-         ! written in mynode (if lk_mpp_mpi)
+      IF(lwm) THEN               ! write merged namelists from earlier to output namelist 
+         !                       ! now that the file has been opened in call to mynode. 
+         !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)
          WRITE( numond, namctl )
          WRITE( numond, namcfg )
          IF( .NOT.ln_read_cfg ) THEN
             DO ji = 1, SIZE(clnam)
-               IF( TRIM(clnam (ji)) /= '' )   WRITE(numond, * ) clnam(ji)    ! namusr_def print
+               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print
             END DO
          ENDIF
@@ -234 +234 @@
       ! If dimensions of processor grid weren't specified in the namelist file 
       ! then we calculate them here now that we have our communicator size
-      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+      IF( jpni < 1  .OR.  jpnj < 1 ) THEN
 #if   defined key_mpp_mpi
-         CALL nemo_partition(mppsize)
+         CALL nemo_partition( mppsize )
 #else
-         jpni = 1
-         jpnj = 1
+         jpni  = 1
+         jpnj  = 1
          jpnij = jpni*jpnj
 #endif
-      END IF
+      ENDIF
 
       iiarea = 1 + MOD( narea - 1 , jpni )
@@ -279 +279 @@
          WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
          WRITE(numout,*) '                       NEMO team'
-         WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.6  (2015) '
-         WRITE(numout,*)
-         WRITE(numout,*)
-         DO ji = 1, SIZE(cltxt) 
-            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         WRITE(numout,*) '                   Off-line TOP Model'
+         WRITE(numout,*) '                NEMO version 4.0  (2017) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt)
+            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode
          END DO
-         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
-         !
-      ENDIF
-
-      ! Now we know the dimensions of the grid and numout has been set we can 
-      ! allocate arrays
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt2)
+            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size
+         END DO
+         !
+         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
       CALL nemo_alloc()
 
-      !                             !--------------------------------!
-      !                             !  Model general initialization  !
-      !                             !--------------------------------!
-
-      CALL nemo_ctl                           ! Control prints & Benchmark
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints
 
       !                                      ! Domain decomposition
-      CALL mpp_init
-      !
+      CALL mpp_init                             ! MPP
+      IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists
+      !
+      !                                      ! General initialization
       IF( ln_timing    )   CALL timing_init
-      !
-
-      !                                      ! General initialization
       IF( ln_timing    )   CALL timing_start( 'nemo_init')
       !
-                           CALL     phy_cst    ! Physical constants
-                           CALL     eos_init   ! Equation of state
-      IF( lk_c1d       )   CALL     c1d_init   ! 1D column configuration
-
-                           CALL     dom_init   ! Domain
-
-                           CALL  istate_init   ! ocean initial state (Dynamics and tracers)
-
-      IF( ln_nnogather )   CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
-
-      IF( ln_ctl       )   CALL prt_ctl_init   ! Print control
-
-                           CALL     sbc_init   ! Forcings : surface module
-
-                           CALL ldf_tra_init   ! Lateral ocean tracer physics
-                           CALL ldf_eiv_init   ! Eddy induced velocity param
-                           CALL tra_ldf_init   ! lateral mixing
-      IF( l_ldfslp     )   CALL ldf_slp_init   ! slope of lateral mixing
-
-                           CALL tra_qsr_init   ! penetrative solar radiation qsr
-      IF( ln_trabbl    )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
-
+                           CALL     phy_cst     ! Physical constants
+                           CALL     eos_init    ! Equation of state
+      IF( lk_c1d       )   CALL     c1d_init    ! 1D column configuration
+                           CALL     dom_init    ! Domain
+      IF( ln_ctl       )   CALL prt_ctl_init    ! Print control
+
+                           CALL  istate_init    ! ocean initial state (Dynamics and tracers)
+
+                           CALL     sbc_init    ! Forcings : surface module
+
+      !                                      ! Tracer physics
+                           CALL ldf_tra_init    ! Lateral ocean tracer physics
+                           CALL ldf_eiv_init    ! Eddy induced velocity param
+                           CALL tra_ldf_init    ! lateral mixing
+      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing
+                           CALL tra_qsr_init    ! penetrative solar radiation qsr
+      IF( ln_trabbl    )   CALL tra_bbl_init    ! advective (and/or diffusive) bottom boundary layer scheme
+
+      !                                      ! Passive tracers
                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers
                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar
@@ -336 +337 @@
 
                            CALL     trc_init   ! Passive tracers initialization
-                           CALL dia_ptr_init   ! Initialise diaptr as some variables are used 
-      !                                         ! in various advection and diffusion routines
+                           CALL dia_ptr_init   ! Poleward TRansports initialization
+                           
       IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
       !
@@ -357 +358 @@
          WRITE(numout,*)
          WRITE(numout,*) 'nemo_ctl: Control prints'
-         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
          WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
@@ -381 +382 @@
       IF(lwp) THEN                  ! control print
          WRITE(numout,*)
-         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
-         WRITE(numout,*) '~~~~~~~ '
          WRITE(numout,*) '   Namelist namcfg'
-         WRITE(numout,*) '      read domain configuration files             ln_read_cfg      = ', ln_read_cfg
+         WRITE(numout,*) '      read domain configuration file              ln_read_cfg      = ', ln_read_cfg
          WRITE(numout,*) '         filename to be read                         cn_domcfg     = ', TRIM(cn_domcfg)
-         WRITE(numout,*) '      write  configuration definition files       ln_write_cfg     = ', ln_write_cfg
+         WRITE(numout,*) '         keep closed seas in the domain (if exist)   ln_closea     = ', TRIM(cn_domcfg)
+         WRITE(numout,*) '      create a configuration definition file      ln_write_cfg     = ', ln_write_cfg
          WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out)
          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr     = ', ln_use_jattr
       ENDIF
-
+      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
+      !
       !                             ! Parameter control
       !
@@ -430 +431 @@
       ENDIF
       !
-      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
-         &                                               'f2003 standard. '                              ,  &
-         &                                               'Compile with key_nosignedzero enabled' )
+      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
+         &                                                'Compile with key_nosignedzero enabled' )
       !
    END SUBROUTINE nemo_ctl
@@ -444 +444 @@
       !!----------------------------------------------------------------------
       !
-      IF ( lk_mpp ) CALL mppsync
+      IF( lk_mpp )   CALL mppsync
       !
       CALL iom_close                                 ! close all input/output files managed by iom_*
@@ -453 +453 @@
       IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
       IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
-
+      !
       numout = 6                                     ! redefine numout in case it is used after this point...
       !
@@ -467 +467 @@
       !! ** Method  :
       !!----------------------------------------------------------------------
-      USE diawri,       ONLY: dia_wri_alloc
-      USE dom_oce,      ONLY: dom_oce_alloc
-      USE zdf_oce,      ONLY: zdf_oce_alloc
-      USE trc_oce,      ONLY: trc_oce_alloc
+      USE diawri ,   ONLY : dia_wri_alloc
+      USE dom_oce,   ONLY : dom_oce_alloc
+      USE zdf_oce,   ONLY : zdf_oce_alloc
+      USE trc_oce,   ONLY : trc_oce_alloc
       !
       INTEGER :: ierr
       !!----------------------------------------------------------------------
       !
-      ierr =        oce_alloc       ()          ! ocean 
-      ierr = ierr + dia_wri_alloc   ()
-      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
-      !
-      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
+      ierr =        oce_alloc    ()          ! ocean 
+      ierr = ierr + dia_wri_alloc()
+      ierr = ierr + dom_oce_alloc()          ! ocean domain
+      ierr = ierr + zdf_oce_alloc()          ! ocean vertical physics
+      ierr = ierr + trc_oce_alloc()          ! shared TRC / TRA arrays
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
@@ -496 +495 @@
       !! ** Method  :
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
+      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
       !
       INTEGER, PARAMETER :: nfactmax = 20
@@ -505 +504 @@
       INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
       !!----------------------------------------------------------------------
-
+      !
       ierr = 0
-
+      !
       CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-
+      !
       IF( nfact <= 1 ) THEN
          WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
@@ -540 +539 @@
       !!
       !! ** Purpose :   return the prime factors of n.
-      !!                knfax factors are returned in array kfax which is of 
+      !!                knfax factors are returned in array kfax which is of
       !!                maximum dimension kmaxfax.
       !! ** Method  :
@@ -550 +549 @@
       INTEGER :: ifac, jl, inu
       INTEGER, PARAMETER :: ntest = 14
-      INTEGER :: ilfax(ntest)
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
       !
       ! lfax contains the set of allowed factors.
       ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
-
+      !
       ! Clear the error flag and initialise output vars
-      kerr = 0
-      kfax = 1
+      kerr  = 0
+      kfax  = 1
       knfax = 0
-
-      ! Find the factors of n.
-      IF( kn .NE. 1 ) THEN
-
+      !
+      IF( kn /= 1 ) THEN      ! Find the factors of n
+         !
          ! nu holds the unfactorised part of the number.
          ! knfax holds the number of factors found.
          ! l points to the allowed factor list.
          ! ifac holds the current factor.
-   
+         !
          inu   = kn
          knfax = 0
-   
+         !
          DO jl = ntest, 1, -1
             !
             ifac = ilfax(jl)
             IF( ifac > inu )   CYCLE
-   
+            !
             ! Test whether the factor will divide.
-   
+            !
             IF( MOD(inu,ifac) == 0 ) THEN
                !
@@ -594 +593 @@
             !
          END DO
-   
+         !
       ENDIF
       !
@@ -600 +599 @@
 
 #if defined key_mpp_mpi
-   SUBROUTINE nemo_northcomms
-      !!======================================================================
-      !!                     ***  ROUTINE  nemo_northcomms  ***
-      !! nemo_northcomms    :  Setup for north fold exchanges with explicit 
-      !!                       point-to-point messaging
-      !!=====================================================================
-      !!----------------------------------------------------------------------
-      !!
-      !! ** Purpose :   Initialization of the northern neighbours lists.
+
+   SUBROUTINE nemo_nfdcom
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  nemo_nfdcom  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
       !!----------------------------------------------------------------------
       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
-      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S.
-      !Mocavero, CMCC) 
-      !!----------------------------------------------------------------------
-
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
       INTEGER  ::   sxM, dxM, sxT, dxT, jn
       INTEGER  ::   njmppmax
-
+      !!----------------------------------------------------------------------
+      !
       njmppmax = MAXVAL( njmppt )
-
+      !
       !initializes the north-fold communication variables
       isendto(:) = 0
-      nsndto = 0
-
-      !if I am a process in the north
-      IF ( njmpp == njmppmax ) THEN
-          !sxM is the first point (in the global domain) needed to compute the
-          !north-fold for the current process
-          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
-          !dxM is the last point (in the global domain) needed to compute the
-          !north-fold for the current process
-          dxM = jpiglo - nimppt(narea) + 2
-
-          !loop over the other north-fold processes to find the processes
-          !managing the points belonging to the sxT-dxT range
-
-          DO jn = 1, jpni
-                !sxT is the first point (in the global domain) of the jn
-                !process
-                sxT = nfiimpp(jn, jpnj)
-                !dxT is the last point (in the global domain) of the jn
-                !process
-                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
-                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
-                   nsndto = nsndto + 1
-                     isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
-                   nsndto = nsndto + 1
-                     isendto(nsndto) = jn
-                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
-                   nsndto = nsndto + 1
-                     isendto(nsndto) = jn
-                END IF
-          END DO
-          nfsloop = 1
-          nfeloop = nlci
-          DO jn = 2,jpni-1
-           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
-              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
-                 nfsloop = nldi
-              ENDIF
-              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
-                 nfeloop = nlei
-              ENDIF
-           ENDIF
-        END DO
-
+      nsndto     = 0
+      !
+      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
+         !
+         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
+         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
+         dxM = jpiglo - nimppt(narea) + 2
+         !
+         ! loop over the other north-fold processes to find the processes
+         ! managing the points belonging to the sxT-dxT range
+         !
+         DO jn = 1, jpni
+            !
+            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
+            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
+            !
+            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ENDIF
+            !
+         END DO
+         nfsloop = 1
+         nfeloop = nlci
+         DO jn = 2,jpni-1
+            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
+               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
+               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
+            ENDIF
+         END DO
+         !
       ENDIF
       l_north_nogather = .TRUE.
-   END SUBROUTINE nemo_northcomms
+      !
+   END SUBROUTINE nemo_nfdcom
+
 #else
-   SUBROUTINE nemo_northcomms      ! Dummy routine
-      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
-   END SUBROUTINE nemo_northcomms
+   SUBROUTINE nemo_nfdcom      ! Dummy routine
+      WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'
+   END SUBROUTINE nemo_nfdcom
 #endif
 
@@ -696 +688 @@
    END SUBROUTINE istate_init
 
+
    SUBROUTINE stp_ctl( kt, kindic )
       !!----------------------------------------------------------------------
@@ -722 +715 @@
       !
    END SUBROUTINE stp_ctl
+
    !!======================================================================
 END MODULE nemogcm

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

@@ -74 +74 @@
    REAL(wp), PUBLIC, DIMENSION(:)    , ALLOCATABLE ::   wgtiau               !: IAU weights for each time step
 #if defined key_asminc
-   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_iau           !: IAU-weighted sea surface height increment
+   REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE ::   ssh_iau              !: IAU-weighted sea surface height increment
 #endif
    !                                !!! time steps relative to the cycle interval [0,nitend-nit000-1]
@@ -254 +254 @@
       !--------------------------------------------------------------------
 
-      IF ( ln_asmiau ) THEN
-
+      IF( ln_asmiau ) THEN
+         !
          ALLOCATE( wgtiau( icycper ) )
-
+         !
          wgtiau(:) = 0._wp
-
-         IF ( niaufn == 0 ) THEN
-
-            !---------------------------------------------------------
-            ! Constant IAU forcing 
-            !---------------------------------------------------------
-
+         !
+         !                                !---------------------------------------------------------
+         IF( niaufn == 0 ) THEN           ! Constant IAU forcing 
+            !                             !---------------------------------------------------------
             DO jt = 1, iiauper
                wgtiau(jt+nitiaustr-1) = 1.0 / REAL( iiauper )
             END DO
-
-         ELSEIF ( niaufn == 1 ) THEN
-
-            !---------------------------------------------------------
-            ! Linear hat-like, centred in middle of IAU interval 
-            !---------------------------------------------------------
-
+            !                             !---------------------------------------------------------
+         ELSEIF ( niaufn == 1 ) THEN      ! Linear hat-like, centred in middle of IAU interval 
+            !                             !---------------------------------------------------------
             ! Compute the normalization factor
-            znorm = 0.0
-            IF ( MOD( iiauper, 2 ) == 0 ) THEN  ! Even number of time steps in IAU interval
+            znorm = 0._wp
+            IF( MOD( iiauper, 2 ) == 0 ) THEN   ! Even number of time steps in IAU interval
                imid = iiauper / 2 
                DO jt = 1, imid
@@ -284 +277 @@
                END DO
                znorm = 2.0 * znorm
-            ELSE                               ! Odd number of time steps in IAU interval
+            ELSE                                ! Odd number of time steps in IAU interval
                imid = ( iiauper + 1 ) / 2        
                DO jt = 1, imid - 1
@@ -292 +285 @@
             ENDIF
             znorm = 1.0 / znorm
-
+            !
             DO jt = 1, imid - 1
                wgtiau(jt+nitiaustr-1) = REAL( jt ) * znorm
@@ -299 +292 @@
                wgtiau(jt+nitiaustr-1) = REAL( iiauper - jt + 1 ) * znorm
             END DO
-
+            !
          ENDIF
 
@@ -325 +318 @@
       !--------------------------------------------------------------------
 
-      ALLOCATE( t_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( s_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( u_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( v_bkginc(jpi,jpj,jpk) )
-      ALLOCATE( ssh_bkginc(jpi,jpj)   )
-      ALLOCATE( seaice_bkginc(jpi,jpj))
-      t_bkginc     (:,:,:) = 0._wp
-      s_bkginc     (:,:,:) = 0._wp
-      u_bkginc     (:,:,:) = 0._wp
-      v_bkginc     (:,:,:) = 0._wp
-      ssh_bkginc   (:,:)   = 0._wp
-      seaice_bkginc(:,:)   = 0._wp
+      ALLOCATE( t_bkginc     (jpi,jpj,jpk) )   ;   t_bkginc     (:,:,:) = 0._wp
+      ALLOCATE( s_bkginc     (jpi,jpj,jpk) )   ;   s_bkginc     (:,:,:) = 0._wp
+      ALLOCATE( u_bkginc     (jpi,jpj,jpk) )   ;   u_bkginc     (:,:,:) = 0._wp
+      ALLOCATE( v_bkginc     (jpi,jpj,jpk) )   ;   v_bkginc     (:,:,:) = 0._wp
+      ALLOCATE( ssh_bkginc   (jpi,jpj)     )   ;   ssh_bkginc   (:,:)   = 0._wp
+      ALLOCATE( seaice_bkginc(jpi,jpj)     )   ;   seaice_bkginc(:,:)   = 0._wp
 #if defined key_asminc
-      ALLOCATE( ssh_iau(jpi,jpj)      )
-      ssh_iau      (:,:)   = 0._wp
+      ALLOCATE( ssh_iau      (jpi,jpj)     )   ;   ssh_iau      (:,:)   = 0._wp
 #endif
 #if defined key_cice && defined key_asminc
-      ALLOCATE( ndaice_da(jpi,jpj)    )
-      ndaice_da    (:,:)   = 0._wp
-#endif
-      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN
-
-         !--------------------------------------------------------------------
-         ! Read the increments from file
-         !--------------------------------------------------------------------
-
+      ALLOCATE( ndaice_da    (jpi,jpj)     )   ;   ndaice_da    (:,:)   = 0._wp
+#endif
+      !
+      IF ( ln_trainc .OR. ln_dyninc .OR.   &       !--------------------------------------
+         & ln_sshinc .OR. ln_seaiceinc   ) THEN    ! Read the increments from file
+         !                                         !--------------------------------------
          CALL iom_open( c_asminc, inum )
-
-         CALL iom_get( inum, 'time', zdate_inc ) 
-
+         !
+         CALL iom_get( inum, 'time'       , zdate_inc   ) 
          CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb )
          CALL iom_get( inum, 'z_inc_datef', z_inc_datef )
          z_inc_dateb = zdate_inc
          z_inc_datef = zdate_inc
-
+         !
          IF(lwp) THEN
             WRITE(numout,*) 
-            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', &
-               &            ' between dates ', z_inc_dateb,' and ',  &
-               &            z_inc_datef
+            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid between dates ', z_inc_dateb,' and ', z_inc_datef
             WRITE(numout,*) '~~~~~~~~~~~~'
          ENDIF
-
-         IF (     ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) &
-            & .OR.( z_inc_datef > ditend_date ) ) &
-            & CALL ctl_warn( ' Validity time of assimilation increments is ', &
-            &                ' outside the assimilation interval' )
+         !
+         IF ( ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) .OR.   &
+            & ( z_inc_datef > ditend_date ) ) &
+            &    CALL ctl_warn( ' Validity time of assimilation increments is ', &
+            &                   ' outside the assimilation interval' )
 
          IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_date ) ) &
@@ -418 +398 @@
             WHERE( ABS( seaice_bkginc(:,:) ) > 1.0e+10 ) seaice_bkginc(:,:) = 0.0
          ENDIF
-
+         !
          CALL iom_close( inum )
- 
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Apply divergence damping filter
-      !-----------------------------------------------------------------------
-
-      IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN
-         !
+         !
+      ENDIF
+      !
+      !                                            !--------------------------------------
+      IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN    ! Apply divergence damping filter
+         !                                         !--------------------------------------
          ALLOCATE( zhdiv(jpi,jpj) ) 
          !
@@ -460 +437 @@
          !
       ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Allocate and initialize the background state arrays
-      !-----------------------------------------------------------------------
-
-      IF ( ln_asmdin ) THEN
-         !
-         ALLOCATE( t_bkg(jpi,jpj,jpk) )
-         ALLOCATE( s_bkg(jpi,jpj,jpk) )
-         ALLOCATE( u_bkg(jpi,jpj,jpk) )
-         ALLOCATE( v_bkg(jpi,jpj,jpk) )
-         ALLOCATE( ssh_bkg(jpi,jpj)   )
-         !
-         t_bkg(:,:,:) = 0._wp
-         s_bkg(:,:,:) = 0._wp
-         u_bkg(:,:,:) = 0._wp
-         v_bkg(:,:,:) = 0._wp
-         ssh_bkg(:,:) = 0._wp
+      !
+      !                             !-----------------------------------------------------
+      IF ( ln_asmdin ) THEN         ! Allocate and initialize the background state arrays
+         !                          !-----------------------------------------------------
+         !
+         ALLOCATE( t_bkg  (jpi,jpj,jpk) )   ;   t_bkg  (:,:,:) = 0._wp
+         ALLOCATE( s_bkg  (jpi,jpj,jpk) )   ;   s_bkg  (:,:,:) = 0._wp
+         ALLOCATE( u_bkg  (jpi,jpj,jpk) )   ;   u_bkg  (:,:,:) = 0._wp
+         ALLOCATE( v_bkg  (jpi,jpj,jpk) )   ;   v_bkg  (:,:,:) = 0._wp
+         ALLOCATE( ssh_bkg(jpi,jpj)     )   ;   ssh_bkg(:,:)   = 0._wp
+         !
          !
          !--------------------------------------------------------------------
@@ -489 +459 @@
          IF(lwp) THEN
             WRITE(numout,*) 
-            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', &
-               &  zdate_bkg
-            WRITE(numout,*) '~~~~~~~~~~~~'
-         ENDIF
-         !
-         IF ( zdate_bkg /= ditdin_date ) &
+            WRITE(numout,*) '   ==>>>  Assimilation background state valid at : ', zdate_bkg
+            WRITE(numout,*)
+         ENDIF
+         !
+         IF ( zdate_bkg /= ditdin_date )   &
             & CALL ctl_warn( ' Validity time of assimilation background state does', &
             &                ' not agree with Direct Initialization time' )
@@ -521 +490 @@
       ENDIF
       !
+      IF(lwp) WRITE(numout,*) '   ==>>>   Euler time step switch is ', neuler
+      !
+      IF( lk_asminc ) THEN                            !==  data assimilation  ==!
+         IF( ln_bkgwri )   CALL asm_bkg_wri( nit000 - 1 )      ! Output background fields
+         IF( ln_asmdin ) THEN                                  ! Direct initialization
+            IF( ln_trainc )   CALL tra_asm_inc( nit000 - 1 )      ! Tracers
+            IF( ln_dyninc )   CALL dyn_asm_inc( nit000 - 1 )      ! Dynamics
+            IF( ln_sshinc )   CALL ssh_asm_inc( nit000 - 1 )      ! SSH
+         ENDIF
+      ENDIF
+      !
    END SUBROUTINE asm_inc_init
+   
+   
    SUBROUTINE tra_asm_inc( kt )
       !!----------------------------------------------------------------------
@@ -786 +768 @@
    END SUBROUTINE ssh_asm_inc
 
+
    SUBROUTINE ssh_asm_div( kt, phdivn )
       !!----------------------------------------------------------------------
@@ -824 +807 @@
    END SUBROUTINE ssh_asm_div
 
+
    SUBROUTINE seaice_asm_inc( kt, kindic )
       !!----------------------------------------------------------------------
@@ -886 +870 @@
             ! seaice salinity balancing (to add)
 #endif
-
+            !
 #if defined key_cice && defined key_asminc
             ! Sea-ice : CICE case. Pass ice increment tendency into CICE
             ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt
 #endif
-
+            !
             IF ( kt == nitiaufin_r ) THEN
                DEALLOCATE( seaice_bkginc )
             ENDIF
-
+            !
          ELSE
-
+            !
 #if defined key_cice && defined key_asminc
             ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE
 #endif
-
+            !
          ENDIF
          !                          !-----------------------------------------
@@ -949 +933 @@
 #if defined key_cice && defined key_asminc
             ndaice_da(:,:) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE
-
 #endif
             !

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

@@ -28 +28 @@
    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
-   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_nfdcom
    !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
    !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
-   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_nfdcom: setup avoiding MPI communication 
    !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
    !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
@@ -44 +44 @@
    !!   nemo_partition: calculate MPP domain decomposition
    !!   factorise     : calculate the factors of the no. of MPI processes
+   !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
    !!----------------------------------------------------------------------
    USE step_oce       ! module used in the ocean time stepping module (step.F90)
@@ -88 +89 @@
    USE lib_mpp        ! distributed memory computing
    USE mppini         ! shared/distributed memory setting (mpp_init routine)
-   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 #if defined key_iomput
@@ -104 +105 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2016)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2018)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -130 +131 @@
       CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
 #endif
-      !
       !                            !-----------------------!
       CALL nemo_init               !==  Initialisations  ==!
@@ -161 +161 @@
       END DO
 #else
-
-!!gm     This data assimilation calls should be part of the initialisation (i.e. put in asm_inc_init)
-      !
-      IF( lk_asminc ) THEN                            !==  data assimilation  ==!   (done prior to time stepping)
-         IF( ln_bkgwri )   CALL asm_bkg_wri( nit000 - 1 )      ! Output background fields
-         IF( ln_asmdin ) THEN                                  ! Direct initialization
-            IF( ln_trainc )   CALL tra_asm_inc( nit000 - 1 )      ! Tracers
-            IF( ln_dyninc )   CALL dyn_asm_inc( nit000 - 1 )      ! Dynamics
-            IF( ln_sshinc )   CALL ssh_asm_inc( nit000 - 1 )      ! SSH
-         ENDIF
-      ENDIF
-!!gm end
       !
 # if defined key_agrif
       !                                               !==  AGRIF time-stepping  ==!
       CALL Agrif_Regrid()
+      !
       DO WHILE( istp <= nitend .AND. nstop == 0 )
          CALL stp
@@ -222 +211 @@
       IF( nstop /= 0 .AND. lwp ) THEN        ! error print
          WRITE(numout,cform_err)
-         WRITE(numout,*) 'nemo_gcm: a total of ', nstop, ' errors have been found'
+         WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
          WRITE(numout,*)
       ENDIF
@@ -249 +238 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   ji                 ! dummy loop indices
-      INTEGER  ::   ios, ilocal_comm   ! local integer
-      INTEGER  ::   iiarea, ijarea     ! local integers
-      INTEGER  ::   iirest, ijrest     ! local integers
+      INTEGER  ::   ios, ilocal_comm   ! local integers
+      INTEGER  ::   iiarea, ijarea     !   -       -
+      INTEGER  ::   iirest, ijrest     !   -       -
       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
-      !
+      !!
       NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   &
          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   &
          &             ln_timing, ln_diacfl
-      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr, ln_closea
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
       !!----------------------------------------------------------------------
       !
@@ -269 +258 @@
       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
       !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
@@ -276 +265 @@
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
       !
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
-      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
@@ -435 +424 @@
 
       !                                      ! Domain decomposition
-      CALL mpp_init
-      IF( ln_nnogather )   CALL nemo_northcomms! northfold neighbour lists
-      !
-      IF( ln_timing    )   CALL timing_init
+      CALL mpp_init                             ! MPP
+      IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists
       !
       !                                      ! General initialization
-                           CALL     phy_cst    ! Physical constants
-                           CALL     eos_init   ! Equation of state
-      IF( lk_c1d       )   CALL     c1d_init   ! 1D column configuration
-                           CALL     wad_init   ! Wetting and drying options
-                           CALL     dom_init   ! Domain
-      IF( ln_crs       )   CALL     crs_init   ! coarsened grid: domain initialization 
-      IF( ln_ctl       )   CALL prt_ctl_init   ! Print control
+      IF( ln_timing    )   CALL timing_init     ! timing
+      IF( ln_timing    )   CALL timing_start( 'nemo_init')
+      !
+                           CALL     phy_cst     ! Physical constants
+                           CALL     eos_init    ! Equation of state
+      IF( lk_c1d       )   CALL     c1d_init    ! 1D column configuration
+                           CALL     wad_init    ! Wetting and drying options
+                           CALL     dom_init    ! Domain
+      IF( ln_crs       )   CALL     crs_init    ! coarsened grid: domain initialization 
+      IF( ln_ctl       )   CALL prt_ctl_init    ! Print control
       
-      CALL diurnal_sst_bulk_init             ! diurnal sst
-      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin   
+      CALL diurnal_sst_bulk_init                ! diurnal sst
+      IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin   
+      !                            
+      IF( ln_diurnal_only ) THEN                   ! diurnal only: a subset of the initialisation routines
+         CALL  istate_init                            ! ocean initial state (Dynamics and tracers)
+         CALL     sbc_init                            ! Forcings : surface module
+         CALL tra_qsr_init                            ! penetrative solar radiation qsr
+         IF( ln_diaobs ) THEN                         ! Observation & model comparison
+            CALL dia_obs_init                            ! Initialize observational data
+            CALL dia_obs( nit000 - 1 )                   ! Observation operator for restart
+         ENDIF     
+         IF( lk_asminc )   CALL asm_inc_init          ! Assimilation increments
+         !
+         RETURN                                       ! end of initialization
+      ENDIF
       
-      ! IF ln_diurnal_only, then we only want a subset of the initialisation routines
-      IF( ln_diurnal_only ) THEN
-         CALL  istate_init   ! ocean initial state (Dynamics and tracers)
-         CALL     sbc_init   ! Forcings : surface module
-         CALL tra_qsr_init   ! penetrative solar radiation qsr
-         IF( ln_diaobs ) THEN                   ! Observation & model comparison
-            CALL dia_obs_init                      ! Initialize observational data
-            CALL dia_obs( nit000 - 1 )             ! Observation operator for restart
-         ENDIF     
-         !                                     ! Assimilation increments
-         IF( lk_asminc )   CALL asm_inc_init   ! Initialize assimilation increments
-                 
-         IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
-         RETURN
-      ENDIF
-      
-                           CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+                           CALL  istate_init    ! ocean initial state (Dynamics and tracers)
 
       !                                      ! external forcing 
-                           CALL    tide_init   ! tidal harmonics
-                           CALL     sbc_init   ! surface boundary conditions (including sea-ice)
-                           CALL     bdy_init   ! Open boundaries initialisation
+                           CALL    tide_init    ! tidal harmonics
+                           CALL     sbc_init    ! surface boundary conditions (including sea-ice)
+                           CALL     bdy_init    ! Open boundaries initialisation
 
       !                                      ! Ocean physics
@@ -520 +507 @@
                            CALL     trd_init    ! Mixed-layer/Vorticity/Integral constraints trends
                            CALL dia_obs_init    ! Initialize observational data
-      IF( ln_diaobs    )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+                           CALL dia_tmb_init    ! TMB outputs
+                           CALL dia_25h_init    ! 25h mean  outputs
+      IF( ln_diaobs    )   CALL dia_obs( nit000-1 )   ! Observation operator for restart
 
       !                                      ! Assimilation increments
       IF( lk_asminc    )   CALL asm_inc_init    ! Initialize assimilation increments
-      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
-                           CALL dia_tmb_init    ! TMB outputs
-                           CALL dia_25h_init    ! 25h mean  outputs
+      !
+      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
+      !
+      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
       !
    END SUBROUTINE nemo_init
@@ -543 +533 @@
          WRITE(numout,*)
          WRITE(numout,*) 'nemo_ctl: Control prints'
-         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
          WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
@@ -563 +553 @@
       njctle    = nn_jctle
       isplt     = nn_isplt
-      jsplt     = nn_jsplt      
+      jsplt     = nn_jsplt
 
       IF(lwp) THEN                  ! control print
          WRITE(numout,*)
-         WRITE(numout,*) 'namcfg : configuration initialization through namelist read'
-         WRITE(numout,*) '~~~~~~ '
          WRITE(numout,*) '   Namelist namcfg'
          WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
          WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
-         WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg
+         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
+         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
          WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
          WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
       ENDIF
+      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
+      !
       !                             ! Parameter control
       !
@@ -615 +606 @@
       ENDIF
       !
-      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
-         &                                               'f2003 standard. '                              ,  &
-         &                                               'Compile with key_nosignedzero enabled' )
+      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
+         &                                                'Compile with key_nosignedzero enabled' )
       !
 #if defined key_agrif
@@ -664 +654 @@
       !! ** Method  :
       !!----------------------------------------------------------------------
-      USE diawri    , ONLY: dia_wri_alloc
-      USE dom_oce   , ONLY: dom_oce_alloc
-      USE trc_oce   , ONLY: trc_oce_alloc
+      USE diawri    , ONLY : dia_wri_alloc
+      USE dom_oce   , ONLY : dom_oce_alloc
+      USE trc_oce   , ONLY : trc_oce_alloc
+      USE bdy_oce   , ONLY : bdy_oce_alloc
 #if defined key_diadct 
-      USE diadct    , ONLY: diadct_alloc 
+      USE diadct    , ONLY : diadct_alloc 
 #endif 
-      USE bdy_oce   , ONLY: bdy_oce_alloc
       !
       INTEGER :: ierr
       !!----------------------------------------------------------------------
       !
-      ierr =        oce_alloc       ()          ! ocean 
-      ierr = ierr + dia_wri_alloc   ()
-      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
-      !
-      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
+      ierr =        oce_alloc    ()    ! ocean 
+      ierr = ierr + dia_wri_alloc()
+      ierr = ierr + dom_oce_alloc()    ! ocean domain
+      ierr = ierr + zdf_oce_alloc()    ! ocean vertical physics
+      ierr = ierr + trc_oce_alloc()    ! shared TRC / TRA arrays
+      ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization)
       !
 #if defined key_diadct 
-      ierr = ierr + diadct_alloc    ()          ! 
+      ierr = ierr + diadct_alloc ()    ! 
 #endif 
-      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
       !
    END SUBROUTINE nemo_alloc
@@ -766 +755 @@
       knfax = 0
       !
-      ! Find the factors of n.
-      IF( kn .NE. 1 ) THEN
-
+      IF( kn /= 1 ) THEN      ! Find the factors of n
+         !
          ! nu holds the unfactorised part of the number.
          ! knfax holds the number of factors found.
@@ -781 +769 @@
             ifac = ilfax(jl)
             IF( ifac > inu )   CYCLE
-   
+            !
             ! Test whether the factor will divide.
-   
+            !
             IF( MOD(inu,ifac) == 0 ) THEN
                !
@@ -807 +795 @@
 #if defined key_mpp_mpi
 
-   SUBROUTINE nemo_northcomms
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  nemo_northcomms  ***
+   SUBROUTINE nemo_nfdcom
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  nemo_nfdcom  ***
       !! ** Purpose :   Setup for north fold exchanges with explicit 
       !!                point-to-point messaging
@@ -828 +816 @@
       nsndto     = 0
       !
-      !if I am a process in the north
-      IF ( njmpp == njmppmax ) THEN
-          !sxM is the first point (in the global domain) needed to compute the
-          !north-fold for the current process
-          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
-          !dxM is the last point (in the global domain) needed to compute the
-          !north-fold for the current process
-          dxM = jpiglo - nimppt(narea) + 2
-
-          !loop over the other north-fold processes to find the processes
-          !managing the points belonging to the sxT-dxT range
-  
-          DO jn = 1, jpni
-                !sxT is the first point (in the global domain) of the jn
-                !process
-                sxT = nfiimpp(jn, jpnj)
-                !dxT is the last point (in the global domain) of the jn
-                !process
-                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
-                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ENDIF
-          END DO
-          nfsloop = 1
-          nfeloop = nlci
-          DO jn = 2,jpni-1
-           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
-              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
-                 nfsloop = nldi
-              ENDIF
-              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
-                 nfeloop = nlei
-              ENDIF
-           ENDIF
-        END DO
-
+      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
+         !
+         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
+         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
+         dxM = jpiglo - nimppt(narea) + 2
+         !
+         ! loop over the other north-fold processes to find the processes
+         ! managing the points belonging to the sxT-dxT range
+         !
+         DO jn = 1, jpni
+            !
+            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
+            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
+            !
+            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ENDIF
+            !
+         END DO
+         nfsloop = 1
+         nfeloop = nlci
+         DO jn = 2,jpni-1
+            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
+               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
+               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
+            ENDIF
+         END DO
+         !
       ENDIF
       l_north_nogather = .TRUE.
-   END SUBROUTINE nemo_northcomms
+      !
+   END SUBROUTINE nemo_nfdcom
 
 #else
-   SUBROUTINE nemo_northcomms      ! Dummy routine
-      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
-   END SUBROUTINE nemo_northcomms
+   SUBROUTINE nemo_nfdcom      ! Dummy routine
+      WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'
+   END SUBROUTINE nemo_nfdcom
 #endif
 

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

@@ -82 +82 @@
    USE diaharm
    USE diacfl
+   USE diaobs          ! Observation operator
    USE flo_oce         ! floats variables
    USE floats          ! floats computation               (flo_stp routine)
@@ -93 +94 @@
    USE restart         ! ocean restart                    (rst_wri routine)
    USE prtctl          ! Print control                    (prt_ctl routine)
-
-   USE diaobs          ! Observation operator
 
    USE in_out_manager  ! I/O manager

branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

@@ -18 +18 @@
    !!   nemo_partition: calculate MPP domain decomposition
    !!   factorise     : calculate the factors of the no. of MPI processes
+   !!   nemo_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
    !!----------------------------------------------------------------------
    USE step_oce       ! module used in the ocean time stepping module
@@ -37 +38 @@
    USE lib_mpp        ! distributed memory computing
    USE mppini         ! shared/distributed memory setting (mpp_init routine)
-   USE lbcnfd   , ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
+   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 #if defined key_iomput
@@ -52 +53 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2018)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -76 +77 @@
       !
 #if defined key_agrif
-     CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
-#endif
-      !
+      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
+#endif
       !                            !-----------------------!
       CALL nemo_init               !==  Initialisations  ==!
@@ -102 +102 @@
       !                            !-----------------------!
       istp = nit000
+      !
 #if defined key_agrif
+      !                                               !==  AGRIF time-stepping  ==!
       CALL Agrif_Regrid()
-#endif
-
-      DO WHILE ( istp <= nitend .AND. nstop == 0 )
-#if defined key_agrif
-         CALL stp                         ! AGRIF: time stepping
+      !
+      DO WHILE( istp <= nitend .AND. nstop == 0 )
+         CALL stp
+         istp = istp + 1
+      END DO
+      !
+      IF( .NOT. Agrif_Root() ) THEN
+         CALL Agrif_ParentGrid_To_ChildGrid()
+         IF( ln_timing )   CALL timing_finalize
+         CALL Agrif_ChildGrid_To_ParentGrid()
+      ENDIF
+      !
 #else
-         IF ( .NOT. ln_diurnal_only ) THEN
-            CALL stp( istp )                 ! standard time stepping
-         ELSE
-            CALL stp_diurnal( istp )        ! time step only the diurnal SST
-         ENDIF 
-#endif
-         istp = istp + 1
-         IF( lk_mpp )   CALL mpp_max( nstop )
+      !
+      IF( .NOT.ln_diurnal_only ) THEN                 !==  Standard time-stepping  ==!
+         !
+         DO WHILE( istp <= nitend .AND. nstop == 0 )
+            CALL stp        ( istp ) 
+            istp = istp + 1
          END DO
+         !
+      ELSE                                            !==  diurnal SST time-steeping only  ==!
+         !
+         DO WHILE( istp <= nitend .AND. nstop == 0 )
+            CALL stp_diurnal( istp )   ! time step only the diurnal SST 
+            istp = istp + 1
+         END DO
+         !
+      ENDIF
+      !
+#endif
       !
       IF( ln_icebergs )   CALL icb_end( nitend )
@@ -129 +147 @@
       IF( nstop /= 0 .AND. lwp ) THEN        ! error print
          WRITE(numout,cform_err)
-         WRITE(numout,*) nstop, ' error have been found'
-      ENDIF
-      !
-#if defined key_agrif
-         CALL Agrif_ParentGrid_To_ChildGrid()
-         IF( ln_timing )   CALL timing_finalize
-         CALL Agrif_ChildGrid_To_ParentGrid()
-#endif
+         WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
+         WRITE(numout,*)
+      ENDIF
+      !
       IF( ln_timing )   CALL timing_finalize
       !
@@ -142 +156 @@
       !
 #if defined key_iomput
-      CALL xios_finalize                     ! end mpp communications with xios
-      IF( lk_oasis )   CALL cpl_finalize     ! end coupling and mpp communications with OASIS
+                                    CALL xios_finalize  ! end mpp communications with xios
+      IF( lk_oasis     )            CALL cpl_finalize   ! end coupling and mpp communications with OASIS
 #else
-      IF( lk_oasis ) THEN 
-         CALL cpl_finalize                   ! end coupling and mpp communications with OASIS
-      ELSE
-         IF( lk_mpp )   CALL mppstop         ! end mpp communications
+      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS
+      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications
       ENDIF
 #endif
@@ -161 +173 @@
       !! ** Purpose :   initialization of the NEMO GCM
       !!----------------------------------------------------------------------
-      INTEGER  ::   ji            ! dummy loop indices
-      INTEGER  ::   ilocal_comm   ! local integer
-      INTEGER  ::   ios, inum     !   -      -
-      INTEGER  ::   iiarea, ijarea     ! local integers
-      INTEGER  ::   iirest, ijrest     ! local integers
+      INTEGER  ::   ji                 ! dummy loop indices
+      INTEGER  ::   ios, ilocal_comm   ! local integers
+      INTEGER  ::   iiarea, ijarea     !   -       -
+      INTEGER  ::   iirest, ijrest     !   -       -
       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
       CHARACTER(len=80)                 ::   clname
-      !
+      !!
       NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   &
          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   &
          &             ln_timing, ln_diacfl
-      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr, ln_closea
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
       !!----------------------------------------------------------------------
       !
@@ -193 +204 @@
    ENDIF
       !
-      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
@@ -200 +211 @@
 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
       !
-      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
-      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
@@ -325 +336 @@
       IF(lwp) THEN                            ! open listing units
          !
-         IF( lk_oasis ) THEN
-            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
-         ELSE
-            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         IF( lk_oasis ) THEN   ;   CALL ctl_opn( numout,   'sas.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea )
+         ELSE                  ;   CALL ctl_opn( numout, 'ocean.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea )
          ENDIF
          !
@@ -335 +344 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.7  (2016) '
+         WRITE(numout,*) '                NEMO version 4.0  (2017) '
          WRITE(numout,*) '             StandAlone Surface version (SAS) '
          WRITE(numout,*)
@@ -354 +363 @@
       ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
       CALL nemo_alloc()
+
       !                             !-------------------------------!
       !                             !  NEMO general initialization  !
@@ -361 +371 @@
 
       !                                      ! Domain decomposition
-      CALL mpp_init
-      !
-      IF( ln_timing    )   CALL timing_init
-      !
-      !                                     ! General initialization
-                           CALL phy_cst    ! Physical constants
-                           CALL eos_init   ! Equation of state
-                           CALL dom_init   ! Domain
-
-     IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
-
-      IF( ln_ctl      )    CALL prt_ctl_init   ! Print control
-                           CALL day_init   ! model calendar (using both namelist and restart infos)
-      IF( ln_rstart )       CALL rst_read_open
-
-                           CALL sbc_init   ! Forcings : surface module 
+      CALL mpp_init                             ! MPP
+      IF( ln_nnogather )   CALL nemo_nfdcom     ! northfold neighbour lists
+      !
+      !
+      !                                      ! General initialization
+      IF( ln_timing    )   CALL timing_init     ! timing
+      IF( ln_timing    )   CALL timing_start( 'nemo_init')
+
+                           CALL phy_cst         ! Physical constants
+                           CALL eos_init        ! Equation of seawater
+                           CALL dom_init        ! Domain
+      IF( ln_ctl      )    CALL prt_ctl_init    ! Print control
+      
+                           CALL day_init        ! model calendar (using both namelist and restart infos)
+      IF( ln_rstart )      CALL rst_read_open
+
+      !                                      ! external forcing 
+                           CALL sbc_init        ! Forcings : surface module 
 
       ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from  
@@ -384 +396 @@
       ! ==>
                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance
-      
-      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+      !
+      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
+      !
+      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
       !
    END SUBROUTINE nemo_init
@@ -394 +408 @@
       !!                     ***  ROUTINE nemo_ctl  ***
       !!
-      !! ** Purpose :   control print setting 
+      !! ** Purpose :   control print setting
       !!
       !! ** Method  : - print namctl information and check some consistencies
@@ -402 +416 @@
          WRITE(numout,*)
          WRITE(numout,*) 'nemo_ctl: Control prints'
-         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '~~~~~~~~'
          WRITE(numout,*) '   Namelist namctl'
          WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
@@ -426 +440 @@
       IF(lwp) THEN                  ! control print
          WRITE(numout,*)
-         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
-         WRITE(numout,*) '~~~~~~~ '
          WRITE(numout,*) '   Namelist namcfg'
-         WRITE(numout,*) '      read domain configuration files               ln_read_cfg      = ', ln_read_cfg
+         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
          WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
-         WRITE(numout,*) '      write  configuration definition files         ln_write_cfg     = ', ln_write_cfg
+         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
+         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
          WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
          WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
       ENDIF
+      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
+      !
       !                             ! Parameter control
       !
@@ -474 +489 @@
       ENDIF
       !
-      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
-         &                                               'f2003 standard. '                              ,  &
-         &                                               'Compile with key_nosignedzero enabled' )
+      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
+         &                                                'Compile with key_nosignedzero enabled' )
+      !
+#if defined key_agrif
+      IF( ln_timing )   CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
+#endif
       !
    END SUBROUTINE nemo_ctl
@@ -492 +510 @@
       CALL iom_close                                 ! close all input/output files managed by iom_*
       !
-      IF( numstp          /= -1 )   CLOSE( numstp      )   ! time-step file      
+      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file      
       IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
       IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
@@ -499 +517 @@
       IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
       IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
-      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice  )   ! ice variables (temp. evolution)
-      IF( numout          /=  6 )   CLOSE( numout      )   ! standard model output file
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
       !
       numout = 6                                     ! redefine numout in case it is used after this point...
@@ -515 +533 @@
       !! ** Method  :
       !!----------------------------------------------------------------------
-      USE diawri    , ONLY: dia_wri_alloc
-      USE dom_oce   , ONLY: dom_oce_alloc
-      USE bdy_oce   , ONLY: ln_bdy, bdy_oce_alloc
+      USE diawri    , ONLY : dia_wri_alloc
+      USE dom_oce   , ONLY : dom_oce_alloc
+      USE bdy_oce   , ONLY : ln_bdy, bdy_oce_alloc
       USE oce       ! mandatory for sea-ice because needed for bdy arrays
       !
@@ -523 +541 @@
       !!----------------------------------------------------------------------
       !
-      ierr =        dia_wri_alloc   ()
-      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + oce_alloc       ()          ! (tsn...) needed for agrif and/or ESIM and bdy
-      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
+      ierr =        dia_wri_alloc()
+      ierr = ierr + dom_oce_alloc()          ! ocean domain
+      ierr = ierr + oce_alloc    ()          ! (tsn...) needed for agrif and/or ESIM and bdy
+      ierr = ierr + bdy_oce_alloc()          ! bdy masks (incl. initialization)
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
       !
    END SUBROUTINE nemo_alloc
@@ -538 +556 @@
       !!                 ***  ROUTINE nemo_partition  ***
       !!
-      !! ** Purpose :   
+      !! ** Purpose :
       !!
       !! ** Method  :
@@ -607 +625 @@
       knfax = 0
       !
-      ! Find the factors of n.
-      IF( kn .NE. 1 ) THEN
-
+      IF( kn /= 1 ) THEN      ! Find the factors of n
+         !
          ! nu holds the unfactorised part of the number.
          ! knfax holds the number of factors found.
@@ -622 +639 @@
             ifac = ilfax(jl)
             IF( ifac > inu )   CYCLE
-   
+            !
             ! Test whether the factor will divide.
-   
+            !
             IF( MOD(inu,ifac) == 0 ) THEN
                !
@@ -648 +665 @@
 #if defined key_mpp_mpi
 
-   SUBROUTINE nemo_northcomms
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  nemo_northcomms  ***
+   SUBROUTINE nemo_nfdcom
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  nemo_nfdcom  ***
       !! ** Purpose :   Setup for north fold exchanges with explicit 
       !!                point-to-point messaging
@@ -669 +686 @@
       nsndto     = 0
       !
-      !if I am a process in the north
-      IF ( njmpp == njmppmax ) THEN
-          !sxM is the first point (in the global domain) needed to compute the
-          !north-fold for the current process
-          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
-          !dxM is the last point (in the global domain) needed to compute the
-          !north-fold for the current process
-          dxM = jpiglo - nimppt(narea) + 2
-
-          !loop over the other north-fold processes to find the processes
-          !managing the points belonging to the sxT-dxT range
-  
-          DO jn = 1, jpni
-                !sxT is the first point (in the global domain) of the jn
-                !process
-                sxT = nfiimpp(jn, jpnj)
-                !dxT is the last point (in the global domain) of the jn
-                !process
-                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
-                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
-                   nsndto = nsndto + 1
-                     isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
-                   nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ENDIF
-          END DO
-          nfsloop = 1
-          nfeloop = nlci
-          DO jn = 2,jpni-1
-           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
-              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
-                 nfsloop = nldi
-              ENDIF
-              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
-                 nfeloop = nlei
-              ENDIF
-           ENDIF
-        END DO
-
+      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
+         !
+         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
+         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
+         dxM = jpiglo - nimppt(narea) + 2
+         !
+         ! loop over the other north-fold processes to find the processes
+         ! managing the points belonging to the sxT-dxT range
+         !
+         DO jn = 1, jpni
+            !
+            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
+            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
+            !
+            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ENDIF
+            !
+         END DO
+         nfsloop = 1
+         nfeloop = nlci
+         DO jn = 2,jpni-1
+            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
+               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
+               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
+            ENDIF
+         END DO
+         !
       ENDIF
       l_north_nogather = .TRUE.
-   END SUBROUTINE nemo_northcomms
+      !
+   END SUBROUTINE nemo_nfdcom
 
 #else
-   SUBROUTINE nemo_northcomms      ! Dummy routine
-      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
-   END SUBROUTINE nemo_northcomms
+   SUBROUTINE nemo_nfdcom      ! Dummy routine
+      WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'
+   END SUBROUTINE nemo_nfdcom
 #endif
 
    !!======================================================================
 END MODULE nemogcm
+