source: NEMO/trunk/src/SAO/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: 22.4 KB
Line 
1MODULE nemogcm
2   !!======================================================================
3   !!                       ***  MODULE nemogcm   ***
4   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
5   !!======================================================================
6   !! History :  3.6  ! 2015-12  (A. Ryan) Original code   (from OCE/)
7   !!            4.0  ! 2016-11  (G. Madec, S. Flavoni)  domain configuration / user defined interface
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
12   !!   nemo_init     : initialization of the NEMO system
13   !!   nemo_ctl      : initialisation of the contol print
14   !!   nemo_closefile: close remaining open files
15   !!   nemo_alloc    : dynamical allocation
16   !!----------------------------------------------------------------------
17   USE step_oce       ! module used in the ocean time stepping module (step.F90)
18   USE domain         ! domain initialization   (dom_init & dom_cfg routines)
19   USE istate         ! initial state setting          (istate_init routine)
20   USE phycst         ! physical constant                  (par_cst routine)
21   USE step           ! NEMO time-stepping                 (stp     routine)
22   USE cpl_oasis3     ! OASIS3 coupling
23   USE diaobs         ! Observation diagnostics       (dia_obs_init routine)
24#if defined key_nemocice_decomp
25   USE ice_domain_size, only: nx_global, ny_global
26#endif
27   !           ! Stand Alone Observation operator modules
28   USE sao_data
29   USE sao_intp
30   !
31   USE lib_mpp        ! distributed memory computing
32   USE mppini         ! shared/distributed memory setting (mpp_init routine)
33   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
34   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
35#if defined key_iomput
36   USE xios           ! xIOserver
37#endif
38
39   IMPLICIT NONE
40   PRIVATE
41
42   PUBLIC   nemo_gcm    ! called by model.F90
43   PUBLIC   nemo_init   ! needed by AGRIF
44   PUBLIC   nemo_alloc  ! needed by TAM
45
46   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
47
48   !!----------------------------------------------------------------------
49   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
50   !! $Id$
51   !! Software governed by the CeCILL license (see ./LICENSE)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE nemo_gcm
56         !!----------------------------------------------------------------------
57         !!                    ***  SUBROUTINE offline_obs_oper ***
58         !!
59         !! ** Purpose : To use NEMO components to interpolate model fields
60         !!              to observation space.
61         !!
62         !! ** Method : 1. Initialise NEMO
63         !!             2. Initialise offline obs_oper
64         !!             3. Cycle through match ups
65         !!             4. Write results to file
66         !!----------------------------------------------------------------------
67         !
68         CALL nemo_init       ! Initialise NEMO
69         !
70         CALL sao_data_init   ! Initialise Stand Alone Observation operator data
71         !
72         CALL dia_obs_init    ! Initialise obs_operator
73         !
74         CALL sao_interp      ! Interpolate to observation space
75         !
76         CALL dia_obs_wri     ! Pipe to output files
77         !
78         CALL dia_obs_dealloc ! Reset the obs_oper between
79         !
80         IF(lk_mpp)   CALL mppstop  ! Safely stop MPI (end mpp communications)
81         !
82   END SUBROUTINE nemo_gcm
83
84
85   SUBROUTINE nemo_init
86      !!----------------------------------------------------------------------
87      !!                     ***  ROUTINE nemo_init  ***
88      !!
89      !! ** Purpose :   initialization of the NEMO GCM
90      !!----------------------------------------------------------------------
91      INTEGER ::   ji                 ! dummy loop indices
92      INTEGER ::   ios, ilocal_comm   ! local integer
93      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
94      !
95      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
96         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
97         &             ln_timing, ln_diacfl
98      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
99      !!----------------------------------------------------------------------
100      !
101      cltxt  = ''
102      cltxt2 = ''
103      clnam  = '' 
104      cxios_context = 'nemo'
105      !
106      !                             ! Open reference namelist and configuration namelist files
107      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
108      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
109      !
110      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints
111      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
112901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
113      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
114      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
115902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
116      !
117      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints
118      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
119903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
120      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
121      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
122904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
123
124      !                             !--------------------------!
125      !                             !  Set global domain size  !   (control print return in cltxt2)
126      !                             !--------------------------!
127      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
128         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
129         !
130      ELSE                                ! user-defined namelist
131         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
132      ENDIF
133      !
134      !
135      !                             !--------------------------------------------!
136      !                             !  set communicator & select the local node  !
137      !                             !  NB: mynode also opens output.namelist.dyn !
138      !                             !      on unit number numond on first proc   !
139      !                             !--------------------------------------------!
140#if defined key_iomput
141      IF( Agrif_Root() ) THEN
142         IF( lk_oasis ) THEN
143            CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis
144            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
145         ELSE
146            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
147         ENDIF
148      ENDIF
149      ! Nodes selection (control print return in cltxt)
150      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
151#else
152      IF( lk_oasis ) THEN
153         IF( Agrif_Root() ) THEN
154            CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis
155         ENDIF
156         ! Nodes selection (control print return in cltxt)
157         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
158      ELSE
159         ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt)
160         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
161      ENDIF
162#endif
163
164      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
165
166      IF( sn_cfctl%l_config ) THEN
167         ! Activate finer control of report outputs
168         ! optionally switch off output from selected areas (note this only
169         ! applies to output which does not involve global communications
170         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
171           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
172           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
173      ELSE
174         ! Use ln_ctl to turn on or off all options.
175         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
176      ENDIF
177
178      lwm = (narea == 1)                                    ! control of output namelists
179      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
180
181      IF(lwm) THEN
182         ! write merged namelists from earlier to output namelist now that the
183         ! file has been opened in call to mynode. nammpp has already been
184         ! written in mynode (if lk_mpp_mpi)
185         WRITE( numond, namctl )
186         WRITE( numond, namcfg )
187         IF( .NOT.ln_read_cfg ) THEN
188            DO ji = 1, SIZE(clnam)
189               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print
190            END DO
191         ENDIF
192      ENDIF
193
194      IF(lwp) THEN                            ! open listing units
195         !
196         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
197         !
198         WRITE(numout,*)
199         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
200         WRITE(numout,*) '                       NEMO team'
201         WRITE(numout,*) '            Stand Alone Observation operator'
202         WRITE(numout,*) '                NEMO version 4.0  (2019) '
203         WRITE(numout,*)
204         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
205         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
206         WRITE(numout,*)
207         WRITE(numout,*) "           o         _,           _,             "
208         WRITE(numout,*) "            o      .' (        .-' /             "
209         WRITE(numout,*) "           o     _/..._'.    .'   /              "
210         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
211         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
212         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
213         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
214         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
215         WRITE(numout,*) "       )  )                        `     (   (   "
216         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
217         WRITE(numout,*)
218         DO ji = 1, SIZE(cltxt)
219            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode
220         END DO
221         WRITE(numout,*)
222         WRITE(numout,*)
223         DO ji = 1, SIZE(cltxt2)
224            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size
225         END DO
226         !
227         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
228         !
229      ENDIF
230      !                                      ! Domain decomposition
231      CALL mpp_init                          ! MPP
232
233      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
234      CALL nemo_alloc()
235
236      !                             !-------------------------------!
237      !                             !  NEMO general initialization  !
238      !                             !-------------------------------!
239
240      CALL nemo_ctl                          ! Control prints
241      !
242      !                                         ! General initialization
243      IF( ln_timing    )   CALL timing_init     ! timing
244      IF( ln_timing    )   CALL timing_start( 'nemo_init')
245      !
246                           CALL phy_cst            ! Physical constants
247                           CALL eos_init           ! Equation of state
248                           CALL dom_init('SAO')    ! Domain
249
250
251      IF( ln_ctl       )   CALL prt_ctl_init    ! Print control
252
253                           CALL istate_init     ! ocean initial state (Dynamics and tracers)
254   END SUBROUTINE nemo_init
255
256
257   SUBROUTINE nemo_ctl
258      !!----------------------------------------------------------------------
259      !!                     ***  ROUTINE nemo_ctl  ***
260      !!
261      !! ** Purpose :   control print setting
262      !!
263      !! ** Method  : - print namctl information and check some consistencies
264      !!----------------------------------------------------------------------
265      !
266      IF(lwp) THEN                  ! control print
267         WRITE(numout,*)
268         WRITE(numout,*) 'nemo_ctl: Control prints'
269         WRITE(numout,*) '~~~~~~~~'
270         WRITE(numout,*) '   Namelist namctl'
271         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
272         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
273         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
274         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
275         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
276         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
277         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
278         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
279         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
280         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
281         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
282         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
283         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
284         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
285         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
286         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
287         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
288         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
289         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
290         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
291         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
292      ENDIF
293      !
294      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
295      nictls    = nn_ictls
296      nictle    = nn_ictle
297      njctls    = nn_jctls
298      njctle    = nn_jctle
299      isplt     = nn_isplt
300      jsplt     = nn_jsplt
301
302      IF(lwp) THEN                  ! control print
303         WRITE(numout,*)
304         WRITE(numout,*) '   Namelist namcfg'
305         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
306         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
307         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
308         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
309         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
310         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
311      ENDIF
312      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
313      !
314      !                             ! Parameter control
315      !
316      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
317         IF( lk_mpp .AND. jpnij > 1 ) THEN
318            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
319         ELSE
320            IF( isplt == 1 .AND. jsplt == 1  ) THEN
321               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
322                  &           ' - the print control will be done over the whole domain' )
323            ENDIF
324            ijsplt = isplt * jsplt            ! total number of processors ijsplt
325         ENDIF
326         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
327         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
328         !
329         !                              ! indices used for the SUM control
330         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
331            lsp_area = .FALSE.
332         ELSE                                             ! print control done over a specific  area
333            lsp_area = .TRUE.
334            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
335               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
336               nictls = 1
337            ENDIF
338            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
339               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
340               nictle = jpiglo
341            ENDIF
342            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
343               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
344               njctls = 1
345            ENDIF
346            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
347               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
348               njctle = jpjglo
349            ENDIF
350         ENDIF
351      ENDIF
352      !
353      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
354         &                                                'Compile with key_nosignedzero enabled:',   &
355         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
356      !
357   END SUBROUTINE nemo_ctl
358
359
360   SUBROUTINE nemo_closefile
361      !!----------------------------------------------------------------------
362      !!                     ***  ROUTINE nemo_closefile  ***
363      !!
364      !! ** Purpose :   Close the files
365      !!----------------------------------------------------------------------
366      !
367      IF( lk_mpp )   CALL mppsync
368      !
369      CALL iom_close                                 ! close all input/output files managed by iom_*
370      !
371      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
372      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
373      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
374      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
375      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
376      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
377      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
378      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
379      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
380      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
381      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
382      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
383      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
384      !
385      numout = 6                                     ! redefine numout in case it is used after this point...
386      !
387   END SUBROUTINE nemo_closefile
388
389
390   SUBROUTINE nemo_alloc
391      !!----------------------------------------------------------------------
392      !!                     ***  ROUTINE nemo_alloc  ***
393      !!
394      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
395      !!
396      !! ** Method  :
397      !!----------------------------------------------------------------------
398      USE diawri    , ONLY: dia_wri_alloc
399      USE dom_oce   , ONLY: dom_oce_alloc
400      !
401      INTEGER :: ierr
402      !!----------------------------------------------------------------------
403      !
404      ierr =        oce_alloc       ()          ! ocean
405      ierr = ierr + dia_wri_alloc   ()
406      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
407      !
408      CALL mpp_sum( 'nemogcm', ierr )
409      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
410      !
411   END SUBROUTINE nemo_alloc
412
413   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
414      !!----------------------------------------------------------------------
415      !!                     ***  ROUTINE nemo_set_cfctl  ***
416      !!
417      !! ** Purpose :   Set elements of the output control structure to setto.
418      !!                for_all should be .false. unless all areas are to be
419      !!                treated identically.
420      !!
421      !! ** Method  :   Note this routine can be used to switch on/off some
422      !!                types of output for selected areas but any output types
423      !!                that involve global communications (e.g. mpp_max, glob_sum)
424      !!                should be protected from selective switching by the
425      !!                for_all argument
426      !!----------------------------------------------------------------------
427      LOGICAL :: setto, for_all
428      TYPE (sn_ctl) :: sn_cfctl
429      !!----------------------------------------------------------------------
430      IF( for_all ) THEN
431         sn_cfctl%l_runstat = setto
432         sn_cfctl%l_trcstat = setto
433      ENDIF
434      sn_cfctl%l_oceout  = setto
435      sn_cfctl%l_layout  = setto
436      sn_cfctl%l_mppout  = setto
437      sn_cfctl%l_mpptop  = setto
438   END SUBROUTINE nemo_set_cfctl
439
440   !!======================================================================
441END MODULE nemogcm
442
Note: See TracBrowser for help on using the repository browser.