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/SAO – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/SAO/nemogcm.F90 @ 11648

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

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Introduce broadcast of namelist character buffer from single reader to all others. This completes the second stage but there is still an issue with AGRIF that may scupper this whole concept

  • Property svn:keywords set to Id
File size: 21.5 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 ::   ios, ilocal_comm   ! local integer
92      !
93      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
94         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
95         &             ln_timing, ln_diacfl
96      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
97      !!----------------------------------------------------------------------
98      !
99      cxios_context = 'nemo'
100      !
101      !                             !-------------------------------------------------!
102      !                             !     set communicator & select the local rank    !
103      !                             !  must be done as soon as possible to get narea  !
104      !                             !-------------------------------------------------!
105      !
106#if defined key_iomput
107      IF( Agrif_Root() ) THEN
108         IF( lk_oasis ) THEN
109            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis
110            CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios
111         ELSE
112            CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios
113         ENDIF
114      ENDIF
115      CALL mpp_start( ilocal_comm )
116#else
117      IF( lk_oasis ) THEN
118         IF( Agrif_Root() ) THEN
119            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis
120         ENDIF
121         CALL mpp_start( ilocal_comm )
122      ELSE
123         CALL mpp_start( )
124      ENDIF
125#endif
126      !
127      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 )
128      lwm = (narea == 1)                ! control of output namelists
129      !
130      !                             !---------------------------------------------------------------!
131      !                             ! Open output files, reference and configuration namelist files !
132      !                             !---------------------------------------------------------------!
133      !
134      ! open ocean.output as soon as possible to get all output prints (including errors messages)
135      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
136      ! open reference and configuration namelist files
137                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
138                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
139      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
140      ! open /dev/null file to be able to supress output write easily
141                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
142      !
143      !                             !--------------------!
144      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp
145      !                             !--------------------!
146      !
147      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
148901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
149      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
150902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
151      !
152      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print
153      !
154      IF(lwp) THEN                      ! open listing units
155         !
156         IF( .NOT. lwm )   &            ! alreay opened for narea == 1
157            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
158         !
159         WRITE(numout,*)
160         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
161         WRITE(numout,*) '                       NEMO team'
162         WRITE(numout,*) '            Stand Alone Observation operator'
163         WRITE(numout,*) '                NEMO version 4.0  (2019) '
164         WRITE(numout,*)
165         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
166         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
167         WRITE(numout,*)
168         WRITE(numout,*) "           o         _,           _,             "
169         WRITE(numout,*) "            o      .' (        .-' /             "
170         WRITE(numout,*) "           o     _/..._'.    .'   /              "
171         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
172         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
173         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
174         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
175         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
176         WRITE(numout,*) "       )  ) jgs                     `    (   (   "
177         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
178         WRITE(numout,*)
179         !
180         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
181         !
182      ENDIF
183      !
184      ! finalize the definition of namctl variables
185      IF( sn_cfctl%l_config ) THEN
186         ! Activate finer control of report outputs
187         ! optionally switch off output from selected areas (note this only
188         ! applies to output which does not involve global communications)
189         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. &
190           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    &
191           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
192      ELSE
193         ! Use ln_ctl to turn on or off all options.
194         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
195      ENDIF
196      !
197      IF(lwm) WRITE( numond, namctl )
198      !
199      !                             !------------------------------------!
200      !                             !  Set global domain size parameters !
201      !                             !------------------------------------!
202      !
203      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
204903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' )
205      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
206904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )   
207      !
208      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file
209         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
210      ELSE                              ! user-defined namelist
211         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
212      ENDIF
213      !
214      IF(lwm)   WRITE( numond, namcfg )
215      !
216      !                             !-----------------------------------------!
217      !                             ! mpp parameters and domain decomposition !
218      !                             !-----------------------------------------!
219      CALL mpp_init
220
221      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
222      CALL nemo_alloc()
223
224      !                             !-------------------------------!
225      !                             !  NEMO general initialization  !
226      !                             !-------------------------------!
227
228      CALL nemo_ctl                          ! Control prints
229      !
230      !                                         ! General initialization
231      IF( ln_timing    )   CALL timing_init     ! timing
232      IF( ln_timing    )   CALL timing_start( 'nemo_init')
233      !
234                           CALL phy_cst            ! Physical constants
235                           CALL eos_init           ! Equation of state
236                           CALL dom_init('SAO')    ! Domain
237
238
239      IF( ln_ctl       )   CALL prt_ctl_init    ! Print control
240
241                           CALL istate_init     ! ocean initial state (Dynamics and tracers)
242   END SUBROUTINE nemo_init
243
244
245   SUBROUTINE nemo_ctl
246      !!----------------------------------------------------------------------
247      !!                     ***  ROUTINE nemo_ctl  ***
248      !!
249      !! ** Purpose :   control print setting
250      !!
251      !! ** Method  : - print namctl information and check some consistencies
252      !!----------------------------------------------------------------------
253      !
254      IF(lwp) THEN                  ! control print
255         WRITE(numout,*)
256         WRITE(numout,*) 'nemo_ctl: Control prints'
257         WRITE(numout,*) '~~~~~~~~'
258         WRITE(numout,*) '   Namelist namctl'
259         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
260         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
261         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
262         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
263         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
264         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
265         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
266         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
267         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
268         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
269         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
270         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
271         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
272         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
273         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
274         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
275         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
276         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
277         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
278         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
279         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
280      ENDIF
281      !
282      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
283      nictls    = nn_ictls
284      nictle    = nn_ictle
285      njctls    = nn_jctls
286      njctle    = nn_jctle
287      isplt     = nn_isplt
288      jsplt     = nn_jsplt
289
290      IF(lwp) THEN                  ! control print
291         WRITE(numout,*)
292         WRITE(numout,*) '   Namelist namcfg'
293         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
294         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
295         WRITE(numout,*) '         keep closed seas in the domain (if exist)     ln_closea     = ', ln_closea
296         WRITE(numout,*) '      create a configuration definition file        ln_write_cfg     = ', ln_write_cfg
297         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
298         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
299      ENDIF
300      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file
301      !
302      !                             ! Parameter control
303      !
304      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
305         IF( lk_mpp .AND. jpnij > 1 ) THEN
306            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
307         ELSE
308            IF( isplt == 1 .AND. jsplt == 1  ) THEN
309               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
310                  &           ' - the print control will be done over the whole domain' )
311            ENDIF
312            ijsplt = isplt * jsplt            ! total number of processors ijsplt
313         ENDIF
314         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
315         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
316         !
317         !                              ! indices used for the SUM control
318         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
319            lsp_area = .FALSE.
320         ELSE                                             ! print control done over a specific  area
321            lsp_area = .TRUE.
322            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
323               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
324               nictls = 1
325            ENDIF
326            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
327               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
328               nictle = jpiglo
329            ENDIF
330            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
331               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
332               njctls = 1
333            ENDIF
334            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
335               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
336               njctle = jpjglo
337            ENDIF
338         ENDIF
339      ENDIF
340      !
341      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
342         &                                                'Compile with key_nosignedzero enabled:',   &
343         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
344      !
345   END SUBROUTINE nemo_ctl
346
347
348   SUBROUTINE nemo_closefile
349      !!----------------------------------------------------------------------
350      !!                     ***  ROUTINE nemo_closefile  ***
351      !!
352      !! ** Purpose :   Close the files
353      !!----------------------------------------------------------------------
354      !
355      IF( lk_mpp )   CALL mppsync
356      !
357      CALL iom_close                                 ! close all input/output files managed by iom_*
358      !
359      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
360      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file
361      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
362      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
363      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
364      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
365      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
366      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
367      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
368      !
369      numout = 6                                     ! redefine numout in case it is used after this point...
370      !
371   END SUBROUTINE nemo_closefile
372
373
374   SUBROUTINE nemo_alloc
375      !!----------------------------------------------------------------------
376      !!                     ***  ROUTINE nemo_alloc  ***
377      !!
378      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
379      !!
380      !! ** Method  :
381      !!----------------------------------------------------------------------
382      USE diawri    , ONLY: dia_wri_alloc
383      USE dom_oce   , ONLY: dom_oce_alloc
384      !
385      INTEGER :: ierr
386      !!----------------------------------------------------------------------
387      !
388      ierr =        oce_alloc       ()          ! ocean
389      ierr = ierr + dia_wri_alloc   ()
390      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
391      !
392      CALL mpp_sum( 'nemogcm', ierr )
393      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
394      !
395   END SUBROUTINE nemo_alloc
396
397   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
398      !!----------------------------------------------------------------------
399      !!                     ***  ROUTINE nemo_set_cfctl  ***
400      !!
401      !! ** Purpose :   Set elements of the output control structure to setto.
402      !!                for_all should be .false. unless all areas are to be
403      !!                treated identically.
404      !!
405      !! ** Method  :   Note this routine can be used to switch on/off some
406      !!                types of output for selected areas but any output types
407      !!                that involve global communications (e.g. mpp_max, glob_sum)
408      !!                should be protected from selective switching by the
409      !!                for_all argument
410      !!----------------------------------------------------------------------
411      LOGICAL :: setto, for_all
412      TYPE(sn_ctl) :: sn_cfctl
413      !!----------------------------------------------------------------------
414      IF( for_all ) THEN
415         sn_cfctl%l_runstat = setto
416         sn_cfctl%l_trcstat = setto
417      ENDIF
418      sn_cfctl%l_oceout  = setto
419      sn_cfctl%l_layout  = setto
420      sn_cfctl%l_mppout  = setto
421      sn_cfctl%l_mpptop  = setto
422   END SUBROUTINE nemo_set_cfctl
423
424   !!======================================================================
425END MODULE nemogcm
426
Note: See TracBrowser for help on using the repository browser.