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/trunk/src/OFF – NEMO

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

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