source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/nemogcm.F90 @ 11624

Last change on this file since 11624 was 11624, checked in by acc, 16 months ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Substantive changes required to replace all namelists with internal files. These are the key changes only; to compile and run tests all REWIND and CLOSE operations on the (no longer) units have to be removed. These changes affect many more files but can be scripted so are not included here in order to make a later merge easier. The scripts used to prepare code for testing are included on: wiki:2019WP/ENHANCE-04_AndrewC-reporting/Internal_Namelists. With these additional changes this code passes most SETTE tests but the AGRIF preprocessor does not currently accept the new allocatable character strings. To be investigated.

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