New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
nemogcm.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/nemogcm.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only
  • Property svn:keywords set to Id
File size: 35.8 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 diu_layers     ! diurnal bulk SST and coolskin
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,*) "       )  ) jgs                     `    (   (   "
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      ! Initialise time level indices
404      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa
405
406      ! Initialisation of temporary pointers (to be deleted after development finished)
407      CALL update_pointers( Nbb, Nnn, Naa )
408      !                             !-------------------------------!
409      !                             !  NEMO general initialization  !
410      !                             !-------------------------------!
411
412      CALL nemo_ctl                          ! Control prints
413      !
414      !                                      ! General initialization
415      IF( ln_timing    )   CALL timing_init     ! timing
416      IF( ln_timing    )   CALL timing_start( 'nemo_init')
417      !
418                           CALL     phy_cst         ! Physical constants
419                           CALL     eos_init        ! Equation of state
420      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration
421                           CALL     wad_init        ! Wetting and drying options
422                           CALL     dom_init("OPA") ! Domain
423      IF( ln_crs       )   CALL     crs_init        ! coarsened grid: domain initialization
424      IF( ln_ctl       )   CALL prt_ctl_init        ! Print control
425     
426      CALL diurnal_sst_bulk_init                ! diurnal sst
427      IF( ln_diurnal   )   CALL diurnal_sst_coolskin_init   ! cool skin   
428      !                           
429      IF( ln_diurnal_only ) THEN                   ! diurnal only: a subset of the initialisation routines
430         CALL  istate_init( Nbb, Nnn, Naa )           ! ocean initial state (Dynamics and tracers)
431         CALL     sbc_init( Nbb, Nnn )                ! Forcings : surface module
432         CALL tra_qsr_init                            ! penetrative solar radiation qsr
433         IF( ln_diaobs ) THEN                         ! Observation & model comparison
434            CALL dia_obs_init( Nnn )                     ! Initialize observational data
435            CALL dia_obs( nit000 - 1, Nnn )              ! Observation operator for restart
436         ENDIF     
437         IF( lk_asminc )   CALL asm_inc_init          ! Assimilation increments
438         !
439         RETURN                                       ! end of initialization
440      ENDIF
441     
442                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers)
443
444      !                                      ! external forcing
445                           CALL    tide_init             ! tidal harmonics
446                           CALL     sbc_init( Nbb, Nnn ) ! surface boundary conditions (including sea-ice)
447                           CALL     bdy_init             ! Open boundaries initialisation
448
449      !                                      ! Ocean physics
450                           CALL zdf_phy_init( Nnn )    ! Vertical physics
451                                     
452      !                                         ! Lateral physics
453                           CALL ldf_tra_init      ! Lateral ocean tracer physics
454                           CALL ldf_eiv_init      ! eddy induced velocity param.
455                           CALL ldf_dyn_init      ! Lateral ocean momentum physics
456
457      !                                      ! Active tracers
458      IF( ln_traqsr    )   CALL tra_qsr_init      ! penetrative solar radiation qsr
459                           CALL tra_bbc_init      ! bottom heat flux
460                           CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme
461                           CALL tra_dmp_init      ! internal tracer damping
462                           CALL tra_adv_init      ! horizontal & vertical advection
463                           CALL tra_ldf_init      ! lateral mixing
464
465      !                                      ! Dynamics
466      IF( lk_c1d       )   CALL dyn_dmp_init         ! internal momentum damping
467                           CALL dyn_adv_init         ! advection (vector or flux form)
468                           CALL dyn_vor_init         ! vorticity term including Coriolis
469                           CALL dyn_ldf_init         ! lateral mixing
470                           CALL dyn_hpg_init( Nnn )  ! horizontal gradient of Hydrostatic pressure
471                           CALL dyn_spg_init         ! surface pressure gradient
472
473#if defined key_top
474      !                                      ! Passive tracers
475                           CALL     trc_init( Nbb, Nnn, Naa )
476#endif
477      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing
478
479      !                                      ! Icebergs
480                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance
481
482      !                                      ! Misc. options
483                           CALL sto_par_init    ! Stochastic parametrization
484      IF( ln_sto_eos   )   CALL sto_pts_init    ! RRandom T/S fluctuations
485     
486      !                                      ! Diagnostics
487      IF( lk_floats    )   CALL     flo_init    ! drifting Floats
488      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics
489                           CALL dia_ptr_init    ! Poleward TRansports initialization
490      IF( lk_diadct    )   CALL dia_dct_init    ! Sections tranports
491                           CALL dia_hsb_init    ! heat content, salt content and volume budgets
492                           CALL     trd_init( Nnn )    ! Mixed-layer/Vorticity/Integral constraints trends
493                           CALL dia_obs_init( Nnn )    ! Initialize observational data
494                           CALL dia_tmb_init    ! TMB outputs
495                           CALL dia_25h_init    ! 25h mean  outputs
496      IF( ln_diaobs    )   CALL dia_obs( nit000-1, Nnn )   ! Observation operator for restart
497
498      !                                      ! Assimilation increments
499      IF( lk_asminc    )   CALL asm_inc_init    ! Initialize assimilation increments
500      !
501      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
502      !
503      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
504      !
505   END SUBROUTINE nemo_init
506
507
508   SUBROUTINE nemo_ctl
509      !!----------------------------------------------------------------------
510      !!                     ***  ROUTINE nemo_ctl  ***
511      !!
512      !! ** Purpose :   control print setting
513      !!
514      !! ** Method  : - print namctl information and check some consistencies
515      !!----------------------------------------------------------------------
516      !
517      IF(lwp) THEN                  ! control print
518         WRITE(numout,*)
519         WRITE(numout,*) 'nemo_ctl: Control prints'
520         WRITE(numout,*) '~~~~~~~~'
521         WRITE(numout,*) '   Namelist namctl'
522         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
523         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
524         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
525         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
526         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
527         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
528         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
529         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
530         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
531         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
532         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
533         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
534         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
535         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
536         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
537         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
538         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
539         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
540         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
541         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
542         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
543      ENDIF
544      !
545      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
546      nictls    = nn_ictls
547      nictle    = nn_ictle
548      njctls    = nn_jctls
549      njctle    = nn_jctle
550      isplt     = nn_isplt
551      jsplt     = nn_jsplt
552
553      IF(lwp) THEN                  ! control print
554         WRITE(numout,*)
555         WRITE(numout,*) '   Namelist namcfg'
556         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
557         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
558         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
559         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
560         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
561         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
562      ENDIF
563      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
564      !
565      !                             ! Parameter control
566      !
567      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
568         IF( lk_mpp .AND. jpnij > 1 ) THEN
569            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
570         ELSE
571            IF( isplt == 1 .AND. jsplt == 1  ) THEN
572               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
573                  &           ' - the print control will be done over the whole domain' )
574            ENDIF
575            ijsplt = isplt * jsplt            ! total number of processors ijsplt
576         ENDIF
577         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
578         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
579         !
580         !                              ! indices used for the SUM control
581         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
582            lsp_area = .FALSE.
583         ELSE                                             ! print control done over a specific  area
584            lsp_area = .TRUE.
585            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
586               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
587               nictls = 1
588            ENDIF
589            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
590               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
591               nictle = jpiglo
592            ENDIF
593            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
594               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
595               njctls = 1
596            ENDIF
597            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
598               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
599               njctle = jpjglo
600            ENDIF
601         ENDIF
602      ENDIF
603      !
604      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
605         &                                                'Compile with key_nosignedzero enabled:',   &
606         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
607      !
608#if defined key_agrif
609      IF( ln_timing )   CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
610#endif
611      !
612   END SUBROUTINE nemo_ctl
613
614
615   SUBROUTINE nemo_closefile
616      !!----------------------------------------------------------------------
617      !!                     ***  ROUTINE nemo_closefile  ***
618      !!
619      !! ** Purpose :   Close the files
620      !!----------------------------------------------------------------------
621      !
622      IF( lk_mpp )   CALL mppsync
623      !
624      CALL iom_close                                 ! close all input/output files managed by iom_*
625      !
626      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
627      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
628      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
629      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
630      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
631      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
632      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
633      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
634      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
635      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
636      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
637      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
638      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
639      !
640      numout = 6                                     ! redefine numout in case it is used after this point...
641      !
642   END SUBROUTINE nemo_closefile
643
644
645   SUBROUTINE nemo_alloc
646      !!----------------------------------------------------------------------
647      !!                     ***  ROUTINE nemo_alloc  ***
648      !!
649      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
650      !!
651      !! ** Method  :
652      !!----------------------------------------------------------------------
653      USE diawri    , ONLY : dia_wri_alloc
654      USE dom_oce   , ONLY : dom_oce_alloc
655      USE trc_oce   , ONLY : trc_oce_alloc
656      USE bdy_oce   , ONLY : bdy_oce_alloc
657#if defined key_diadct 
658      USE diadct    , ONLY : diadct_alloc 
659#endif 
660      !
661      INTEGER :: ierr
662      !!----------------------------------------------------------------------
663      !
664      ierr =        oce_alloc    ()    ! ocean
665      ierr = ierr + dia_wri_alloc()
666      ierr = ierr + dom_oce_alloc()    ! ocean domain
667      ierr = ierr + zdf_oce_alloc()    ! ocean vertical physics
668      ierr = ierr + trc_oce_alloc()    ! shared TRC / TRA arrays
669      ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization)
670      !
671#if defined key_diadct 
672      ierr = ierr + diadct_alloc ()    !
673#endif 
674      !
675      CALL mpp_sum( 'nemogcm', ierr )
676      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
677      !
678   END SUBROUTINE nemo_alloc
679
680   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
681      !!----------------------------------------------------------------------
682      !!                     ***  ROUTINE nemo_set_cfctl  ***
683      !!
684      !! ** Purpose :   Set elements of the output control structure to setto.
685      !!                for_all should be .false. unless all areas are to be
686      !!                treated identically.
687      !!
688      !! ** Method  :   Note this routine can be used to switch on/off some
689      !!                types of output for selected areas but any output types
690      !!                that involve global communications (e.g. mpp_max, glob_sum)
691      !!                should be protected from selective switching by the
692      !!                for_all argument
693      !!----------------------------------------------------------------------
694      LOGICAL :: setto, for_all
695      TYPE(sn_ctl) :: sn_cfctl
696      !!----------------------------------------------------------------------
697      IF( for_all ) THEN
698         sn_cfctl%l_runstat = setto
699         sn_cfctl%l_trcstat = setto
700      ENDIF
701      sn_cfctl%l_oceout  = setto
702      sn_cfctl%l_layout  = setto
703      sn_cfctl%l_mppout  = setto
704      sn_cfctl%l_mpptop  = setto
705   END SUBROUTINE nemo_set_cfctl
706
707   !!======================================================================
708END MODULE nemogcm
709
Note: See TracBrowser for help on using the repository browser.