source: NEMO/trunk/src/OCE/nemogcm.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 7 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 36.0 KB
Line 
1MODULE nemogcm
2   !!======================================================================
3   !!                       ***  MODULE nemogcm   ***
4   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
5   !!======================================================================
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
34   !!----------------------------------------------------------------------
35
36   !!----------------------------------------------------------------------
37   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
38   !!   nemo_init     : initialization of the NEMO system
39   !!   nemo_ctl      : initialisation of the contol print
40   !!   nemo_closefile: close remaining open files
41   !!   nemo_alloc    : dynamical allocation
42   !!----------------------------------------------------------------------
43   USE step_oce       ! module used in the ocean time stepping module (step.F90)
44   USE phycst         ! physical constant                  (par_cst routine)
45   USE domain         ! domain initialization   (dom_init & dom_cfg routines)
46   USE closea         ! treatment of closed seas (for ln_closea)
47   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
50   USE bdyini         ! open boundary cond. setting       (bdy_init routine)
51   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
62   USE step           ! NEMO time-stepping                 (stp     routine)
63   USE isfstp         ! ice shelf                     (isf_stp_init routine)
64   USE icbini         ! handle bergs, initialisation
65   USE icbstp         ! handle bergs, calving, themodynamics and transport
66   USE cpl_oasis3     ! OASIS3 coupling
67   USE c1d            ! 1D configuration
68   USE step_c1d       ! Time stepping loop for the 1D configuration
69   USE dyndmp         ! Momentum damping
70   USE stopar         ! Stochastic param.: ???
71   USE stopts         ! Stochastic param.: ???
72   USE diu_layers     ! diurnal bulk SST and coolskin
73   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline)
74   USE crsini         ! initialise grid coarsening utility
75   USE dia25h         ! 25h mean output
76   USE diadetide      ! Weights computation for daily detiding of model diagnostics
77   USE sbc_oce , ONLY : lk_oasis
78   USE wet_dry        ! Wetting and drying setting   (wad_init routine)
79#if defined key_top
80   USE trcini         ! passive tracer initialisation
81#endif
82#if defined key_nemocice_decomp
83   USE ice_domain_size, only: nx_global, ny_global
84#endif
85   !
86   USE lib_mpp        ! distributed memory computing
87   USE mppini         ! shared/distributed memory setting (mpp_init routine)
88   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges
89   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
90#if defined key_iomput
91   USE xios           ! xIOserver
92#endif
93#if defined key_agrif
94   USE agrif_all_update   ! Master Agrif update
95#endif
96
97   IMPLICIT NONE
98   PRIVATE
99
100   PUBLIC   nemo_gcm    ! called by model.F90
101   PUBLIC   nemo_init   ! needed by AGRIF
102   PUBLIC   nemo_alloc  ! needed by TAM
103
104   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
105
106#if defined key_mpp_mpi
107   ! need MPI_Wtime
108   INCLUDE 'mpif.h'
109#endif
110
111   !!----------------------------------------------------------------------
112   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
113   !! $Id$
114   !! Software governed by the CeCILL license (see ./LICENSE)
115   !!----------------------------------------------------------------------
116CONTAINS
117
118   SUBROUTINE nemo_gcm
119      !!----------------------------------------------------------------------
120      !!                     ***  ROUTINE nemo_gcm  ***
121      !!
122      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
123      !!              curvilinear mesh on the sphere.
124      !!
125      !! ** Method  : - model general initialization
126      !!              - launch the time-stepping (stp routine)
127      !!              - finalize the run by closing files and communications
128      !!
129      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
130      !!              Madec, 2008, internal report, IPSL.
131      !!----------------------------------------------------------------------
132      INTEGER ::   istp   ! time step index
133      REAL(wp)::   zstptiming   ! elapsed time for 1 time step
134      !!----------------------------------------------------------------------
135      !
136#if defined key_agrif
137      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
138#endif
139      !                            !-----------------------!
140      CALL nemo_init               !==  Initialisations  ==!
141      !                            !-----------------------!
142#if defined key_agrif
143      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
144      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
145      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA
146# if defined key_top
147      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
148# endif
149# if defined key_si3
150      CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice
151# endif
152#endif
153      ! check that all process are still there... If some process have an error,
154      ! they will never enter in step and other processes will wait until the end of the cpu time!
155      CALL mpp_max( 'nemogcm', nstop )
156
157      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
158
159      !                            !-----------------------!
160      !                            !==   time stepping   ==!
161      !                            !-----------------------!
162      istp = nit000
163      !
164#if defined key_c1d
165      DO WHILE ( istp <= nitend .AND. nstop == 0 )    !==  C1D time-stepping  ==!
166         CALL stp_c1d( istp )
167         istp = istp + 1
168      END DO
169#else
170      !
171# if defined key_agrif
172      !                                               !==  AGRIF time-stepping  ==!
173      CALL Agrif_Regrid()
174      !
175      ! Recursive update from highest nested level to lowest:
176      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
177      CALL Agrif_step_child_adj(Agrif_Update_All)
178      !
179      DO WHILE( istp <= nitend .AND. nstop == 0 )
180         CALL stp
181         istp = istp + 1
182      END DO
183      !
184      IF( .NOT. Agrif_Root() ) THEN
185         CALL Agrif_ParentGrid_To_ChildGrid()
186         IF( ln_diaobs )   CALL dia_obs_wri
187         IF( ln_timing )   CALL timing_finalize
188         CALL Agrif_ChildGrid_To_ParentGrid()
189      ENDIF
190      !
191# else
192      !
193      IF( .NOT.ln_diurnal_only ) THEN                 !==  Standard time-stepping  ==!
194         !
195         DO WHILE( istp <= nitend .AND. nstop == 0 )
196
197            ncom_stp = istp
198            IF( ln_timing ) THEN
199               zstptiming = MPI_Wtime()
200               IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming
201               IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time
202            ENDIF
203           
204            CALL stp        ( istp ) 
205            istp = istp + 1
206
207            IF( lwp .AND. ln_timing )   WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming
208
209         END DO
210         !
211      ELSE                                            !==  diurnal SST time-steeping only  ==!
212         !
213         DO WHILE( istp <= nitend .AND. nstop == 0 )
214            CALL stp_diurnal( istp )   ! time step only the diurnal SST
215            istp = istp + 1
216         END DO
217         !
218      ENDIF
219      !
220# endif
221      !
222#endif
223      !
224      IF( ln_diaobs   )   CALL dia_obs_wri
225      !
226      IF( ln_icebergs )   CALL icb_end( nitend )
227
228      !                            !------------------------!
229      !                            !==  finalize the run  ==!
230      !                            !------------------------!
231      IF(lwp) WRITE(numout,cform_aaa)        ! Flag AAAAAAA
232      !
233      IF( nstop /= 0 .AND. lwp ) THEN        ! error print
234         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
235         CALL ctl_stop( ctmp1 )
236      ENDIF
237      !
238      IF( ln_timing )   CALL timing_finalize
239      !
240      CALL nemo_closefile
241      !
242#if defined key_iomput
243                                    CALL xios_finalize  ! end mpp communications with xios
244      IF( lk_oasis     )            CALL cpl_finalize   ! end coupling and mpp communications with OASIS
245#else
246      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS
247      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications
248      ENDIF
249#endif
250      !
251      IF(lwm) THEN
252         IF( nstop == 0 ) THEN   ;   STOP 0
253         ELSE                    ;   STOP 123
254         ENDIF
255      ENDIF
256      !
257   END SUBROUTINE nemo_gcm
258
259
260   SUBROUTINE nemo_init
261      !!----------------------------------------------------------------------
262      !!                     ***  ROUTINE nemo_init  ***
263      !!
264      !! ** Purpose :   initialization of the NEMO GCM
265      !!----------------------------------------------------------------------
266      INTEGER ::   ios, ilocal_comm   ! local integers
267      !!
268      NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             &
269         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
270         &             ln_timing, ln_diacfl
271      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
272      !!----------------------------------------------------------------------
273      !
274      cxios_context = 'nemo'
275      !
276      !                             !-------------------------------------------------!
277      !                             !     set communicator & select the local rank    !
278      !                             !  must be done as soon as possible to get narea  !
279      !                             !-------------------------------------------------!
280      !
281#if defined key_iomput
282      IF( Agrif_Root() ) THEN
283         IF( lk_oasis ) THEN
284            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis
285            CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios
286         ELSE
287            CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios
288         ENDIF
289      ENDIF
290      CALL mpp_start( ilocal_comm )
291#else
292      IF( lk_oasis ) THEN
293         IF( Agrif_Root() ) THEN
294            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis
295         ENDIF
296         CALL mpp_start( ilocal_comm )
297      ELSE
298         CALL mpp_start( )
299      ENDIF
300#endif
301      !
302      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 )
303      lwm = (narea == 1)                ! control of output namelists
304      !
305      !                             !---------------------------------------------------------------!
306      !                             ! Open output files, reference and configuration namelist files !
307      !                             !---------------------------------------------------------------!
308      !
309      ! open ocean.output as soon as possible to get all output prints (including errors messages)
310      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
311      ! open reference and configuration namelist files
312                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
313                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
314      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
315      ! open /dev/null file to be able to supress output write easily
316                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
317      !
318      !                             !--------------------!
319      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp
320      !                             !--------------------!
321      !
322      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
323901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
324      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
325902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
326      !
327      ! finalize the definition of namctl variables
328      IF( sn_cfctl%l_allon ) THEN
329         ! Turn on all options.
330         CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. )
331         ! Ensure all processors are active
332         sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1
333      ELSEIF( sn_cfctl%l_config ) THEN
334         ! Activate finer control of report outputs
335         ! optionally switch off output from selected areas (note this only
336         ! applies to output which does not involve global communications)
337         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
338           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
339           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
340      ELSE
341         ! turn off all options.
342         CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. )
343      ENDIF
344      !
345      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print
346      !
347      IF(lwp) THEN                      ! open listing units
348         !
349         IF( .NOT. lwm )   &            ! alreay opened for narea == 1
350            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
351         !
352         WRITE(numout,*)
353         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
354         WRITE(numout,*) '                       NEMO team'
355         WRITE(numout,*) '            Ocean General Circulation Model'
356         WRITE(numout,*) '                NEMO version 4.0  (2019) '
357         WRITE(numout,*)
358         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
359         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
360         WRITE(numout,*)
361         WRITE(numout,*) "           o         _,           _,             "
362         WRITE(numout,*) "            o      .' (        .-' /             "
363         WRITE(numout,*) "           o     _/..._'.    .'   /              "
364         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
365         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
366         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
367         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
368         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
369         WRITE(numout,*) "       )  ) jgs                     `    (   (   "
370         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
371         WRITE(numout,*)
372         !
373         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
374         !
375      ENDIF
376      !
377      IF(lwm) WRITE( numond, namctl )
378      !
379      !                             !------------------------------------!
380      !                             !  Set global domain size parameters !
381      !                             !------------------------------------!
382      !
383      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
384903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
385      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
386904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
387      !
388      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file
389         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
390      ELSE                              ! user-defined namelist
391         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
392      ENDIF
393      !
394      IF(lwm)   WRITE( numond, namcfg )
395      !
396      !                             !-----------------------------------------!
397      !                             ! mpp parameters and domain decomposition !
398      !                             !-----------------------------------------!
399      CALL mpp_init
400
401      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
402      CALL nemo_alloc()
403
404      ! Initialise time level indices
405      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa
406
407      !                             !-------------------------------!
408      !                             !  NEMO general initialization  !
409      !                             !-------------------------------!
410
411      CALL nemo_ctl                          ! Control prints
412      !
413      !                                      ! General initialization
414      IF( ln_timing    )   CALL timing_init     ! timing
415      IF( ln_timing    )   CALL timing_start( 'nemo_init')
416      !
417                           CALL     phy_cst         ! Physical constants
418                           CALL     eos_init        ! Equation of state
419      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration
420                           CALL     wad_init        ! Wetting and drying options
421                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain
422      IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization
423      IF( sn_cfctl%l_prtctl )   &
424         &                 CALL prt_ctl_init        ! Print control
425     
426                           CALL diurnal_sst_bulk_init       ! diurnal sst
427      IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin   
428      !                           
429      IF( ln_diurnal_only ) THEN                    ! diurnal only: a subset of the initialisation routines
430         CALL  istate_init( Nbb, Nnn, Naa )         ! ocean initial state (Dynamics and tracers)
431         CALL     sbc_init( Nbb, Nnn, Naa )         ! Forcings : surface module
432         CALL tra_qsr_init                          ! penetrative solar radiation qsr
433         IF( ln_diaobs ) THEN                       ! Observation & model comparison
434            CALL dia_obs_init( Nnn )                ! Initialize observational data
435            CALL dia_obs( nit000 - 1, Nnn )         ! Observation operator for restart
436         ENDIF     
437         IF( lk_asminc )   CALL asm_inc_init( Nbb, Nnn, Nrhs )   ! Assimilation increments
438         !
439         RETURN                                       ! end of initialization
440      ENDIF
441      !
442     
443                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers)
444
445      !                                      ! external forcing
446                           CALL    tide_init                     ! tidal harmonics
447                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice)
448                           CALL     bdy_init                     ! Open boundaries initialisation
449
450      !                                      ! Ocean physics
451                           CALL zdf_phy_init( Nnn )    ! Vertical physics
452                                     
453      !                                         ! Lateral physics
454                           CALL ldf_tra_init      ! Lateral ocean tracer physics
455                           CALL ldf_eiv_init      ! eddy induced velocity param.
456                           CALL ldf_dyn_init      ! Lateral ocean momentum physics
457
458      !                                      ! Active tracers
459      IF( ln_traqsr    )   CALL tra_qsr_init      ! penetrative solar radiation qsr
460                           CALL tra_bbc_init      ! bottom heat flux
461                           CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme
462                           CALL tra_dmp_init      ! internal tracer damping
463                           CALL tra_adv_init      ! horizontal & vertical advection
464                           CALL tra_ldf_init      ! lateral mixing
465
466      !                                      ! Dynamics
467      IF( lk_c1d       )   CALL dyn_dmp_init         ! internal momentum damping
468                           CALL dyn_adv_init         ! advection (vector or flux form)
469                           CALL dyn_vor_init         ! vorticity term including Coriolis
470                           CALL dyn_ldf_init         ! lateral mixing
471                           CALL dyn_hpg_init( Nnn )  ! horizontal gradient of Hydrostatic pressure
472                           CALL dyn_spg_init         ! surface pressure gradient
473
474#if defined key_top
475      !                                      ! Passive tracers
476                           CALL     trc_init( Nbb, Nnn, Naa )
477#endif
478      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing
479
480      !                                      ! Icebergs
481                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance
482
483                                                ! ice shelf
484                           CALL isf_init( Nbb, Nnn, Naa )
485
486      !                                      ! Misc. options
487                           CALL sto_par_init    ! Stochastic parametrization
488      IF( ln_sto_eos   )   CALL sto_pts_init    ! RRandom T/S fluctuations
489     
490      !                                      ! Diagnostics
491                           CALL     flo_init( Nnn )    ! drifting Floats
492      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics
493!                           CALL dia_ptr_init    ! Poleward TRansports initialization
494                           CALL dia_dct_init    ! Sections tranports
495                           CALL dia_hsb_init( Nnn )    ! heat content, salt content and volume budgets
496                           CALL     trd_init( Nnn )    ! Mixed-layer/Vorticity/Integral constraints trends
497                           CALL dia_obs_init( Nnn )    ! Initialize observational data
498                           CALL dia_25h_init( Nbb )    ! 25h mean  outputs
499                           CALL dia_detide_init ! Weights computation for daily detiding of model diagnostics
500      IF( ln_diaobs    )   CALL dia_obs( nit000-1, Nnn )   ! Observation operator for restart
501                           CALL dia_mlr_init    ! Initialisation of IOM context management for multiple-linear-regression analysis
502
503      !                                      ! Assimilation increments
504      IF( lk_asminc    )   CALL asm_inc_init( Nbb, Nnn, Nrhs )   ! Initialize assimilation increments
505      !
506      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
507      !
508      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
509      !
510   END SUBROUTINE nemo_init
511
512
513   SUBROUTINE nemo_ctl
514      !!----------------------------------------------------------------------
515      !!                     ***  ROUTINE nemo_ctl  ***
516      !!
517      !! ** Purpose :   control print setting
518      !!
519      !! ** Method  : - print namctl and namcfg information and check some consistencies
520      !!----------------------------------------------------------------------
521      !
522      IF(lwp) THEN                  ! control print
523         WRITE(numout,*)
524         WRITE(numout,*) 'nemo_ctl: Control prints'
525         WRITE(numout,*) '~~~~~~~~'
526         WRITE(numout,*) '   Namelist namctl'
527         WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk
528         WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon
529         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
530         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
531         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
532         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
533         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
534         WRITE(numout,*) '                              sn_cfctl%l_prtctl  = ', sn_cfctl%l_prtctl
535         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc
536         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout
537         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
538         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
539         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
540         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
541         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
542         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
543         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
544         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
545         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
546         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
547         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
548         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
549         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
550      ENDIF
551      !
552      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
553      nictls    = nn_ictls
554      nictle    = nn_ictle
555      njctls    = nn_jctls
556      njctle    = nn_jctle
557      isplt     = nn_isplt
558      jsplt     = nn_jsplt
559
560      IF(lwp) THEN                  ! control print
561         WRITE(numout,*)
562         WRITE(numout,*) '   Namelist namcfg'
563         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
564         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
565         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
566         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
567         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
568         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
569      ENDIF
570      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
571      !
572      !                             ! Parameter control
573      !
574      IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints
575         IF( lk_mpp .AND. jpnij > 1 ) THEN
576            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
577         ELSE
578            IF( isplt == 1 .AND. jsplt == 1  ) THEN
579               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
580                  &           ' - the print control will be done over the whole domain' )
581            ENDIF
582            ijsplt = isplt * jsplt            ! total number of processors ijsplt
583         ENDIF
584         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
585         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
586         !
587         !                              ! indices used for the SUM control
588         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
589            lsp_area = .FALSE.
590         ELSE                                             ! print control done over a specific  area
591            lsp_area = .TRUE.
592            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
593               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
594               nictls = 1
595            ENDIF
596            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
597               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
598               nictle = jpiglo
599            ENDIF
600            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
601               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
602               njctls = 1
603            ENDIF
604            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
605               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
606               njctle = jpjglo
607            ENDIF
608         ENDIF
609      ENDIF
610      !
611      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
612         &                                                'Compile with key_nosignedzero enabled:',   &
613         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
614      !
615#if defined key_agrif
616      IF( ln_timing )   CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
617#endif
618      !
619   END SUBROUTINE nemo_ctl
620
621
622   SUBROUTINE nemo_closefile
623      !!----------------------------------------------------------------------
624      !!                     ***  ROUTINE nemo_closefile  ***
625      !!
626      !! ** Purpose :   Close the files
627      !!----------------------------------------------------------------------
628      !
629      IF( lk_mpp )   CALL mppsync
630      !
631      CALL iom_close                                 ! close all input/output files managed by iom_*
632      !
633      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
634      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
635      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
636      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
637      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
638      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
639      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
640      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
641      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
642      !
643      numout = 6                                     ! redefine numout in case it is used after this point...
644      !
645   END SUBROUTINE nemo_closefile
646
647
648   SUBROUTINE nemo_alloc
649      !!----------------------------------------------------------------------
650      !!                     ***  ROUTINE nemo_alloc  ***
651      !!
652      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
653      !!
654      !! ** Method  :
655      !!----------------------------------------------------------------------
656      USE diawri    , ONLY : dia_wri_alloc
657      USE dom_oce   , ONLY : dom_oce_alloc
658      USE trc_oce   , ONLY : trc_oce_alloc
659      USE bdy_oce   , ONLY : bdy_oce_alloc
660      !
661      INTEGER :: ierr
662      !!----------------------------------------------------------------------
663      !
664      ierr =        oce_alloc    ()    ! ocean
665      ierr = ierr + dia_wri_alloc()
666      ierr = ierr + dom_oce_alloc()    ! ocean domain
667      ierr = ierr + zdf_oce_alloc()    ! ocean vertical physics
668      ierr = ierr + trc_oce_alloc()    ! shared TRC / TRA arrays
669      ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization)
670      !
671      CALL mpp_sum( 'nemogcm', ierr )
672      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
673      !
674   END SUBROUTINE nemo_alloc
675
676   
677   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
678      !!----------------------------------------------------------------------
679      !!                     ***  ROUTINE nemo_set_cfctl  ***
680      !!
681      !! ** Purpose :   Set elements of the output control structure to setto.
682      !!                for_all should be .false. unless all areas are to be
683      !!                treated identically.
684      !!
685      !! ** Method  :   Note this routine can be used to switch on/off some
686      !!                types of output for selected areas but any output types
687      !!                that involve global communications (e.g. mpp_max, glob_sum)
688      !!                should be protected from selective switching by the
689      !!                for_all argument
690      !!----------------------------------------------------------------------
691      LOGICAL :: setto, for_all
692      TYPE(sn_ctl) :: sn_cfctl
693      !!----------------------------------------------------------------------
694      IF( for_all ) THEN
695         sn_cfctl%l_runstat = setto
696         sn_cfctl%l_trcstat = setto
697      ENDIF
698      sn_cfctl%l_oceout  = setto
699      sn_cfctl%l_layout  = setto
700      sn_cfctl%l_prtctl  = setto
701      sn_cfctl%l_prttrc  = setto
702      sn_cfctl%l_oasout  = setto
703   END SUBROUTINE nemo_set_cfctl
704
705   !!======================================================================
706END MODULE nemogcm
707
Note: See TracBrowser for help on using the repository browser.