source: NEMO/trunk/src/SAS/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: 27.4 KB
Line 
1MODULE nemogcm
2   !!======================================================================
3   !!                       ***  MODULE nemogcm   ***
4   !! StandAlone Surface module : surface fluxes + sea-ice + iceberg floats
5   !!======================================================================
6   !! History :  3.6  ! 2011-11  (S. Alderson, G. Madec) original code
7   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication
8   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
9   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
14   !!   nemo_init     : initialization of the NEMO system
15   !!   nemo_ctl      : initialisation of the contol print
16   !!   nemo_closefile: close remaining open files
17   !!   nemo_alloc    : dynamical allocation
18   !!----------------------------------------------------------------------
19   USE step_oce       ! module used in the ocean time stepping module
20   USE sbc_oce        ! surface boundary condition: ocean
21   USE phycst         ! physical constant                  (par_cst routine)
22   USE domain         ! domain initialization   (dom_init & dom_cfg routines)
23   USE closea         ! treatment of closed seas (for ln_closea)
24   USE usrdef_nam     ! user defined configuration
25   USE daymod         ! calendar
26   USE restart        ! open  restart file
27   USE step           ! NEMO time-stepping                 (stp     routine)
28   USE cpl_oasis3     !
29   USE sbcssm         !
30   USE icbini         ! handle bergs, initialisation
31   USE icbstp         ! handle bergs, calving, themodynamics and transport
32   USE bdyini         ! open boundary cond. setting       (bdy_init routine). mandatory for sea-ice
33   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine). mandatory for sea-ice
34   !
35   USE lib_mpp        ! distributed memory computing
36   USE mppini         ! shared/distributed memory setting (mpp_init routine)
37   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges
38   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
39#if defined key_iomput
40   USE xios           ! xIOserver
41#endif
42#if defined key_agrif && defined key_si3
43   USE agrif_ice_update ! ice update
44#endif
45
46   IMPLICIT NONE
47   PRIVATE
48
49   PUBLIC   nemo_gcm    ! called by model.F90
50   PUBLIC   nemo_init   ! needed by AGRIF
51
52   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
53
54   !!----------------------------------------------------------------------
55   !! NEMO/SAS 4.0 , NEMO Consortium (2018)
56   !! $Id$
57   !! Software governed by the CeCILL license (see ./LICENSE)
58   !!----------------------------------------------------------------------
59CONTAINS
60
61   SUBROUTINE nemo_gcm
62      !!----------------------------------------------------------------------
63      !!                     ***  ROUTINE nemo_gcm  ***
64      !!
65      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
66      !!              curvilinear mesh on the sphere.
67      !!
68      !! ** Method  : - model general initialization
69      !!              - launch the time-stepping (stp routine)
70      !!              - finalize the run by closing files and communications
71      !!
72      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
73      !!              Madec, 2008, internal report, IPSL.
74      !!----------------------------------------------------------------------
75      INTEGER ::   istp   ! time step index
76      !!----------------------------------------------------------------------
77      !
78#if defined key_agrif
79      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
80#endif
81      !                            !-----------------------!
82      CALL nemo_init               !==  Initialisations  ==!
83      !                            !-----------------------!
84#if defined key_agrif
85      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
86      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA
87# if defined key_top
88      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
89# endif
90# if defined key_si3
91      CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice
92# endif
93#endif
94      ! check that all process are still there... If some process have an error,
95      ! they will never enter in step and other processes will wait until the end of the cpu time!
96      CALL mpp_max( 'nemogcm', nstop )
97
98      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
99
100      !                            !-----------------------!
101      !                            !==   time stepping   ==!
102      !                            !-----------------------!
103      istp = nit000
104      !
105#if defined key_agrif
106      !                                               !==  AGRIF time-stepping  ==!
107      CALL Agrif_Regrid()
108      !
109#if defined key_si3
110      ! Recursive update from highest nested level to lowest:
111      CALL Agrif_step_child_adj(Agrif_update_ice)
112#endif
113      !
114      DO WHILE( istp <= nitend .AND. nstop == 0 )
115         CALL stp
116         istp = istp + 1
117      END DO
118      !
119      IF( .NOT. Agrif_Root() ) THEN
120         CALL Agrif_ParentGrid_To_ChildGrid()
121         IF( ln_timing )   CALL timing_finalize
122         CALL Agrif_ChildGrid_To_ParentGrid()
123      ENDIF
124      !
125#else
126      !
127      IF( .NOT.ln_diurnal_only ) THEN                 !==  Standard time-stepping  ==!
128         !
129         DO WHILE( istp <= nitend .AND. nstop == 0 )
130            CALL stp        ( istp ) 
131            istp = istp + 1
132         END DO
133         !
134      ELSE                                            !==  diurnal SST time-steeping only  ==!
135         !
136         DO WHILE( istp <= nitend .AND. nstop == 0 )
137            CALL stp_diurnal( istp )   ! time step only the diurnal SST
138            istp = istp + 1
139         END DO
140         !
141      ENDIF
142      !
143#endif
144      !
145      IF( ln_icebergs )   CALL icb_end( nitend )
146
147      !                            !------------------------!
148      !                            !==  finalize the run  ==!
149      !                            !------------------------!
150      IF(lwp) WRITE(numout,cform_aaa)        ! Flag AAAAAAA
151      !
152      IF( nstop /= 0 .AND. lwp ) THEN        ! error print
153         WRITE(numout,cform_err)
154         WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
155         WRITE(numout,*)
156      ENDIF
157      !
158      IF( ln_timing )   CALL timing_finalize
159      !
160      CALL nemo_closefile
161      !
162#if defined key_iomput
163                                    CALL xios_finalize  ! end mpp communications with xios
164      IF( lk_oasis     )            CALL cpl_finalize   ! end coupling and mpp communications with OASIS
165#else
166      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS
167      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications
168      ENDIF
169#endif
170      !
171   END SUBROUTINE nemo_gcm
172
173
174   SUBROUTINE nemo_init
175      !!----------------------------------------------------------------------
176      !!                     ***  ROUTINE nemo_init  ***
177      !!
178      !! ** Purpose :   initialization of the NEMO GCM
179      !!----------------------------------------------------------------------
180      INTEGER  ::   ji                 ! dummy loop indices
181      INTEGER  ::   ios, ilocal_comm   ! local integers
182      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
183      CHARACTER(len=80)                 ::   clname
184      !!
185      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
186         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
187         &             ln_timing, ln_diacfl
188      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
189      !!----------------------------------------------------------------------
190      !
191      cltxt  = ''
192      cltxt2 = ''
193      clnam  = '' 
194      cxios_context = 'nemo'
195      !
196      !                             ! Open reference namelist and configuration namelist files
197      IF( lk_oasis ) THEN
198         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
199         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
200         cxios_context = 'sas'
201         clname = 'output.namelist_sas.dyn'
202      ELSE
203         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
204         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
205         cxios_context = 'nemo'
206         clname = 'output.namelist.dyn'
207   ENDIF
208      !
209      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
210      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
211901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
212      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
213      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
214902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
215      !
216      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
217      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
218903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
219      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
220      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
221904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
222
223      !                             !--------------------------!
224      !                             !  Set global domain size  !   (control print return in cltxt2)
225      !                             !--------------------------!
226      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
227         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
228         !
229      ELSE                                ! user-defined namelist
230         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
231      ENDIF
232      !
233      !
234      !                             !--------------------------------------------!
235      !                             !  set communicator & select the local node  !
236      !                             !  NB: mynode also opens output.namelist.dyn !
237      !                             !      on unit number numond on first proc   !
238      !                             !--------------------------------------------!
239#if defined key_iomput
240      IF( Agrif_Root() ) THEN
241         IF( lk_oasis ) THEN
242            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis
243            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
244         ELSE
245            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
246         ENDIF
247      ENDIF
248      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection
249#else
250      IF( lk_oasis ) THEN
251         IF( Agrif_Root() ) THEN
252            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis
253         ENDIF
254         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
255      ELSE
256         ilocal_comm = 0
257         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
258      ENDIF
259#endif
260
261      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
262
263      IF( sn_cfctl%l_config ) THEN
264         ! Activate finer control of report outputs
265         ! optionally switch off output from selected areas (note this only
266         ! applies to output which does not involve global communications)
267         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
268           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
269           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
270      ELSE
271         ! Use ln_ctl to turn on or off all options.
272         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
273      ENDIF
274
275      lwm = (narea == 1)                                    ! control of output namelists
276      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
277
278      IF(lwm) THEN               ! write merged namelists from earlier to output namelist
279         !                       ! now that the file has been opened in call to mynode.
280         !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)
281         WRITE( numond, namctl )
282         WRITE( numond, namcfg )
283         IF( .NOT.ln_read_cfg ) THEN
284            DO ji = 1, SIZE(clnam)
285               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print
286            END DO
287         ENDIF
288      ENDIF
289
290      IF(lwp) THEN                            ! open listing units
291         !
292         IF( lk_oasis ) THEN   ;   CALL ctl_opn( numout,   'sas.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea )
293         ELSE                  ;   CALL ctl_opn( numout, 'ocean.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea )
294         ENDIF
295         !
296         WRITE(numout,*)
297         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
298         WRITE(numout,*) '                       NEMO team'
299         WRITE(numout,*) '            Ocean General Circulation Model'
300         WRITE(numout,*) '                NEMO version 4.0  (2019) '
301         WRITE(numout,*) '             StandAlone Surface version (SAS) '
302         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
303         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
304         WRITE(numout,*)
305         WRITE(numout,*) "           o         _,           _,             "
306         WRITE(numout,*) "            o      .' (        .-' /             "
307         WRITE(numout,*) "           o     _/..._'.    .'   /              "
308         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
309         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
310         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
311         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
312         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
313         WRITE(numout,*) "       )  )                        `     (   (   "
314         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
315         WRITE(numout,*)
316         DO ji = 1, SIZE(cltxt)
317            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode
318         END DO
319         WRITE(numout,*)
320         WRITE(numout,*)
321         DO ji = 1, SIZE(cltxt2)
322            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size
323         END DO
324         !
325         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
326         !
327      ENDIF
328      ! open /dev/null file to be able to supress output write easily
329      CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
330      !
331      !                                      ! Domain decomposition
332      CALL mpp_init                          ! MPP
333
334      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
335      CALL nemo_alloc()
336
337      !                             !-------------------------------!
338      !                             !  NEMO general initialization  !
339      !                             !-------------------------------!
340
341      CALL nemo_ctl                          ! Control prints
342      !
343      !                                      ! General initialization
344      IF( ln_timing    )   CALL timing_init     ! timing
345      IF( ln_timing    )   CALL timing_start( 'nemo_init')
346
347                           CALL phy_cst         ! Physical constants
348                           CALL eos_init        ! Equation of seawater
349                           CALL dom_init('SAS') ! Domain
350      IF( ln_ctl      )    CALL prt_ctl_init    ! Print control
351     
352                           CALL day_init        ! model calendar (using both namelist and restart infos)
353      IF( ln_rstart )      CALL rst_read_open
354
355      !                                      ! external forcing
356                           CALL sbc_init        ! Forcings : surface module
357
358      ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from 
359      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
360      !           This is not clean and should be changed in the future.
361                           CALL bdy_init
362      ! ==>
363                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance
364      !
365      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
366      !
367      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
368      !
369   END SUBROUTINE nemo_init
370
371
372   SUBROUTINE nemo_ctl
373      !!----------------------------------------------------------------------
374      !!                     ***  ROUTINE nemo_ctl  ***
375      !!
376      !! ** Purpose :   control print setting
377      !!
378      !! ** Method  : - print namctl information and check some consistencies
379      !!----------------------------------------------------------------------
380      !
381      IF(lwp) THEN                  ! control print
382         WRITE(numout,*)
383         WRITE(numout,*) 'nemo_ctl: Control prints'
384         WRITE(numout,*) '~~~~~~~~'
385         WRITE(numout,*) '   Namelist namctl'
386         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
387         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
388         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
389         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
390         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
391         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
392         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
393         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
394         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
395         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
396         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
397         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
398         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
399         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
400         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
401         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
402         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
403         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
404         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
405         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
406         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
407      ENDIF
408      !
409      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
410      nictls    = nn_ictls
411      nictle    = nn_ictle
412      njctls    = nn_jctls
413      njctle    = nn_jctle
414      isplt     = nn_isplt
415      jsplt     = nn_jsplt
416
417      IF(lwp) THEN                  ! control print
418         WRITE(numout,*)
419         WRITE(numout,*) '   Namelist namcfg'
420         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
421         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
422         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
423         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
424         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
425         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
426      ENDIF
427      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
428      !
429      !                             ! Parameter control
430      !
431      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
432         IF( lk_mpp .AND. jpnij > 1 ) THEN
433            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
434         ELSE
435            IF( isplt == 1 .AND. jsplt == 1  ) THEN
436               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
437                  &           ' - the print control will be done over the whole domain' )
438            ENDIF
439            ijsplt = isplt * jsplt            ! total number of processors ijsplt
440         ENDIF
441         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
442         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
443         !
444         !                              ! indices used for the SUM control
445         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
446            lsp_area = .FALSE.
447         ELSE                                             ! print control done over a specific  area
448            lsp_area = .TRUE.
449            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
450               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
451               nictls = 1
452            ENDIF
453            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
454               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
455               nictle = jpiglo
456            ENDIF
457            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
458               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
459               njctls = 1
460            ENDIF
461            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
462               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
463               njctle = jpjglo
464            ENDIF
465         ENDIF
466      ENDIF
467      !
468      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
469         &                                                'Compile with key_nosignedzero enabled' )
470      !
471#if defined key_agrif
472      IF( ln_timing )   CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
473#endif
474      !
475   END SUBROUTINE nemo_ctl
476
477
478   SUBROUTINE nemo_closefile
479      !!----------------------------------------------------------------------
480      !!                     ***  ROUTINE nemo_closefile  ***
481      !!
482      !! ** Purpose :   Close the files
483      !!----------------------------------------------------------------------
484      !
485      IF( lk_mpp )   CALL mppsync
486      !
487      CALL iom_close                                 ! close all input/output files managed by iom_*
488      !
489      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file     
490      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
491      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
492      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
493      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
494      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
495      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
496      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
497      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
498      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
499      !
500      numout = 6                                     ! redefine numout in case it is used after this point...
501      !
502   END SUBROUTINE nemo_closefile
503
504
505   SUBROUTINE nemo_alloc
506      !!----------------------------------------------------------------------
507      !!                     ***  ROUTINE nemo_alloc  ***
508      !!
509      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
510      !!
511      !! ** Method  :
512      !!----------------------------------------------------------------------
513      USE diawri    , ONLY : dia_wri_alloc
514      USE dom_oce   , ONLY : dom_oce_alloc
515      USE bdy_oce   , ONLY : ln_bdy, bdy_oce_alloc
516      USE oce       ! mandatory for sea-ice because needed for bdy arrays
517      !
518      INTEGER :: ierr
519      !!----------------------------------------------------------------------
520      !
521      ierr =        dia_wri_alloc()
522      ierr = ierr + dom_oce_alloc()          ! ocean domain
523      ierr = ierr + oce_alloc    ()          ! (tsn...) needed for agrif and/or SI3 and bdy
524      ierr = ierr + bdy_oce_alloc()          ! bdy masks (incl. initialization)
525      !
526      CALL mpp_sum( 'nemogcm', ierr )
527      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
528      !
529   END SUBROUTINE nemo_alloc
530
531   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
532      !!----------------------------------------------------------------------
533      !!                     ***  ROUTINE nemo_set_cfctl  ***
534      !!
535      !! ** Purpose :   Set elements of the output control structure to setto.
536      !!                for_all should be .false. unless all areas are to be
537      !!                treated identically.
538      !!
539      !! ** Method  :   Note this routine can be used to switch on/off some
540      !!                types of output for selected areas but any output types
541      !!                that involve global communications (e.g. mpp_max, glob_sum)
542      !!                should be protected from selective switching by the
543      !!                for_all argument
544      !!----------------------------------------------------------------------
545      LOGICAL :: setto, for_all
546      TYPE (sn_ctl) :: sn_cfctl
547      !!----------------------------------------------------------------------
548      IF( for_all ) THEN
549         sn_cfctl%l_runstat = setto
550         sn_cfctl%l_trcstat = setto
551      ENDIF
552      sn_cfctl%l_oceout  = setto
553      sn_cfctl%l_layout  = setto
554      sn_cfctl%l_mppout  = setto
555      sn_cfctl%l_mpptop  = setto
556   END SUBROUTINE nemo_set_cfctl
557
558   !!======================================================================
559END MODULE nemogcm
560
Note: See TracBrowser for help on using the repository browser.