source: NEMO/trunk/src/OFF/nemogcm.F90 @ 10570

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

Trunk update to implement finer control over the choice of text report files generated. See ticket: #2167

  • Property svn:keywords set to Id
File size: 28.3 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(numout,cform_err)
134         WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
135         WRITE(numout,*)
136      ENDIF
137      !
138      IF( ln_timing )   CALL timing_finalize
139      !
140      CALL nemo_closefile
141      !
142#if defined key_iomput
143                     CALL xios_finalize   ! end mpp communications with xios
144#else
145      IF( lk_mpp )   CALL mppstop         ! end mpp communications
146#endif
147      !
148   END SUBROUTINE nemo_gcm
149
150
151   SUBROUTINE nemo_init
152      !!----------------------------------------------------------------------
153      !!                     ***  ROUTINE nemo_init  ***
154      !!
155      !! ** Purpose :   initialization of the nemo model in off-line mode
156      !!----------------------------------------------------------------------
157      INTEGER  ::   ji                 ! dummy loop indices
158      INTEGER  ::   ios, ilocal_comm   ! local integers
159      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
160      !!
161      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
162         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
163         &             ln_timing, ln_diacfl
164      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
165      !!----------------------------------------------------------------------
166      !
167      cltxt  = ''
168      cltxt2 = ''
169      clnam  = '' 
170      cxios_context = 'nemo'
171      !
172      !                             ! Open reference namelist and configuration namelist files
173      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
174      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
175      !
176      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
177      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
178901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
179      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
180      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
181902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
182      !
183      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
184      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
185903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
186      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
187      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
188904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
189
190      !                             !--------------------------!
191      !                             !  Set global domain size  !   (control print return in cltxt2)
192      !                             !--------------------------!
193      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
194         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
195         !
196      ELSE                                ! user-defined namelist
197         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
198      ENDIF
199      !
200      l_offline = .true.                  ! passive tracers are run offline
201      !
202      !                             !--------------------------------------------!
203      !                             !  set communicator & select the local node  !
204      !                             !  NB: mynode also opens output.namelist.dyn !
205      !                             !      on unit number numond on first proc   !
206      !                             !--------------------------------------------!
207#if defined key_iomput
208      CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )
209      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
210#else
211      ilocal_comm = 0
212      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
213#endif
214
215      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 )
216
217      IF( sn_cfctl%l_config ) THEN
218         ! Activate finer control of report outputs
219         ! optionally switch off output from selected areas (note this only
220         ! applies to output which does not involve global communications)
221         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
222           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
223           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
224      ELSE
225         ! Use ln_ctl to turn on or off all options.
226         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
227      ENDIF
228
229      lwm = (narea == 1)                      ! control of output namelists
230      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
231
232      IF(lwm) THEN               ! write merged namelists from earlier to output namelist
233         !                       ! now that the file has been opened in call to mynode.
234         !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)
235         WRITE( numond, namctl )
236         WRITE( numond, namcfg )
237         IF( .NOT.ln_read_cfg ) THEN
238            DO ji = 1, SIZE(clnam)
239               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print
240            END DO
241         ENDIF
242      ENDIF
243
244      IF(lwp) THEN                            ! open listing units
245         !
246         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
247         !
248         WRITE(numout,*)
249         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
250         WRITE(numout,*) '                       NEMO team'
251         WRITE(numout,*) '                   Off-line TOP Model'
252         WRITE(numout,*) '                NEMO version 4.0  (2019) '
253         WRITE(numout,*)
254         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
255         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
256         WRITE(numout,*)
257         WRITE(numout,*) "           o         _,           _,             "
258         WRITE(numout,*) "            o      .' (        .-' /             "
259         WRITE(numout,*) "           o     _/..._'.    .'   /              "
260         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
261         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
262         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
263         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
264         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
265         WRITE(numout,*) "       )  )                        `     (   (   "
266         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
267         WRITE(numout,*)
268         DO ji = 1, SIZE(cltxt)
269            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode
270         END DO
271         WRITE(numout,*)
272         WRITE(numout,*)
273         DO ji = 1, SIZE(cltxt2)
274            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size
275         END DO
276         !
277         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
278         !
279      ENDIF
280      ! open /dev/null file to be able to supress output write easily
281      CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
282      !
283      !                                      ! Domain decomposition
284      CALL mpp_init                          ! MPP
285
286      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
287      CALL nemo_alloc()
288
289      !                             !-------------------------------!
290      !                             !  NEMO general initialization  !
291      !                             !-------------------------------!
292
293      CALL nemo_ctl                          ! Control prints
294      !
295      !                                      ! General initialization
296      IF( ln_timing    )   CALL timing_init
297      IF( ln_timing    )   CALL timing_start( 'nemo_init')
298      !
299                           CALL     phy_cst         ! Physical constants
300                           CALL     eos_init        ! Equation of state
301      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration
302                           CALL     dom_init("OPA") ! Domain
303      IF( ln_ctl       )   CALL prt_ctl_init        ! Print control
304
305                           CALL  istate_init    ! ocean initial state (Dynamics and tracers)
306
307                           CALL     sbc_init    ! Forcings : surface module
308
309      !                                      ! Tracer physics
310                           CALL ldf_tra_init    ! Lateral ocean tracer physics
311                           CALL ldf_eiv_init    ! Eddy induced velocity param
312                           CALL tra_ldf_init    ! lateral mixing
313      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing
314      IF( ln_traqsr    )   CALL tra_qsr_init    ! penetrative solar radiation
315      IF( ln_trabbl    )   CALL tra_bbl_init    ! advective (and/or diffusive) bottom boundary layer scheme
316
317      !                                      ! Passive tracers
318                           CALL trc_nam_run    ! Needed to get restart parameters for passive tracers
319                           CALL trc_rst_cal( nit000, 'READ' )   ! calendar
320#if defined key_sed_off
321                           CALL dta_dyn_sed_init ! Initialization for the dynamics
322#else
323                           CALL dta_dyn_init   ! Initialization for the dynamics
324#endif
325
326                           CALL     trc_init   ! Passive tracers initialization
327                           CALL dia_ptr_init   ! Poleward TRansports initialization
328                           
329      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
330      !
331      IF( ln_timing    )   CALL timing_stop( 'nemo_init')
332      !
333   END SUBROUTINE nemo_init
334
335
336   SUBROUTINE nemo_ctl
337      !!----------------------------------------------------------------------
338      !!                     ***  ROUTINE nemo_ctl  ***
339      !!
340      !! ** Purpose :   control print setting
341      !!
342      !! ** Method  : - print namctl information and check some consistencies
343      !!----------------------------------------------------------------------
344      !
345      IF(lwp) THEN                  ! control print
346         WRITE(numout,*)
347         WRITE(numout,*) 'nemo_ctl: Control prints'
348         WRITE(numout,*) '~~~~~~~~'
349         WRITE(numout,*) '   Namelist namctl'
350         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
351         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
352         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
353         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
354         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
355         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
356         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
357         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
358         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
359         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
360         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
361         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
362         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
363         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
364         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
365         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
366         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
367         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
368         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
369         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
370         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
371      ENDIF
372      !
373      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
374      nictls    = nn_ictls
375      nictle    = nn_ictle
376      njctls    = nn_jctls
377      njctle    = nn_jctle
378      isplt     = nn_isplt
379      jsplt     = nn_jsplt
380
381      IF(lwp) THEN                  ! control print
382         WRITE(numout,*)
383         WRITE(numout,*) '   Namelist namcfg'
384         WRITE(numout,*) '      read domain configuration file              ln_read_cfg      = ', ln_read_cfg
385         WRITE(numout,*) '         filename to be read                         cn_domcfg     = ', TRIM(cn_domcfg)
386         WRITE(numout,*) '         keep closed seas in the domain (if exist)   ln_closea     = ', ln_closea
387         WRITE(numout,*) '      create a configuration definition file      ln_write_cfg     = ', ln_write_cfg
388         WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out)
389         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr     = ', ln_use_jattr
390      ENDIF
391      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
392      !
393      !                             ! Parameter control
394      !
395      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
396         IF( lk_mpp .AND. jpnij > 1 ) THEN
397            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
398         ELSE
399            IF( isplt == 1 .AND. jsplt == 1  ) THEN
400               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
401                  &           ' - the print control will be done over the whole domain' )
402            ENDIF
403            ijsplt = isplt * jsplt            ! total number of processors ijsplt
404         ENDIF
405         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
406         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
407         !
408         !                              ! indices used for the SUM control
409         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
410            lsp_area = .FALSE.
411         ELSE                                             ! print control done over a specific  area
412            lsp_area = .TRUE.
413            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
414               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
415               nictls = 1
416            ENDIF
417            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
418               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
419               nictle = jpiglo
420            ENDIF
421            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
422               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
423               njctls = 1
424            ENDIF
425            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
426               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
427               njctle = jpjglo
428            ENDIF
429         ENDIF
430      ENDIF
431      !
432      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
433         &                                                'Compile with key_nosignedzero enabled' )
434      !
435   END SUBROUTINE nemo_ctl
436
437
438   SUBROUTINE nemo_closefile
439      !!----------------------------------------------------------------------
440      !!                     ***  ROUTINE nemo_closefile  ***
441      !!
442      !! ** Purpose :   Close the files
443      !!----------------------------------------------------------------------
444      !
445      IF( lk_mpp )   CALL mppsync
446      !
447      CALL iom_close                                 ! close all input/output files managed by iom_*
448      !
449      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
450      IF( numnam_ref /= -1 )   CLOSE( numnam_ref )   ! oce reference namelist
451      IF( numnam_cfg /= -1 )   CLOSE( numnam_cfg )   ! oce configuration namelist
452      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
453      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
454      !
455      numout = 6                                     ! redefine numout in case it is used after this point...
456      !
457   END SUBROUTINE nemo_closefile
458
459
460   SUBROUTINE nemo_alloc
461      !!----------------------------------------------------------------------
462      !!                     ***  ROUTINE nemo_alloc  ***
463      !!
464      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
465      !!
466      !! ** Method  :
467      !!----------------------------------------------------------------------
468      USE diawri ,   ONLY : dia_wri_alloc
469      USE dom_oce,   ONLY : dom_oce_alloc
470      USE zdf_oce,   ONLY : zdf_oce_alloc
471      USE trc_oce,   ONLY : trc_oce_alloc
472      !
473      INTEGER :: ierr
474      !!----------------------------------------------------------------------
475      !
476      ierr =        oce_alloc    ()          ! ocean
477      ierr = ierr + dia_wri_alloc()
478      ierr = ierr + dom_oce_alloc()          ! ocean domain
479      ierr = ierr + zdf_oce_alloc()          ! ocean vertical physics
480      ierr = ierr + trc_oce_alloc()          ! shared TRC / TRA arrays
481      !
482      CALL mpp_sum( 'nemogcm', ierr )
483      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
484      !
485   END SUBROUTINE nemo_alloc
486
487   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
488      !!----------------------------------------------------------------------
489      !!                     ***  ROUTINE nemo_set_cfctl  ***
490      !!
491      !! ** Purpose :   Set elements of the output control structure to setto.
492      !!                for_all should be .false. unless all areas are to be
493      !!                treated identically.
494      !!
495      !! ** Method  :   Note this routine can be used to switch on/off some
496      !!                types of output for selected areas but any output types
497      !!                that involve global communications (e.g. mpp_max, glob_sum)
498      !!                should be protected from selective switching by the
499      !!                for_all argument
500      !!----------------------------------------------------------------------
501      LOGICAL :: setto, for_all
502      TYPE (sn_ctl) :: sn_cfctl
503      !!----------------------------------------------------------------------
504      IF( for_all ) THEN
505         sn_cfctl%l_runstat = setto
506         sn_cfctl%l_trcstat = setto
507      ENDIF
508      sn_cfctl%l_oceout  = setto
509      sn_cfctl%l_layout  = setto
510      sn_cfctl%l_mppout  = setto
511      sn_cfctl%l_mpptop  = setto
512   END SUBROUTINE nemo_set_cfctl
513
514   SUBROUTINE istate_init
515      !!----------------------------------------------------------------------
516      !!                   ***  ROUTINE istate_init  ***
517      !!
518      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
519      !!----------------------------------------------------------------------
520      !
521      !     now fields         !     after fields      !
522      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
523      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
524      wn   (:,:,:)   = 0._wp   !                       !
525      hdivn(:,:,:)   = 0._wp   !                       !
526      tsn  (:,:,:,:) = 0._wp   !                       !
527      !
528      rhd  (:,:,:) = 0.e0
529      rhop (:,:,:) = 0.e0
530      rn2  (:,:,:) = 0.e0
531      !
532   END SUBROUTINE istate_init
533
534
535   SUBROUTINE stp_ctl( kt, kindic )
536      !!----------------------------------------------------------------------
537      !!                    ***  ROUTINE stp_ctl  ***
538      !!
539      !! ** Purpose :   Control the run
540      !!
541      !! ** Method  : - Save the time step in numstp
542      !!
543      !! ** Actions :   'time.step' file containing the last ocean time-step
544      !!----------------------------------------------------------------------
545      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
546      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
547      !!----------------------------------------------------------------------
548      !
549      IF( kt == nit000 .AND. lwm ) THEN
550         WRITE(numout,*)
551         WRITE(numout,*) 'stp_ctl : time-stepping control'
552         WRITE(numout,*) '~~~~~~~'
553         ! open time.step file
554         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
555      ENDIF
556      !
557      IF(lwm) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
558      IF(lwm) REWIND( numstp )                       ! --------------------------
559      !
560   END SUBROUTINE stp_ctl
561   !!======================================================================
562END MODULE nemogcm
Note: See TracBrowser for help on using the repository browser.