Context Navigation

nemogcm.F90 @ 12377

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

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

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

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/trunk/src/OCE/nemogcm.F90 @ 12377

Download in other formats: