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

Last change on this file since 10570 was 10570, checked in by acc, 19 months ago

Trunk update to implement finer control over the choice of text report files generated. See ticket: #2167

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