source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/SAS/nemogcm.F90 @ 11648

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

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Introduce broadcast of namelist character buffer from single reader to all others. This completes the second stage but there is still an issue with AGRIF that may scupper this whole concept

  • Property svn:keywords set to Id
File size: 27.0 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(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
154         CALL ctl_stop( ctmp1 )
155      ENDIF
156      !
157      IF( ln_timing )   CALL timing_finalize
158      !
159      CALL nemo_closefile
160      !
161#if defined key_iomput
162                                    CALL xios_finalize  ! end mpp communications with xios
163      IF( lk_oasis     )            CALL cpl_finalize   ! end coupling and mpp communications with OASIS
164#else
165      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS
166      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications
167      ENDIF
168#endif
169      !
170      IF(lwm) THEN
171         IF( nstop == 0 ) THEN   ;   STOP 0
172         ELSE                    ;   STOP 123
173         ENDIF
174      ENDIF
175      !
176   END SUBROUTINE nemo_gcm
177
178
179   SUBROUTINE nemo_init
180      !!----------------------------------------------------------------------
181      !!                     ***  ROUTINE nemo_init  ***
182      !!
183      !! ** Purpose :   initialization of the NEMO GCM
184      !!----------------------------------------------------------------------
185      INTEGER ::   ios, ilocal_comm   ! local integers
186      !!
187      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
188         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
189         &             ln_timing, ln_diacfl
190      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
191      !!----------------------------------------------------------------------
192      !
193      IF( lk_oasis ) THEN   ;   cxios_context = 'sas'
194      ELSE                  ;   cxios_context = 'nemo'
195      ENDIF
196      !
197      !                             !-------------------------------------------------!
198      !                             !     set communicator & select the local rank    !
199      !                             !  must be done as soon as possible to get narea  !
200      !                             !-------------------------------------------------!
201      !
202#if defined key_iomput
203      IF( Agrif_Root() ) THEN
204         IF( lk_oasis ) THEN
205            CALL cpl_init( "sas", ilocal_comm )                                  ! nemo local communicator given by oasis
206            CALL xios_initialize( "not used",local_comm=ilocal_comm )            ! send nemo communicator to xios
207         ELSE
208            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
209         ENDIF
210      ENDIF
211      CALL mpp_start( ilocal_comm )
212#else
213      IF( lk_oasis ) THEN
214         IF( Agrif_Root() ) THEN
215            CALL cpl_init( "sas", ilocal_comm )             ! nemo local communicator given by oasis
216         ENDIF
217         CALL mpp_start( ilocal_comm )
218      ELSE
219         CALL mpp_start( )
220      ENDIF
221#endif
222      !
223      narea = mpprank + 1                                   ! mpprank: the rank of proc (0 --> mppsize -1 )
224      lwm = (narea == 1)                ! control of output namelists
225      !
226      !                             !---------------------------------------------------------------!
227      !                             ! Open output files, reference and configuration namelist files !
228      !                             !---------------------------------------------------------------!
229      !
230      ! open ocean.output as soon as possible to get all output prints (including errors messages)
231      IF( lk_oasis ) THEN
232         IF( lwm )   CALL ctl_opn(     numout,               'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
233         ! open reference and configuration namelist files
234                     CALL load_nml( numnam_ref,        'namelist_sas_ref',                                           -1, lwm )
235                     CALL load_nml( numnam_cfg,        'namelist_sas_cfg',                                           -1, lwm )
236         IF( lwm )   CALL ctl_opn(      numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
237      ELSE
238         IF( lwm )   CALL ctl_opn(      numout,            'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
239         ! open reference and configuration namelist files
240                     CALL load_nml( numnam_ref,            'namelist_ref',                                           -1, lwm )
241                     CALL load_nml( numnam_cfg,            'namelist_cfg',                                           -1, lwm )
242         IF( lwm )   CALL ctl_opn(      numond,     'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
243      ENDIF
244      ! open /dev/null file to be able to supress output write easily
245                     CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
246      !
247      !                             !--------------------!
248      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp
249      !                             !--------------------!
250      !
251      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
252901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
253      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
254902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
255      !
256      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print
257      !
258      IF(lwp) THEN                      ! open listing units
259         !
260         IF( .NOT. lwm ) THEN           ! alreay opened for narea == 1
261            IF(lk_oasis) THEN   ;   CALL ctl_opn( numout,   'sas.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea )
262            ELSE                ;   CALL ctl_opn( numout, 'ocean.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea )
263            ENDIF
264         ENDIF
265         !
266         WRITE(numout,*)
267         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
268         WRITE(numout,*) '                       NEMO team'
269         WRITE(numout,*) '            Ocean General Circulation Model'
270         WRITE(numout,*) '                NEMO version 4.0  (2019) '
271         WRITE(numout,*) '             StandAlone Surface version (SAS) '
272         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
273         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
274         WRITE(numout,*)
275         WRITE(numout,*) "           o         _,           _,             "
276         WRITE(numout,*) "            o      .' (        .-' /             "
277         WRITE(numout,*) "           o     _/..._'.    .'   /              "
278         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
279         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
280         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
281         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
282         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
283         WRITE(numout,*) "       )  ) jgs                    `     (   (   "
284         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
285         WRITE(numout,*)
286         WRITE(numout,*)
287         !
288         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
289         !
290      ENDIF
291     !
292      ! finalize the definition of namctl variables
293      IF( sn_cfctl%l_config ) THEN
294         ! Activate finer control of report outputs
295         ! optionally switch off output from selected areas (note this only
296         ! applies to output which does not involve global communications)
297         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
298           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
299           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
300      ELSE
301         ! Use ln_ctl to turn on or off all options.
302         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
303      ENDIF
304      !
305      IF(lwm) WRITE( numond, namctl )
306      !
307      !                             !------------------------------------!
308      !                             !  Set global domain size parameters !
309      !                             !------------------------------------!
310      !
311      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
312903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
313      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
314904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
315      !
316      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file
317         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
318      ELSE                              ! user-defined namelist
319         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
320      ENDIF
321      !
322      IF(lwm)   WRITE( numond, namcfg )
323      !
324      !                             !-----------------------------------------!
325      !                             ! mpp parameters and domain decomposition !
326      !                             !-----------------------------------------!
327      CALL mpp_init
328
329      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
330      CALL nemo_alloc()
331
332      !                             !-------------------------------!
333      !                             !  NEMO general initialization  !
334      !                             !-------------------------------!
335
336      CALL nemo_ctl                          ! Control prints
337      !
338      !                                      ! General initialization
339      IF( ln_timing    )   CALL timing_init     ! timing
340      IF( ln_timing    )   CALL timing_start( 'nemo_init')
341
342                           CALL phy_cst         ! Physical constants
343                           CALL eos_init        ! Equation of seawater
344                           CALL dom_init('SAS') ! Domain
345      IF( ln_ctl      )    CALL prt_ctl_init    ! Print control
346     
347                           CALL day_init        ! model calendar (using both namelist and restart infos)
348      IF( ln_rstart )      CALL rst_read_open
349
350      !                                      ! external forcing
351                           CALL sbc_init        ! Forcings : surface module
352
353      ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from 
354      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
355      !           This is not clean and should be changed in the future.
356                           CALL bdy_init
357      ! ==>
358                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance
359      !
360      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
361      !
362      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
363      !
364   END SUBROUTINE nemo_init
365
366
367   SUBROUTINE nemo_ctl
368      !!----------------------------------------------------------------------
369      !!                     ***  ROUTINE nemo_ctl  ***
370      !!
371      !! ** Purpose :   control print setting
372      !!
373      !! ** Method  : - print namctl information and check some consistencies
374      !!----------------------------------------------------------------------
375      !
376      IF(lwp) THEN                  ! control print
377         WRITE(numout,*)
378         WRITE(numout,*) 'nemo_ctl: Control prints'
379         WRITE(numout,*) '~~~~~~~~'
380         WRITE(numout,*) '   Namelist namctl'
381         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
382         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
383         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
384         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
385         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
386         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
387         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
388         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
389         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
390         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
391         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
392         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
393         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
394         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
395         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
396         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
397         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
398         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
399         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
400         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
401         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
402      ENDIF
403      !
404      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
405      nictls    = nn_ictls
406      nictle    = nn_ictle
407      njctls    = nn_jctls
408      njctle    = nn_jctle
409      isplt     = nn_isplt
410      jsplt     = nn_jsplt
411
412      IF(lwp) THEN                  ! control print
413         WRITE(numout,*)
414         WRITE(numout,*) '   Namelist namcfg'
415         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
416         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
417         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
418         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
419         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
420         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
421      ENDIF
422      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
423      !
424      !                             ! Parameter control
425      !
426      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
427         IF( lk_mpp .AND. jpnij > 1 ) THEN
428            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
429         ELSE
430            IF( isplt == 1 .AND. jsplt == 1  ) THEN
431               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
432                  &           ' - the print control will be done over the whole domain' )
433            ENDIF
434            ijsplt = isplt * jsplt            ! total number of processors ijsplt
435         ENDIF
436         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
437         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
438         !
439         !                              ! indices used for the SUM control
440         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
441            lsp_area = .FALSE.
442         ELSE                                             ! print control done over a specific  area
443            lsp_area = .TRUE.
444            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
445               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
446               nictls = 1
447            ENDIF
448            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
449               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
450               nictle = jpiglo
451            ENDIF
452            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
453               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
454               njctls = 1
455            ENDIF
456            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
457               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
458               njctle = jpjglo
459            ENDIF
460         ENDIF
461      ENDIF
462      !
463      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
464         &                                                'Compile with key_nosignedzero enabled:',   &
465         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
466      !
467#if defined key_agrif
468      IF( ln_timing )   CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
469#endif
470      !
471   END SUBROUTINE nemo_ctl
472
473
474   SUBROUTINE nemo_closefile
475      !!----------------------------------------------------------------------
476      !!                     ***  ROUTINE nemo_closefile  ***
477      !!
478      !! ** Purpose :   Close the files
479      !!----------------------------------------------------------------------
480      !
481      IF( lk_mpp )   CALL mppsync
482      !
483      CALL iom_close                                 ! close all input/output files managed by iom_*
484      !
485      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file     
486      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
487      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
488      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
489      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
490      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
491      !
492      numout = 6                                     ! redefine numout in case it is used after this point...
493      !
494   END SUBROUTINE nemo_closefile
495
496
497   SUBROUTINE nemo_alloc
498      !!----------------------------------------------------------------------
499      !!                     ***  ROUTINE nemo_alloc  ***
500      !!
501      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
502      !!
503      !! ** Method  :
504      !!----------------------------------------------------------------------
505      USE diawri    , ONLY : dia_wri_alloc
506      USE dom_oce   , ONLY : dom_oce_alloc
507      USE bdy_oce   , ONLY : ln_bdy, bdy_oce_alloc
508      USE oce       ! mandatory for sea-ice because needed for bdy arrays
509      !
510      INTEGER :: ierr
511      !!----------------------------------------------------------------------
512      !
513      ierr =        dia_wri_alloc()
514      ierr = ierr + dom_oce_alloc()          ! ocean domain
515      ierr = ierr + oce_alloc    ()          ! (tsn...) needed for agrif and/or SI3 and bdy
516      ierr = ierr + bdy_oce_alloc()          ! bdy masks (incl. initialization)
517      !
518      CALL mpp_sum( 'nemogcm', ierr )
519      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
520      !
521   END SUBROUTINE nemo_alloc
522
523   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
524      !!----------------------------------------------------------------------
525      !!                     ***  ROUTINE nemo_set_cfctl  ***
526      !!
527      !! ** Purpose :   Set elements of the output control structure to setto.
528      !!                for_all should be .false. unless all areas are to be
529      !!                treated identically.
530      !!
531      !! ** Method  :   Note this routine can be used to switch on/off some
532      !!                types of output for selected areas but any output types
533      !!                that involve global communications (e.g. mpp_max, glob_sum)
534      !!                should be protected from selective switching by the
535      !!                for_all argument
536      !!----------------------------------------------------------------------
537      LOGICAL :: setto, for_all
538      TYPE(sn_ctl) :: sn_cfctl
539      !!----------------------------------------------------------------------
540      IF( for_all ) THEN
541         sn_cfctl%l_runstat = setto
542         sn_cfctl%l_trcstat = setto
543      ENDIF
544      sn_cfctl%l_oceout  = setto
545      sn_cfctl%l_layout  = setto
546      sn_cfctl%l_mppout  = setto
547      sn_cfctl%l_mpptop  = setto
548   END SUBROUTINE nemo_set_cfctl
549
550   !!======================================================================
551END MODULE nemogcm
552
Note: See TracBrowser for help on using the repository browser.