Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

nemogcm.F90 @ 15725

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

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

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

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_stage3/src/OCE/nemogcm.F90 @ 15725

Download in other formats: