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_r11613_ENHANCE-04_namelists_as_internalfiles/src/OFF – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OFF/nemogcm.F90 @ 11624

Last change on this file since 11624 was 11624, checked in by acc, 4 years ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Substantive changes required to replace all namelists with internal files. These are the key changes only; to compile and run tests all REWIND and CLOSE operations on the (no longer) units have to be removed. These changes affect many more files but can be scripted so are not included here in order to make a later merge easier. The scripts used to prepare code for testing are included on: wiki:2019WP/ENHANCE-04_AndrewC-reporting/Internal_Namelists. With these additional changes this code passes most SETTE tests but the AGRIF preprocessor does not currently accept the new allocatable character strings. To be investigated.

  • Property svn:keywords set to Id
File size: 27.8 KB
Line 
1MODULE nemogcm
2   !!======================================================================
3   !!                       ***  MODULE nemogcm   ***
4   !! Off-line Ocean   : passive tracer evolution, dynamics read in files
5   !!======================================================================
6   !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line: phasing with the on-line
7   !!            3.4  ! 2011-01  (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation
8   !!            4.0  ! 2016-10  (C. Ethe, G. Madec, S. Flavoni)  domain configuration / user defined interface
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   nemo_gcm      : off-line: solve ocean tracer only
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   !!   istate_init   : simple initialization to zero of ocean fields
19   !!   stp_ctl       : reduced step control (no dynamics in off-line)
20   !!----------------------------------------------------------------------
21   USE dom_oce        ! ocean space domain variables
22   USE oce            ! dynamics and tracers variables
23   USE trc_oce        ! Shared ocean/passive tracers variables
24   USE c1d            ! 1D configuration
25   USE domain         ! domain initialization from coordinate & bathymetry (dom_init routine)
26   USE closea         ! treatment of closed seas (for ln_closea)
27   USE usrdef_nam     ! user defined configuration
28   USE eosbn2         ! equation of state            (eos bn2 routine)
29   !              ! ocean physics
30   USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine)
31   USE ldfslp         ! slopes of neutral surfaces     (ldf_slp_init routine)
32   USE traqsr         ! solar radiation penetration    (tra_qsr_init routine)
33   USE trabbl         ! bottom boundary layer          (tra_bbl_init routine)
34   USE traldf         ! lateral physics                (tra_ldf_init routine)
35   USE sbcmod         ! surface boundary condition     (sbc_init     routine)
36   USE phycst         ! physical constant                   (par_cst routine)
37   USE dtadyn         ! Lecture and Interpolation of the dynamical fields
38   USE trcini         ! Initilization of the passive tracers
39   USE daymod         ! calendar                            (day     routine)
40   USE trcstp         ! passive tracer time-stepping        (trc_stp routine)
41   USE dtadyn         ! Lecture and interpolation of the dynamical fields
42   !              ! Passive tracers needs
43   USE trc            ! passive tracer : variables
44   USE trcnam         ! passive tracer : namelist
45   USE trcrst         ! passive tracer restart
46   USE diaptr         ! Need to initialise this as some variables are used in if statements later
47   USE sbc_oce , ONLY : ln_rnf
48   USE sbcrnf         ! surface boundary condition : runoffs
49   !              ! I/O & MPP
50   USE iom            ! I/O library
51   USE in_out_manager ! I/O manager
52   USE mppini         ! shared/distributed memory setting (mpp_init routine)
53   USE lib_mpp        ! distributed memory computing
54#if defined key_iomput
55   USE xios           ! xIOserver
56#endif
57   USE prtctl         ! Print control                    (prt_ctl_init routine)
58   USE timing         ! Timing
59   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
60   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges
61
62   IMPLICIT NONE
63   PRIVATE
64   
65   PUBLIC   nemo_gcm   ! called by nemo.F90
66
67   CHARACTER (len=64) ::   cform_aaa="( /, 'AAAAAAAA', / ) "   ! flag for output listing
68
69   !!----------------------------------------------------------------------
70   !! NEMO/OFF 4.0 , NEMO Consortium (2018)
71   !! $Id$
72   !! Software governed by the CeCILL license (see ./LICENSE)
73   !!----------------------------------------------------------------------
74CONTAINS
75
76   SUBROUTINE nemo_gcm
77      !!----------------------------------------------------------------------
78      !!                     ***  ROUTINE nemo_gcm  ***
79      !!
80      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
81      !!              curvilinear mesh on the sphere.
82      !!
83      !! ** Method  : - model general initialization
84      !!              - launch the time-stepping (dta_dyn and trc_stp)
85      !!              - finalize the run by closing files and communications
86      !!
87      !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL.
88      !!              Madec, 2008, internal report, IPSL.
89      !!----------------------------------------------------------------------
90      INTEGER :: istp, indic       ! time step index
91      !!----------------------------------------------------------------------
92
93      CALL nemo_init  ! Initializations
94
95      ! check that all process are still there... If some process have an error,
96      ! they will never enter in step and other processes will wait until the end of the cpu time!
97      CALL mpp_max( 'nemogcm', nstop )
98
99      !                            !-----------------------!
100      !                            !==   time stepping   ==!
101      !                            !-----------------------!
102      istp = nit000
103      !
104      IF( ln_rnf )   CALL sbc_rnf(istp)   ! runoffs initialization
105      !
106      CALL iom_init( cxios_context )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
107      !
108      DO WHILE ( istp <= nitend .AND. nstop == 0 )    !==  OFF time-stepping  ==!
109         !
110         IF( istp /= nit000 )   CALL day        ( istp )         ! Calendar (day was already called at nit000 in day_init)
111                                CALL iom_setkt  ( istp - nit000 + 1, cxios_context )   ! say to iom that we are at time step kstp
112#if defined key_sed_off
113                                CALL dta_dyn_sed( istp )         ! Interpolation of the dynamical fields
114#else
115                                CALL dta_dyn    ( istp )         ! Interpolation of the dynamical fields
116         IF( .NOT.ln_linssh )   CALL dta_dyn_swp( istp )         ! swap of sea  surface height and vertical scale factors
117#endif
118                                CALL trc_stp    ( istp )         ! time-stepping
119                                CALL stp_ctl    ( istp, indic )  ! Time loop: control and print
120         istp = istp + 1
121      END DO
122      !
123#if defined key_iomput
124      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
125#endif
126
127      !                            !------------------------!
128      !                            !==  finalize the run  ==!
129      !                            !------------------------!
130      IF(lwp) WRITE(numout,cform_aaa)                 ! Flag AAAAAAA
131
132      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print
133         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
134         CALL ctl_stop( ctmp1 )
135      ENDIF
136      !
137      IF( ln_timing )   CALL timing_finalize
138      !
139      CALL nemo_closefile
140      !
141#if defined key_iomput
142                     CALL xios_finalize   ! end mpp communications with xios
143#else
144      IF( lk_mpp )   CALL mppstop         ! end mpp communications
145#endif
146      !
147      IF(lwm) THEN
148         IF( nstop == 0 ) THEN   ;   STOP 0
149         ELSE                    ;   STOP 123
150         ENDIF
151      ENDIF
152      !
153   END SUBROUTINE nemo_gcm
154
155
156   SUBROUTINE nemo_init
157      !!----------------------------------------------------------------------
158      !!                     ***  ROUTINE nemo_init  ***
159      !!
160      !! ** Purpose :   initialization of the nemo model in off-line mode
161      !!----------------------------------------------------------------------
162      INTEGER ::   ios, ilocal_comm   ! local integers
163      !!
164      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
165         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
166         &             ln_timing, ln_diacfl
167      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
168      !!----------------------------------------------------------------------
169      !
170      cxios_context = 'nemo'
171      !
172      !                             !-------------------------------------------------!
173      !                             !     set communicator & select the local rank    !
174      !                             !  must be done as soon as possible to get narea  !
175      !                             !-------------------------------------------------!
176      !
177#if defined key_iomput
178      CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios
179      CALL mpp_start( ilocal_comm )
180#else
181      CALL mpp_start( )
182#endif
183      !
184      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 )
185      lwm = (narea == 1)                ! control of output namelists
186      !
187      !                             !---------------------------------------------------------------!
188      !                             ! Open output files, reference and configuration namelist files !
189      !                             !---------------------------------------------------------------!
190      !
191      ! open ocean.output as soon as possible to get all output prints (including errors messages)
192      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
193      ! open reference and configuration namelist files
194                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, .FALSE. )
195                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, .FALSE. )
196      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
197      ! open /dev/null file to be able to supress output write easily
198                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
199      !
200      !                             !--------------------!
201      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp
202      !                             !--------------------!
203      !
204      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
205901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
206      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
207902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
208      !
209      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print
210      !
211      IF(lwp) THEN                            ! open listing units
212         !
213         IF( .NOT. lwm )   &           ! alreay opened for narea == 1
214            &     CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
215         !
216         WRITE(numout,*)
217         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
218         WRITE(numout,*) '                       NEMO team'
219         WRITE(numout,*) '                   Off-line TOP Model'
220         WRITE(numout,*) '                NEMO version 4.0  (2019) '
221         WRITE(numout,*)
222         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
223         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
224         WRITE(numout,*)
225         WRITE(numout,*) "           o         _,           _,             "
226         WRITE(numout,*) "            o      .' (        .-' /             "
227         WRITE(numout,*) "           o     _/..._'.    .'   /              "
228         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
229         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
230         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
231         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
232         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
233         WRITE(numout,*) "       )  )                        `     (   (   "
234         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
235         WRITE(numout,*)
236         !
237         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
238         !
239      ENDIF
240      !
241      ! finalize the definition of namctl variables
242      IF( sn_cfctl%l_config ) THEN
243         ! Activate finer control of report outputs
244         ! optionally switch off output from selected areas (note this only
245         ! applies to output which does not involve global communications)
246         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
247           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
248           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
249      ELSE
250         ! Use ln_ctl to turn on or off all options.
251         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
252      ENDIF
253      !
254      IF(lwm) WRITE( numond, namctl )
255      !
256      !                             !------------------------------------!
257      !                             !  Set global domain size parameters !
258      !                             !------------------------------------!
259      !     
260      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
261903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
262      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
263904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
264      !
265      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
266         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
267      ELSE                                ! user-defined namelist
268         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
269      ENDIF
270      !
271      IF(lwm)   WRITE( numond, namcfg )
272      l_offline = .true.                  ! passive tracers are run offline
273      !
274      !                             !-----------------------------------------!
275      !                             ! mpp parameters and domain decomposition !
276      !                             !-----------------------------------------!
277      !
278      CALL mpp_init
279
280      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
281      CALL nemo_alloc()
282
283      !                             !-------------------------------!
284      !                             !  NEMO general initialization  !
285      !                             !-------------------------------!
286
287      CALL nemo_ctl                          ! Control prints
288      !
289      !                                      ! General initialization
290      IF( ln_timing    )   CALL timing_init
291      IF( ln_timing    )   CALL timing_start( 'nemo_init')
292      !
293                           CALL     phy_cst         ! Physical constants
294                           CALL     eos_init        ! Equation of state
295      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration
296                           CALL     dom_init("OPA") ! Domain
297      IF( ln_ctl       )   CALL prt_ctl_init        ! Print control
298
299                           CALL  istate_init    ! ocean initial state (Dynamics and tracers)
300
301                           CALL     sbc_init    ! Forcings : surface module
302
303      !                                      ! Tracer physics
304                           CALL ldf_tra_init    ! Lateral ocean tracer physics
305                           CALL ldf_eiv_init    ! Eddy induced velocity param
306                           CALL tra_ldf_init    ! lateral mixing
307      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing
308      IF( ln_traqsr    )   CALL tra_qsr_init    ! penetrative solar radiation
309      IF( ln_trabbl    )   CALL tra_bbl_init    ! advective (and/or diffusive) bottom boundary layer scheme
310
311      !                                      ! Passive tracers
312                           CALL trc_nam_run    ! Needed to get restart parameters for passive tracers
313                           CALL trc_rst_cal( nit000, 'READ' )   ! calendar
314#if defined key_sed_off
315                           CALL dta_dyn_sed_init ! Initialization for the dynamics
316#else
317                           CALL dta_dyn_init   ! Initialization for the dynamics
318#endif
319
320                           CALL     trc_init   ! Passive tracers initialization
321                           CALL dia_ptr_init   ! Poleward TRansports initialization
322                           
323      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
324      !
325      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
326      !
327   END SUBROUTINE nemo_init
328
329
330   SUBROUTINE nemo_ctl
331      !!----------------------------------------------------------------------
332      !!                     ***  ROUTINE nemo_ctl  ***
333      !!
334      !! ** Purpose :   control print setting
335      !!
336      !! ** Method  : - print namctl information and check some consistencies
337      !!----------------------------------------------------------------------
338      !
339      IF(lwp) THEN                  ! control print
340         WRITE(numout,*)
341         WRITE(numout,*) 'nemo_ctl: Control prints'
342         WRITE(numout,*) '~~~~~~~~'
343         WRITE(numout,*) '   Namelist namctl'
344         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
345         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
346         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
347         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
348         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
349         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
350         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
351         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
352         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
353         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
354         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
355         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
356         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
357         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
358         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
359         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
360         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
361         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
362         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
363         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
364         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
365      ENDIF
366      !
367      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
368      nictls    = nn_ictls
369      nictle    = nn_ictle
370      njctls    = nn_jctls
371      njctle    = nn_jctle
372      isplt     = nn_isplt
373      jsplt     = nn_jsplt
374
375      IF(lwp) THEN                  ! control print
376         WRITE(numout,*)
377         WRITE(numout,*) '   Namelist namcfg'
378         WRITE(numout,*) '      read domain configuration file              ln_read_cfg      = ', ln_read_cfg
379         WRITE(numout,*) '         filename to be read                         cn_domcfg     = ', TRIM(cn_domcfg)
380         WRITE(numout,*) '         keep closed seas in the domain (if exist)   ln_closea     = ', ln_closea
381         WRITE(numout,*) '      create a configuration definition file      ln_write_cfg     = ', ln_write_cfg
382         WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out)
383         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr     = ', ln_use_jattr
384      ENDIF
385      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
386      !
387      !                             ! Parameter control
388      !
389      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
390         IF( lk_mpp .AND. jpnij > 1 ) THEN
391            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
392         ELSE
393            IF( isplt == 1 .AND. jsplt == 1  ) THEN
394               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
395                  &           ' - the print control will be done over the whole domain' )
396            ENDIF
397            ijsplt = isplt * jsplt            ! total number of processors ijsplt
398         ENDIF
399         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
400         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
401         !
402         !                              ! indices used for the SUM control
403         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
404            lsp_area = .FALSE.
405         ELSE                                             ! print control done over a specific  area
406            lsp_area = .TRUE.
407            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
408               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
409               nictls = 1
410            ENDIF
411            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
412               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
413               nictle = jpiglo
414            ENDIF
415            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
416               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
417               njctls = 1
418            ENDIF
419            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
420               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
421               njctle = jpjglo
422            ENDIF
423         ENDIF
424      ENDIF
425      !
426      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
427         &                                                'Compile with key_nosignedzero enabled' )
428      !
429   END SUBROUTINE nemo_ctl
430
431
432   SUBROUTINE nemo_closefile
433      !!----------------------------------------------------------------------
434      !!                     ***  ROUTINE nemo_closefile  ***
435      !!
436      !! ** Purpose :   Close the files
437      !!----------------------------------------------------------------------
438      !
439      IF( lk_mpp )   CALL mppsync
440      !
441      CALL iom_close                                 ! close all input/output files managed by iom_*
442      !
443      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
444      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
445      !
446      numout = 6                                     ! redefine numout in case it is used after this point...
447      !
448   END SUBROUTINE nemo_closefile
449
450
451   SUBROUTINE nemo_alloc
452      !!----------------------------------------------------------------------
453      !!                     ***  ROUTINE nemo_alloc  ***
454      !!
455      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
456      !!
457      !! ** Method  :
458      !!----------------------------------------------------------------------
459      USE diawri ,   ONLY : dia_wri_alloc
460      USE dom_oce,   ONLY : dom_oce_alloc
461      USE zdf_oce,   ONLY : zdf_oce_alloc
462      USE trc_oce,   ONLY : trc_oce_alloc
463      !
464      INTEGER :: ierr
465      !!----------------------------------------------------------------------
466      !
467      ierr =        oce_alloc    ()          ! ocean
468      ierr = ierr + dia_wri_alloc()
469      ierr = ierr + dom_oce_alloc()          ! ocean domain
470      ierr = ierr + zdf_oce_alloc()          ! ocean vertical physics
471      ierr = ierr + trc_oce_alloc()          ! shared TRC / TRA arrays
472      !
473      CALL mpp_sum( 'nemogcm', ierr )
474      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
475      !
476   END SUBROUTINE nemo_alloc
477
478   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
479      !!----------------------------------------------------------------------
480      !!                     ***  ROUTINE nemo_set_cfctl  ***
481      !!
482      !! ** Purpose :   Set elements of the output control structure to setto.
483      !!                for_all should be .false. unless all areas are to be
484      !!                treated identically.
485      !!
486      !! ** Method  :   Note this routine can be used to switch on/off some
487      !!                types of output for selected areas but any output types
488      !!                that involve global communications (e.g. mpp_max, glob_sum)
489      !!                should be protected from selective switching by the
490      !!                for_all argument
491      !!----------------------------------------------------------------------
492      LOGICAL :: setto, for_all
493      TYPE(sn_ctl) :: sn_cfctl
494      !!----------------------------------------------------------------------
495      IF( for_all ) THEN
496         sn_cfctl%l_runstat = setto
497         sn_cfctl%l_trcstat = setto
498      ENDIF
499      sn_cfctl%l_oceout  = setto
500      sn_cfctl%l_layout  = setto
501      sn_cfctl%l_mppout  = setto
502      sn_cfctl%l_mpptop  = setto
503   END SUBROUTINE nemo_set_cfctl
504
505   SUBROUTINE istate_init
506      !!----------------------------------------------------------------------
507      !!                   ***  ROUTINE istate_init  ***
508      !!
509      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
510      !!----------------------------------------------------------------------
511      !
512      !     now fields         !     after fields      !
513      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
514      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
515      wn   (:,:,:)   = 0._wp   !                       !
516      hdivn(:,:,:)   = 0._wp   !                       !
517      tsn  (:,:,:,:) = 0._wp   !                       !
518      !
519      rhd  (:,:,:) = 0.e0
520      rhop (:,:,:) = 0.e0
521      rn2  (:,:,:) = 0.e0
522      !
523   END SUBROUTINE istate_init
524
525
526   SUBROUTINE stp_ctl( kt, kindic )
527      !!----------------------------------------------------------------------
528      !!                    ***  ROUTINE stp_ctl  ***
529      !!
530      !! ** Purpose :   Control the run
531      !!
532      !! ** Method  : - Save the time step in numstp
533      !!
534      !! ** Actions :   'time.step' file containing the last ocean time-step
535      !!----------------------------------------------------------------------
536      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
537      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
538      !!----------------------------------------------------------------------
539      !
540      IF( kt == nit000 .AND. lwm ) THEN
541         WRITE(numout,*)
542         WRITE(numout,*) 'stp_ctl : time-stepping control'
543         WRITE(numout,*) '~~~~~~~'
544         ! open time.step file
545         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
546      ENDIF
547      !
548      IF(lwm) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
549      IF(lwm) REWIND( numstp )                       ! --------------------------
550      !
551   END SUBROUTINE stp_ctl
552   !!======================================================================
553END MODULE nemogcm
Note: See TracBrowser for help on using the repository browser.