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/2020/KERNEL-03_Storkey_Coward_RK3_stage2/src/OCE – NEMO

Context Navigation

source: NEMO/branches/2020/KERNEL-03_Storkey_Coward_RK3_stage2/src/OCE/nemogcm.F90 @ 12397

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

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

Download in other formats: