source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/SAS/nemogcm.F90 @ 12460

Last change on this file since 12460 was 12377, checked in by acc, 16 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

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