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

Context Navigation

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

Last change on this file since 11648 was 11648, checked in by acc, 5 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: 27.0 KB

Line
1	MODULE nemogcm
2	!!======================================================================
3	!! * MODULE nemogcm *
4	!! StandAlone Surface module : surface fluxes + sea-ice + iceberg floats
5	!!======================================================================
6	!! History : 3.6 ! 2011-11 (S. Alderson, G. Madec) original code
7	!! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication
8	!! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla)
9	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
10	!!----------------------------------------------------------------------
11
12	!!----------------------------------------------------------------------
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	!!----------------------------------------------------------------------
19	USE step_oce ! module used in the ocean time stepping module
20	USE sbc_oce ! surface boundary condition: ocean
21	USE phycst ! physical constant (par_cst routine)
22	USE domain ! domain initialization (dom_init & dom_cfg routines)
23	USE closea ! treatment of closed seas (for ln_closea)
24	USE usrdef_nam ! user defined configuration
25	USE daymod ! calendar
26	USE restart ! open restart file
27	USE step ! NEMO time-stepping (stp routine)
28	USE cpl_oasis3 !
29	USE sbcssm !
30	USE icbini ! handle bergs, initialisation
31	USE icbstp ! handle bergs, calving, themodynamics and transport
32	USE bdyini ! open boundary cond. setting (bdy_init routine). mandatory for sea-ice
33	USE bdydta ! open boundary cond. setting (bdy_dta_init routine). mandatory for sea-ice
34	!
35	USE lib_mpp ! distributed memory computing
36	USE mppini ! shared/distributed memory setting (mpp_init routine)
37	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
38	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
39	#if defined key_iomput
40	USE xios ! xIOserver
41	#endif
42	#if defined key_agrif && defined key_si3
43	USE agrif_ice_update ! ice update
44	#endif
45
46	IMPLICIT NONE
47	PRIVATE
48
49	PUBLIC nemo_gcm ! called by model.F90
50	PUBLIC nemo_init ! needed by AGRIF
51
52	CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
53
54	!!----------------------------------------------------------------------
55	!! NEMO/SAS 4.0 , NEMO Consortium (2018)
56	!! $Id$
57	!! Software governed by the CeCILL license (see ./LICENSE)
58	!!----------------------------------------------------------------------
59	CONTAINS
60
61	SUBROUTINE nemo_gcm
62	!!----------------------------------------------------------------------
63	!! * ROUTINE nemo_gcm *
64	!!
65	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
66	!! curvilinear mesh on the sphere.
67	!!
68	!! ** Method : - model general initialization
69	!! - launch the time-stepping (stp routine)
70	!! - finalize the run by closing files and communications
71	!!
72	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
73	!! Madec, 2008, internal report, IPSL.
74	!!----------------------------------------------------------------------
75	INTEGER :: istp ! time step index
76	!!----------------------------------------------------------------------
77	!
78	#if defined key_agrif
79	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
80	#endif
81	! !-----------------------!
82	CALL nemo_init !== Initialisations ==!
83	! !-----------------------!
84	#if defined key_agrif
85	CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM
86	CALL Agrif_Declare_Var ! " " " " " DYN/TRA
87	# if defined key_top
88	CALL Agrif_Declare_Var_top ! " " " " " TOP
89	# endif
90	# if defined key_si3
91	CALL Agrif_Declare_Var_ice ! " " " " " Sea ice
92	# endif
93	#endif
94	! check that all process are still there... If some process have an error,
95	! they will never enter in step and other processes will wait until the end of the cpu time!
96	CALL mpp_max( 'nemogcm', nstop )
97
98	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
99
100	! !-----------------------!
101	! !== time stepping ==!
102	! !-----------------------!
103	istp = nit000
104	!
105	#if defined key_agrif
106	! !== AGRIF time-stepping ==!
107	CALL Agrif_Regrid()
108	!
109	#if defined key_si3
110	! Recursive update from highest nested level to lowest:
111	CALL Agrif_step_child_adj(Agrif_update_ice)
112	#endif
113	!
114	DO WHILE( istp <= nitend .AND. nstop == 0 )
115	CALL stp
116	istp = istp + 1
117	END DO
118	!
119	IF( .NOT. Agrif_Root() ) THEN
120	CALL Agrif_ParentGrid_To_ChildGrid()
121	IF( ln_timing ) CALL timing_finalize
122	CALL Agrif_ChildGrid_To_ParentGrid()
123	ENDIF
124	!
125	#else
126	!
127	IF( .NOT.ln_diurnal_only ) THEN !== Standard time-stepping ==!
128	!
129	DO WHILE( istp <= nitend .AND. nstop == 0 )
130	CALL stp ( istp )
131	istp = istp + 1
132	END DO
133	!
134	ELSE !== diurnal SST time-steeping only ==!
135	!
136	DO WHILE( istp <= nitend .AND. nstop == 0 )
137	CALL stp_diurnal( istp ) ! time step only the diurnal SST
138	istp = istp + 1
139	END DO
140	!
141	ENDIF
142	!
143	#endif
144	!
145	IF( ln_icebergs ) CALL icb_end( nitend )
146
147	! !------------------------!
148	! !== finalize the run ==!
149	! !------------------------!
150	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
151	!
152	IF( nstop /= 0 .AND. lwp ) THEN ! error print
153	WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
154	CALL ctl_stop( ctmp1 )
155	ENDIF
156	!
157	IF( ln_timing ) CALL timing_finalize
158	!
159	CALL nemo_closefile
160	!
161	#if defined key_iomput
162	CALL xios_finalize ! end mpp communications with xios
163	IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
164	#else
165	IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS
166	ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications
167	ENDIF
168	#endif
169	!
170	IF(lwm) THEN
171	IF( nstop == 0 ) THEN ; STOP 0
172	ELSE ; STOP 123
173	ENDIF
174	ENDIF
175	!
176	END SUBROUTINE nemo_gcm
177
178
179	SUBROUTINE nemo_init
180	!!----------------------------------------------------------------------
181	!! * ROUTINE nemo_init *
182	!!
183	!! ** Purpose : initialization of the NEMO GCM
184	!!----------------------------------------------------------------------
185	INTEGER :: ios, ilocal_comm ! local integers
186	!!
187	NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, &
188	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
189	& ln_timing, ln_diacfl
190	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
191	!!----------------------------------------------------------------------
192	!
193	IF( lk_oasis ) THEN ; cxios_context = 'sas'
194	ELSE ; cxios_context = 'nemo'
195	ENDIF
196	!
197	! !-------------------------------------------------!
198	! ! set communicator & select the local rank !
199	! ! must be done as soon as possible to get narea !
200	! !-------------------------------------------------!
201	!
202	#if defined key_iomput
203	IF( Agrif_Root() ) THEN
204	IF( lk_oasis ) THEN
205	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
206	CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios
207	ELSE
208	CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
209	ENDIF
210	ENDIF
211	CALL mpp_start( ilocal_comm )
212	#else
213	IF( lk_oasis ) THEN
214	IF( Agrif_Root() ) THEN
215	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
216	ENDIF
217	CALL mpp_start( ilocal_comm )
218	ELSE
219	CALL mpp_start( )
220	ENDIF
221	#endif
222	!
223	narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 )
224	lwm = (narea == 1) ! control of output namelists
225	!
226	! !---------------------------------------------------------------!
227	! ! Open output files, reference and configuration namelist files !
228	! !---------------------------------------------------------------!
229	!
230	! open ocean.output as soon as possible to get all output prints (including errors messages)
231	IF( lk_oasis ) THEN
232	IF( lwm ) CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
233	! open reference and configuration namelist files
234	CALL load_nml( numnam_ref, 'namelist_sas_ref', -1, lwm )
235	CALL load_nml( numnam_cfg, 'namelist_sas_cfg', -1, lwm )
236	IF( lwm ) CALL ctl_opn( numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
237	ELSE
238	IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
239	! open reference and configuration namelist files
240	CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm )
241	CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm )
242	IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
243	ENDIF
244	! open /dev/null file to be able to supress output write easily
245	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
246	!
247	! !--------------------!
248	! ! Open listing units ! -> need ln_ctl from namctl to define lwp
249	! !--------------------!
250	!
251	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
252	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' )
253	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
254	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' )
255	!
256	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
257	!
258	IF(lwp) THEN ! open listing units
259	!
260	IF( .NOT. lwm ) THEN ! alreay opened for narea == 1
261	IF(lk_oasis) THEN ; CALL ctl_opn( numout, 'sas.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea )
262	ELSE ; CALL ctl_opn( numout, 'ocean.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea )
263	ENDIF
264	ENDIF
265	!
266	WRITE(numout,*)
267	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
268	WRITE(numout,*) ' NEMO team'
269	WRITE(numout,*) ' Ocean General Circulation Model'
270	WRITE(numout,*) ' NEMO version 4.0 (2019) '
271	WRITE(numout,*) ' StandAlone Surface version (SAS) '
272	WRITE(numout,*) " ._ ._ ._ ._ ._ "
273	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
274	WRITE(numout,*)
275	WRITE(numout,*) " o _, _, "
276	WRITE(numout,*) " o .' ( .-' / "
277	WRITE(numout,*) " o _/..._'. .' / "
278	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
279	WRITE(numout,*) " ) ( o) ;= <_ ( "
280	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
281	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
282	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
283	WRITE(numout,*) " ) ) jgs ` ( ( "
284	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
285	WRITE(numout,*)
286	WRITE(numout,*)
287	!
288	WRITE(numout,cform_aaa) ! Flag AAAAAAA
289	!
290	ENDIF
291	!
292	! finalize the definition of namctl variables
293	IF( sn_cfctl%l_config ) THEN
294	! Activate finer control of report outputs
295	! optionally switch off output from selected areas (note this only
296	! applies to output which does not involve global communications)
297	IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &
298	& ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &
299	& CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
300	ELSE
301	! Use ln_ctl to turn on or off all options.
302	CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
303	ENDIF
304	!
305	IF(lwm) WRITE( numond, namctl )
306	!
307	! !------------------------------------!
308	! ! Set global domain size parameters !
309	! !------------------------------------!
310	!
311	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
312	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' )
313	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
314	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' )
315	!
316	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
317	CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
318	ELSE ! user-defined namelist
319	CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
320	ENDIF
321	!
322	IF(lwm) WRITE( numond, namcfg )
323	!
324	! !-----------------------------------------!
325	! ! mpp parameters and domain decomposition !
326	! !-----------------------------------------!
327	CALL mpp_init
328
329	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
330	CALL nemo_alloc()
331
332	! !-------------------------------!
333	! ! NEMO general initialization !
334	! !-------------------------------!
335
336	CALL nemo_ctl ! Control prints
337	!
338	! ! General initialization
339	IF( ln_timing ) CALL timing_init ! timing
340	IF( ln_timing ) CALL timing_start( 'nemo_init')
341
342	CALL phy_cst ! Physical constants
343	CALL eos_init ! Equation of seawater
344	CALL dom_init('SAS') ! Domain
345	IF( ln_ctl ) CALL prt_ctl_init ! Print control
346
347	CALL day_init ! model calendar (using both namelist and restart infos)
348	IF( ln_rstart ) CALL rst_read_open
349
350	! ! external forcing
351	CALL sbc_init ! Forcings : surface module
352
353	! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from
354	! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
355	! This is not clean and should be changed in the future.
356	CALL bdy_init
357	! ==>
358	CALL icb_init( rdt, nit000) ! initialise icebergs instance
359	!
360	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
361	!
362	IF( ln_timing ) CALL timing_stop( 'nemo_init')
363	!
364	END SUBROUTINE nemo_init
365
366
367	SUBROUTINE nemo_ctl
368	!!----------------------------------------------------------------------
369	!! * ROUTINE nemo_ctl *
370	!!
371	!! ** Purpose : control print setting
372	!!
373	!! ** Method : - print namctl information and check some consistencies
374	!!----------------------------------------------------------------------
375	!
376	IF(lwp) THEN ! control print
377	WRITE(numout,*)
378	WRITE(numout,*) 'nemo_ctl: Control prints'
379	WRITE(numout,*) '~~~~~~~~'
380	WRITE(numout,*) ' Namelist namctl'
381	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
382	WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config
383	WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
384	WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
385	WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout
386	WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout
387	WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout
388	WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop
389	WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin
390	WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax
391	WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr
392	WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr
393	WRITE(numout,*) ' level of print nn_print = ', nn_print
394	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
395	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
396	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
397	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
398	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
399	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
400	WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing
401	WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl
402	ENDIF
403	!
404	nprint = nn_print ! convert DOCTOR namelist names into OLD names
405	nictls = nn_ictls
406	nictle = nn_ictle
407	njctls = nn_jctls
408	njctle = nn_jctle
409	isplt = nn_isplt
410	jsplt = nn_jsplt
411
412	IF(lwp) THEN ! control print
413	WRITE(numout,*)
414	WRITE(numout,*) ' Namelist namcfg'
415	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
416	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
417	WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea
418	WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg
419	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
420	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
421	ENDIF
422	IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file
423	!
424	! ! Parameter control
425	!
426	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
427	IF( lk_mpp .AND. jpnij > 1 ) THEN
428	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
429	ELSE
430	IF( isplt == 1 .AND. jsplt == 1 ) THEN
431	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
432	& ' - the print control will be done over the whole domain' )
433	ENDIF
434	ijsplt = isplt * jsplt ! total number of processors ijsplt
435	ENDIF
436	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
437	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
438	!
439	! ! indices used for the SUM control
440	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
441	lsp_area = .FALSE.
442	ELSE ! print control done over a specific area
443	lsp_area = .TRUE.
444	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
445	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
446	nictls = 1
447	ENDIF
448	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
449	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
450	nictle = jpiglo
451	ENDIF
452	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
453	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
454	njctls = 1
455	ENDIF
456	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
457	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
458	njctle = jpjglo
459	ENDIF
460	ENDIF
461	ENDIF
462	!
463	IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', &
464	& 'Compile with key_nosignedzero enabled:', &
465	& '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
466	!
467	#if defined key_agrif
468	IF( ln_timing ) CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
469	#endif
470	!
471	END SUBROUTINE nemo_ctl
472
473
474	SUBROUTINE nemo_closefile
475	!!----------------------------------------------------------------------
476	!! * ROUTINE nemo_closefile *
477	!!
478	!! ** Purpose : Close the files
479	!!----------------------------------------------------------------------
480	!
481	IF( lk_mpp ) CALL mppsync
482	!
483	CALL iom_close ! close all input/output files managed by iom_*
484	!
485	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
486	IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file
487	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
488	IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist
489	IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)
490	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
491	!
492	numout = 6 ! redefine numout in case it is used after this point...
493	!
494	END SUBROUTINE nemo_closefile
495
496
497	SUBROUTINE nemo_alloc
498	!!----------------------------------------------------------------------
499	!! * ROUTINE nemo_alloc *
500	!!
501	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
502	!!
503	!! ** Method :
504	!!----------------------------------------------------------------------
505	USE diawri , ONLY : dia_wri_alloc
506	USE dom_oce , ONLY : dom_oce_alloc
507	USE bdy_oce , ONLY : ln_bdy, bdy_oce_alloc
508	USE oce ! mandatory for sea-ice because needed for bdy arrays
509	!
510	INTEGER :: ierr
511	!!----------------------------------------------------------------------
512	!
513	ierr = dia_wri_alloc()
514	ierr = ierr + dom_oce_alloc() ! ocean domain
515	ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or SI3 and bdy
516	ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization)
517	!
518	CALL mpp_sum( 'nemogcm', ierr )
519	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
520	!
521	END SUBROUTINE nemo_alloc
522
523	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
524	!!----------------------------------------------------------------------
525	!! * ROUTINE nemo_set_cfctl *
526	!!
527	!! ** Purpose : Set elements of the output control structure to setto.
528	!! for_all should be .false. unless all areas are to be
529	!! treated identically.
530	!!
531	!! ** Method : Note this routine can be used to switch on/off some
532	!! types of output for selected areas but any output types
533	!! that involve global communications (e.g. mpp_max, glob_sum)
534	!! should be protected from selective switching by the
535	!! for_all argument
536	!!----------------------------------------------------------------------
537	LOGICAL :: setto, for_all
538	TYPE(sn_ctl) :: sn_cfctl
539	!!----------------------------------------------------------------------
540	IF( for_all ) THEN
541	sn_cfctl%l_runstat = setto
542	sn_cfctl%l_trcstat = setto
543	ENDIF
544	sn_cfctl%l_oceout = setto
545	sn_cfctl%l_layout = setto
546	sn_cfctl%l_mppout = setto
547	sn_cfctl%l_mpptop = setto
548	END SUBROUTINE nemo_set_cfctl
549
550	!!======================================================================
551	END MODULE nemogcm
552

Note: See TracBrowser for help on using the repository browser.

Download in other formats: