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

Context Navigation

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/nemogcm.F90 @ 11642

Last change on this file since 11642 was 11624, checked in by acc, 5 years ago
Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Substantive changes required to replace all namelists with internal files. These are the key changes only; to compile and run tests all REWIND and CLOSE operations on the (no longer) units have to be removed. These changes affect many more files but can be scripted so are not included here in order to make a later merge easier. The scripts used to prepare code for testing are included on: wiki:2019WP/ENHANCE-04_AndrewC-reporting/Internal_Namelists. With these additional changes this code passes most SETTE tests but the AGRIF preprocessor does not currently accept the new allocatable character strings. To be investigated.
Property svn:keywords set to `Id`
File size: 34.6 KB

Line
1	MODULE nemogcm
2	!!======================================================================
3	!! * MODULE nemogcm *
4	!! Ocean system : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
5	!!======================================================================
6	!! History : OPA ! 1990-10 (C. Levy, G. Madec) Original code
7	!! 7.0 ! 1991-11 (M. Imbard, C. Levy, G. Madec)
8	!! 7.1 ! 1993-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
9	!! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
10	!! - ! 1992-06 (L.Terray) coupling implementation
11	!! - ! 1993-11 (M.A. Filiberti) IGLOO sea-ice
12	!! 8.0 ! 1996-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
13	!! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
14	!! 8.1 ! 1997-06 (M. Imbard, G. Madec)
15	!! 8.2 ! 1999-11 (M. Imbard, H. Goosse) sea-ice model
16	!! ! 1999-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP
17	!! ! 2000-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER)
18	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and modules
19	!! - ! 2004-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
20	!! - ! 2004-08 (C. Talandier) New trends organization
21	!! - ! 2005-06 (C. Ethe) Add the 1D configuration possibility
22	!! - ! 2005-11 (V. Garnier) Surface pressure gradient organization
23	!! - ! 2006-03 (L. Debreu, C. Mazauric) Agrif implementation
24	!! - ! 2006-04 (G. Madec, R. Benshila) Step reorganization
25	!! - ! 2007-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
26	!! 3.2 ! 2009-08 (S. Masson) open/write in the listing file in mpp
27	!! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
28	!! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
29	!! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
30	!! - ! 2011-11 (C. Harris) decomposition changes for running with CICE
31	!! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening
32	!! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla)
33	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
34	!!----------------------------------------------------------------------
35
36	!!----------------------------------------------------------------------
37	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
38	!! nemo_init : initialization of the NEMO system
39	!! nemo_ctl : initialisation of the contol print
40	!! nemo_closefile: close remaining open files
41	!! nemo_alloc : dynamical allocation
42	!!----------------------------------------------------------------------
43	USE step_oce ! module used in the ocean time stepping module (step.F90)
44	USE phycst ! physical constant (par_cst routine)
45	USE domain ! domain initialization (dom_init & dom_cfg routines)
46	USE closea ! treatment of closed seas (for ln_closea)
47	USE usrdef_nam ! user defined configuration
48	USE tideini ! tidal components initialization (tide_ini routine)
49	USE bdy_oce, ONLY : ln_bdy
50	USE bdyini ! open boundary cond. setting (bdy_init routine)
51	USE istate ! initial state setting (istate_init routine)
52	USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine)
53	USE ldftra ! lateral diffusivity setting (ldftra_init routine)
54	USE trdini ! dyn/tra trends initialization (trd_init routine)
55	USE asminc ! assimilation increments
56	USE asmbkg ! writing out state trajectory
57	USE diaptr ! poleward transports (dia_ptr_init routine)
58	USE diadct ! sections transports (dia_dct_init routine)
59	USE diaobs ! Observation diagnostics (dia_obs_init routine)
60	USE diacfl ! CFL diagnostics (dia_cfl_init routine)
61	USE diaharm ! tidal harmonics diagnostics (dia_harm_init routine)
62	USE step ! NEMO time-stepping (stp routine)
63	USE icbini ! handle bergs, initialisation
64	USE icbstp ! handle bergs, calving, themodynamics and transport
65	USE cpl_oasis3 ! OASIS3 coupling
66	USE c1d ! 1D configuration
67	USE step_c1d ! Time stepping loop for the 1D configuration
68	USE dyndmp ! Momentum damping
69	USE stopar ! Stochastic param.: ???
70	USE stopts ! Stochastic param.: ???
71	USE diurnal_bulk ! diurnal bulk SST
72	USE step_diu ! diurnal bulk SST timestepping (called from here if run offline)
73	USE crsini ! initialise grid coarsening utility
74	USE diatmb ! Top,middle,bottom output
75	USE dia25h ! 25h mean output
76	USE sbc_oce , ONLY : lk_oasis
77	USE wet_dry ! Wetting and drying setting (wad_init routine)
78	#if defined key_top
79	USE trcini ! passive tracer initialisation
80	#endif
81	#if defined key_nemocice_decomp
82	USE ice_domain_size, only: nx_global, ny_global
83	#endif
84	!
85	USE lib_mpp ! distributed memory computing
86	USE mppini ! shared/distributed memory setting (mpp_init routine)
87	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
88	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
89	#if defined key_iomput
90	USE xios ! xIOserver
91	#endif
92	#if defined key_agrif
93	USE agrif_all_update ! Master Agrif update
94	#endif
95
96	IMPLICIT NONE
97	PRIVATE
98
99	PUBLIC nemo_gcm ! called by model.F90
100	PUBLIC nemo_init ! needed by AGRIF
101	PUBLIC nemo_alloc ! needed by TAM
102
103	CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
104
105	#if defined key_mpp_mpi
106	! need MPI_Wtime
107	INCLUDE 'mpif.h'
108	#endif
109
110	!!----------------------------------------------------------------------
111	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
112	!! $Id$
113	!! Software governed by the CeCILL license (see ./LICENSE)
114	!!----------------------------------------------------------------------
115	CONTAINS
116
117	SUBROUTINE nemo_gcm
118	!!----------------------------------------------------------------------
119	!! * ROUTINE nemo_gcm *
120	!!
121	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
122	!! curvilinear mesh on the sphere.
123	!!
124	!! ** Method : - model general initialization
125	!! - launch the time-stepping (stp routine)
126	!! - finalize the run by closing files and communications
127	!!
128	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
129	!! Madec, 2008, internal report, IPSL.
130	!!----------------------------------------------------------------------
131	INTEGER :: istp ! time step index
132	REAL(wp):: zstptiming ! elapsed time for 1 time step
133	!!----------------------------------------------------------------------
134	!
135	#if defined key_agrif
136	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
137	#endif
138	! !-----------------------!
139	CALL nemo_init !== Initialisations ==!
140	! !-----------------------!
141	#if defined key_agrif
142	CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM
143	CALL Agrif_Declare_Var ! " " " " " DYN/TRA
144	# if defined key_top
145	CALL Agrif_Declare_Var_top ! " " " " " TOP
146	# endif
147	# if defined key_si3
148	CALL Agrif_Declare_Var_ice ! " " " " " Sea ice
149	# endif
150	#endif
151	! check that all process are still there... If some process have an error,
152	! they will never enter in step and other processes will wait until the end of the cpu time!
153	CALL mpp_max( 'nemogcm', nstop )
154
155	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
156
157	! !-----------------------!
158	! !== time stepping ==!
159	! !-----------------------!
160	istp = nit000
161	!
162	#if defined key_c1d
163	DO WHILE ( istp <= nitend .AND. nstop == 0 ) !== C1D time-stepping ==!
164	CALL stp_c1d( istp )
165	istp = istp + 1
166	END DO
167	#else
168	!
169	# if defined key_agrif
170	! !== AGRIF time-stepping ==!
171	CALL Agrif_Regrid()
172	!
173	! Recursive update from highest nested level to lowest:
174	CALL Agrif_step_child_adj(Agrif_Update_All)
175	!
176	DO WHILE( istp <= nitend .AND. nstop == 0 )
177	CALL stp
178	istp = istp + 1
179	END DO
180	!
181	IF( .NOT. Agrif_Root() ) THEN
182	CALL Agrif_ParentGrid_To_ChildGrid()
183	IF( ln_diaobs ) CALL dia_obs_wri
184	IF( ln_timing ) CALL timing_finalize
185	CALL Agrif_ChildGrid_To_ParentGrid()
186	ENDIF
187	!
188	# else
189	!
190	IF( .NOT.ln_diurnal_only ) THEN !== Standard time-stepping ==!
191	!
192	DO WHILE( istp <= nitend .AND. nstop == 0 )
193
194	ncom_stp = istp
195	IF( ln_timing ) THEN
196	zstptiming = MPI_Wtime()
197	IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming
198	IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time
199	ENDIF
200
201	CALL stp ( istp )
202	istp = istp + 1
203
204	IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming
205
206	END DO
207	!
208	ELSE !== diurnal SST time-steeping only ==!
209	!
210	DO WHILE( istp <= nitend .AND. nstop == 0 )
211	CALL stp_diurnal( istp ) ! time step only the diurnal SST
212	istp = istp + 1
213	END DO
214	!
215	ENDIF
216	!
217	# endif
218	!
219	#endif
220	!
221	IF( ln_diaobs ) CALL dia_obs_wri
222	!
223	IF( ln_icebergs ) CALL icb_end( nitend )
224
225	! !------------------------!
226	! !== finalize the run ==!
227	! !------------------------!
228	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
229	!
230	IF( nstop /= 0 .AND. lwp ) THEN ! error print
231	WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
232	CALL ctl_stop( ctmp1 )
233	ENDIF
234	!
235	IF( ln_timing ) CALL timing_finalize
236	!
237	CALL nemo_closefile
238	!
239	#if defined key_iomput
240	CALL xios_finalize ! end mpp communications with xios
241	IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
242	#else
243	IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS
244	ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications
245	ENDIF
246	#endif
247	!
248	IF(lwm) THEN
249	IF( nstop == 0 ) THEN ; STOP 0
250	ELSE ; STOP 123
251	ENDIF
252	ENDIF
253	!
254	END SUBROUTINE nemo_gcm
255
256
257	SUBROUTINE nemo_init
258	!!----------------------------------------------------------------------
259	!! * ROUTINE nemo_init *
260	!!
261	!! ** Purpose : initialization of the NEMO GCM
262	!!----------------------------------------------------------------------
263	INTEGER :: ios, ilocal_comm ! local integers
264	!!
265	NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, &
266	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
267	& ln_timing, ln_diacfl
268	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
269	!!----------------------------------------------------------------------
270	!
271	cxios_context = 'nemo'
272	!
273	! !-------------------------------------------------!
274	! ! set communicator & select the local rank !
275	! ! must be done as soon as possible to get narea !
276	! !-------------------------------------------------!
277	!
278	#if defined key_iomput
279	IF( Agrif_Root() ) THEN
280	IF( lk_oasis ) THEN
281	CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
282	CALL xios_initialize( "not used" , local_comm =ilocal_comm ) ! send nemo communicator to xios
283	ELSE
284	CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios
285	ENDIF
286	ENDIF
287	CALL mpp_start( ilocal_comm )
288	#else
289	IF( lk_oasis ) THEN
290	IF( Agrif_Root() ) THEN
291	CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
292	ENDIF
293	CALL mpp_start( ilocal_comm )
294	ELSE
295	CALL mpp_start( )
296	ENDIF
297	#endif
298	!
299	narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 )
300	lwm = (narea == 1) ! control of output namelists
301	!
302	! !---------------------------------------------------------------!
303	! ! Open output files, reference and configuration namelist files !
304	! !---------------------------------------------------------------!
305	!
306	! open ocean.output as soon as possible to get all output prints (including errors messages)
307	IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
308	! open reference and configuration namelist files
309	CALL load_nml( numnam_ref, 'namelist_ref', -1, .FALSE. )
310	CALL load_nml( numnam_cfg, 'namelist_cfg', -1, .FALSE. )
311	IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
312	! open /dev/null file to be able to supress output write easily
313	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
314	!
315	! !--------------------!
316	! ! Open listing units ! -> need ln_ctl from namctl to define lwp
317	! !--------------------!
318	!
319	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
320	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' )
321	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
322	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' )
323	!
324	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
325	!
326	IF(lwp) THEN ! open listing units
327	!
328	IF( .NOT. lwm ) & ! alreay opened for narea == 1
329	& CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
330	!
331	WRITE(numout,*)
332	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
333	WRITE(numout,*) ' NEMO team'
334	WRITE(numout,*) ' Ocean General Circulation Model'
335	WRITE(numout,*) ' NEMO version 4.0 (2019) '
336	WRITE(numout,*)
337	WRITE(numout,*) " ._ ._ ._ ._ ._ "
338	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
339	WRITE(numout,*)
340	WRITE(numout,*) " o _, _, "
341	WRITE(numout,*) " o .' ( .-' / "
342	WRITE(numout,*) " o _/..._'. .' / "
343	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
344	WRITE(numout,*) " ) ( o) ;= <_ ( "
345	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
346	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
347	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
348	WRITE(numout,*) " ) ) jgs ` ( ( "
349	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
350	WRITE(numout,*)
351	!
352	WRITE(numout,cform_aaa) ! Flag AAAAAAA
353	!
354	ENDIF
355	!
356	! finalize the definition of namctl variables
357	IF( sn_cfctl%l_config ) THEN
358	! Activate finer control of report outputs
359	! optionally switch off output from selected areas (note this only
360	! applies to output which does not involve global communications)
361	IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &
362	& ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &
363	& CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
364	ELSE
365	! Use ln_ctl to turn on or off all options.
366	CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
367	ENDIF
368	!
369	IF(lwm) WRITE( numond, namctl )
370	!
371	! !------------------------------------!
372	! ! Set global domain size parameters !
373	! !------------------------------------!
374	!
375	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
376	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' )
377	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
378	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' )
379	!
380	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
381	CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
382	ELSE ! user-defined namelist
383	CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
384	ENDIF
385	!
386	IF(lwm) WRITE( numond, namcfg )
387	!
388	! !-----------------------------------------!
389	! ! mpp parameters and domain decomposition !
390	! !-----------------------------------------!
391	CALL mpp_init
392
393	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
394	CALL nemo_alloc()
395
396	! !-------------------------------!
397	! ! NEMO general initialization !
398	! !-------------------------------!
399
400	CALL nemo_ctl ! Control prints
401	!
402	! ! General initialization
403	IF( ln_timing ) CALL timing_init ! timing
404	IF( ln_timing ) CALL timing_start( 'nemo_init')
405	!
406	CALL phy_cst ! Physical constants
407	CALL eos_init ! Equation of state
408	IF( lk_c1d ) CALL c1d_init ! 1D column configuration
409	CALL wad_init ! Wetting and drying options
410	CALL dom_init("OPA") ! Domain
411	IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization
412	IF( ln_ctl ) CALL prt_ctl_init ! Print control
413
414	CALL diurnal_sst_bulk_init ! diurnal sst
415	IF( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin
416	!
417	IF( ln_diurnal_only ) THEN ! diurnal only: a subset of the initialisation routines
418	CALL istate_init ! ocean initial state (Dynamics and tracers)
419	CALL sbc_init ! Forcings : surface module
420	CALL tra_qsr_init ! penetrative solar radiation qsr
421	IF( ln_diaobs ) THEN ! Observation & model comparison
422	CALL dia_obs_init ! Initialize observational data
423	CALL dia_obs( nit000 - 1 ) ! Observation operator for restart
424	ENDIF
425	IF( lk_asminc ) CALL asm_inc_init ! Assimilation increments
426	!
427	RETURN ! end of initialization
428	ENDIF
429
430	CALL istate_init ! ocean initial state (Dynamics and tracers)
431
432	! ! external forcing
433	CALL tide_init ! tidal harmonics
434	CALL sbc_init ! surface boundary conditions (including sea-ice)
435	CALL bdy_init ! Open boundaries initialisation
436
437	! ! Ocean physics
438	CALL zdf_phy_init ! Vertical physics
439
440	! ! Lateral physics
441	CALL ldf_tra_init ! Lateral ocean tracer physics
442	CALL ldf_eiv_init ! eddy induced velocity param.
443	CALL ldf_dyn_init ! Lateral ocean momentum physics
444
445	! ! Active tracers
446	IF( ln_traqsr ) CALL tra_qsr_init ! penetrative solar radiation qsr
447	CALL tra_bbc_init ! bottom heat flux
448	CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme
449	CALL tra_dmp_init ! internal tracer damping
450	CALL tra_adv_init ! horizontal & vertical advection
451	CALL tra_ldf_init ! lateral mixing
452
453	! ! Dynamics
454	IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping
455	CALL dyn_adv_init ! advection (vector or flux form)
456	CALL dyn_vor_init ! vorticity term including Coriolis
457	CALL dyn_ldf_init ! lateral mixing
458	CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure
459	CALL dyn_spg_init ! surface pressure gradient
460
461	#if defined key_top
462	! ! Passive tracers
463	CALL trc_init
464	#endif
465	IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing
466
467	! ! Icebergs
468	CALL icb_init( rdt, nit000) ! initialise icebergs instance
469
470	! ! Misc. options
471	CALL sto_par_init ! Stochastic parametrization
472	IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations
473
474	! ! Diagnostics
475	CALL flo_init ! drifting Floats
476	IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics
477	CALL dia_ptr_init ! Poleward TRansports initialization
478	CALL dia_dct_init ! Sections tranports
479	CALL dia_hsb_init ! heat content, salt content and volume budgets
480	CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends
481	CALL dia_obs_init ! Initialize observational data
482	CALL dia_tmb_init ! TMB outputs
483	CALL dia_25h_init ! 25h mean outputs
484	CALL dia_harm_init ! tidal harmonics outputs
485	IF( ln_diaobs ) CALL dia_obs( nit000-1 ) ! Observation operator for restart
486
487	! ! Assimilation increments
488	IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments
489	!
490	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
491	!
492	IF( ln_timing ) CALL timing_stop( 'nemo_init')
493	!
494	END SUBROUTINE nemo_init
495
496
497	SUBROUTINE nemo_ctl
498	!!----------------------------------------------------------------------
499	!! * ROUTINE nemo_ctl *
500	!!
501	!! ** Purpose : control print setting
502	!!
503	!! ** Method : - print namctl and namcfg information and check some consistencies
504	!!----------------------------------------------------------------------
505	!
506	IF(lwp) THEN ! control print
507	WRITE(numout,*)
508	WRITE(numout,*) 'nemo_ctl: Control prints'
509	WRITE(numout,*) '~~~~~~~~'
510	WRITE(numout,*) ' Namelist namctl'
511	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
512	WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config
513	WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
514	WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
515	WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout
516	WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout
517	WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout
518	WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop
519	WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin
520	WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax
521	WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr
522	WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr
523	WRITE(numout,*) ' level of print nn_print = ', nn_print
524	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
525	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
526	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
527	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
528	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
529	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
530	WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing
531	WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl
532	ENDIF
533	!
534	nprint = nn_print ! convert DOCTOR namelist names into OLD names
535	nictls = nn_ictls
536	nictle = nn_ictle
537	njctls = nn_jctls
538	njctle = nn_jctle
539	isplt = nn_isplt
540	jsplt = nn_jsplt
541
542	IF(lwp) THEN ! control print
543	WRITE(numout,*)
544	WRITE(numout,*) ' Namelist namcfg'
545	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
546	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
547	WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea
548	WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg
549	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
550	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
551	ENDIF
552	IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file
553	!
554	! ! Parameter control
555	!
556	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
557	IF( lk_mpp .AND. jpnij > 1 ) THEN
558	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
559	ELSE
560	IF( isplt == 1 .AND. jsplt == 1 ) THEN
561	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
562	& ' - the print control will be done over the whole domain' )
563	ENDIF
564	ijsplt = isplt * jsplt ! total number of processors ijsplt
565	ENDIF
566	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
567	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
568	!
569	! ! indices used for the SUM control
570	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
571	lsp_area = .FALSE.
572	ELSE ! print control done over a specific area
573	lsp_area = .TRUE.
574	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
575	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
576	nictls = 1
577	ENDIF
578	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
579	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
580	nictle = jpiglo
581	ENDIF
582	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
583	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
584	njctls = 1
585	ENDIF
586	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
587	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
588	njctle = jpjglo
589	ENDIF
590	ENDIF
591	ENDIF
592	!
593	IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', &
594	& 'Compile with key_nosignedzero enabled:', &
595	& '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
596	!
597	#if defined key_agrif
598	IF( ln_timing ) CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
599	#endif
600	!
601	END SUBROUTINE nemo_ctl
602
603
604	SUBROUTINE nemo_closefile
605	!!----------------------------------------------------------------------
606	!! * ROUTINE nemo_closefile *
607	!!
608	!! ** Purpose : Close the files
609	!!----------------------------------------------------------------------
610	!
611	IF( lk_mpp ) CALL mppsync
612	!
613	CALL iom_close ! close all input/output files managed by iom_*
614	!
615	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
616	IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file
617	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
618	IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist
619	IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)
620	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
621	IF( numdct_vol /= -1 ) CLOSE( numdct_vol ) ! volume transports
622	IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports
623	IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports
624	!
625	numout = 6 ! redefine numout in case it is used after this point...
626	!
627	END SUBROUTINE nemo_closefile
628
629
630	SUBROUTINE nemo_alloc
631	!!----------------------------------------------------------------------
632	!! * ROUTINE nemo_alloc *
633	!!
634	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
635	!!
636	!! ** Method :
637	!!----------------------------------------------------------------------
638	USE diawri , ONLY : dia_wri_alloc
639	USE dom_oce , ONLY : dom_oce_alloc
640	USE trc_oce , ONLY : trc_oce_alloc
641	USE bdy_oce , ONLY : bdy_oce_alloc
642	!
643	INTEGER :: ierr
644	!!----------------------------------------------------------------------
645	!
646	ierr = oce_alloc () ! ocean
647	ierr = ierr + dia_wri_alloc()
648	ierr = ierr + dom_oce_alloc() ! ocean domain
649	ierr = ierr + zdf_oce_alloc() ! ocean vertical physics
650	ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays
651	ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization)
652	!
653	CALL mpp_sum( 'nemogcm', ierr )
654	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
655	!
656	END SUBROUTINE nemo_alloc
657
658
659	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
660	!!----------------------------------------------------------------------
661	!! * ROUTINE nemo_set_cfctl *
662	!!
663	!! ** Purpose : Set elements of the output control structure to setto.
664	!! for_all should be .false. unless all areas are to be
665	!! treated identically.
666	!!
667	!! ** Method : Note this routine can be used to switch on/off some
668	!! types of output for selected areas but any output types
669	!! that involve global communications (e.g. mpp_max, glob_sum)
670	!! should be protected from selective switching by the
671	!! for_all argument
672	!!----------------------------------------------------------------------
673	LOGICAL :: setto, for_all
674	TYPE(sn_ctl) :: sn_cfctl
675	!!----------------------------------------------------------------------
676	IF( for_all ) THEN
677	sn_cfctl%l_runstat = setto
678	sn_cfctl%l_trcstat = setto
679	ENDIF
680	sn_cfctl%l_oceout = setto
681	sn_cfctl%l_layout = setto
682	sn_cfctl%l_mppout = setto
683	sn_cfctl%l_mpptop = setto
684	END SUBROUTINE nemo_set_cfctl
685
686	!!======================================================================
687	END MODULE nemogcm
688

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

Download in other formats: