source: NEMO/branches/UKMO/NEMO_4.0_surge/src/OCE/nemogcm.F90 @ 11180

Last change on this file since 11180 was 11180, checked in by clne, 22 months ago

Initial commit of code for 2d (surge) work in NEMO4.
This is aiming to replicate the 3.6 version in branches/UKMO/dev_r5518_Surge_Modelling

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