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/test_12905_xios_ancil/src/OFF – NEMO

Context Navigation

source: NEMO/branches/2020/test_12905_xios_ancil/src/OFF/nemogcm.F90 @ 13041

Last change on this file since 13041 was 13041, checked in by andmirek, 4 years ago
Ticket #2475 update test branch
Property svn:keywords set to `Id`
File size: 29.6 KB

Line
1	MODULE nemogcm
2	!!======================================================================
3	!! * MODULE nemogcm *
4	!! Off-line Ocean : passive tracer evolution, dynamics read in files
5	!!======================================================================
6	!! History : 3.3 ! 2010-05 (C. Ethe) Full reorganization of the off-line: phasing with the on-line
7	!! 3.4 ! 2011-01 (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation
8	!! 4.0 ! 2016-10 (C. Ethe, G. Madec, S. Flavoni) domain configuration / user defined interface
9	!! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
10	!!----------------------------------------------------------------------
11
12	!!----------------------------------------------------------------------
13	!! nemo_gcm : off-line: solve ocean tracer only
14	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
15	!! nemo_init : initialization of the NEMO system
16	!! nemo_ctl : initialisation of the contol print
17	!! nemo_closefile: close remaining open files
18	!! nemo_alloc : dynamical allocation
19	!! istate_init : simple initialization to zero of ocean fields
20	!! stp_ctl : reduced step control (no dynamics in off-line)
21	!!----------------------------------------------------------------------
22	USE dom_oce ! ocean space domain variables
23	USE oce ! dynamics and tracers variables
24	USE trc_oce ! Shared ocean/passive tracers variables
25	USE c1d ! 1D configuration
26	USE domain ! domain initialization from coordinate & bathymetry (dom_init routine)
27	USE closea ! treatment of closed seas (for ln_closea)
28	USE usrdef_nam ! user defined configuration
29	USE eosbn2 ! equation of state (eos bn2 routine)
30	USE bdy_oce, ONLY : ln_bdy
31	USE bdyini ! open boundary cond. setting (bdy_init routine)
32	! ! ocean physics
33	USE ldftra ! lateral diffusivity setting (ldf_tra_init routine)
34	USE ldfslp ! slopes of neutral surfaces (ldf_slp_init routine)
35	USE traqsr ! solar radiation penetration (tra_qsr_init routine)
36	USE trabbl ! bottom boundary layer (tra_bbl_init routine)
37	USE traldf ! lateral physics (tra_ldf_init routine)
38	USE sbcmod ! surface boundary condition (sbc_init routine)
39	USE phycst ! physical constant (par_cst routine)
40	USE dtadyn ! Lecture and Interpolation of the dynamical fields
41	USE trcini ! Initilization of the passive tracers
42	USE daymod ! calendar (day routine)
43	USE trcstp ! passive tracer time-stepping (trc_stp routine)
44	USE dtadyn ! Lecture and interpolation of the dynamical fields
45	! ! Passive tracers needs
46	USE trc ! passive tracer : variables
47	USE trcnam ! passive tracer : namelist
48	USE trcrst ! passive tracer restart
49	USE diaptr ! Need to initialise this as some variables are used in if statements later
50	USE sbc_oce , ONLY : ln_rnf
51	USE sbcrnf ! surface boundary condition : runoffs
52	! ! I/O & MPP
53	USE iom ! I/O library
54	USE in_out_manager ! I/O manager
55	USE mppini ! shared/distributed memory setting (mpp_init routine)
56	USE lib_mpp ! distributed memory computing
57	#if defined key_iomput
58	USE xios ! xIOserver
59	#endif
60	USE prtctl ! Print control (prt_ctl_init routine)
61	USE timing ! Timing
62	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
63	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
64	USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices
65
66	IMPLICIT NONE
67	PRIVATE
68
69	PUBLIC nemo_gcm ! called by nemo.F90
70
71	CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
72
73	!!----------------------------------------------------------------------
74	!! NEMO/OFF 4.0 , NEMO Consortium (2018)
75	!! $Id$
76	!! Software governed by the CeCILL license (see ./LICENSE)
77	!!----------------------------------------------------------------------
78	CONTAINS
79
80	SUBROUTINE nemo_gcm
81	!!----------------------------------------------------------------------
82	!! * ROUTINE nemo_gcm *
83	!!
84	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
85	!! curvilinear mesh on the sphere.
86	!!
87	!! ** Method : - model general initialization
88	!! - launch the time-stepping (dta_dyn and trc_stp)
89	!! - finalize the run by closing files and communications
90	!!
91	!! References : Madec, Delecluse,Imbard, and Levy, 1997: internal report, IPSL.
92	!! Madec, 2008, internal report, IPSL.
93	!!----------------------------------------------------------------------
94	INTEGER :: istp, indic ! time step index
95	!!----------------------------------------------------------------------
96
97	CALL nemo_init ! Initializations
98
99	! check that all process are still there... If some process have an error,
100	! they will never enter in step and other processes will wait until the end of the cpu time!
101	CALL mpp_max( 'nemogcm', nstop )
102
103	! !-----------------------!
104	! !== time stepping ==!
105	! !-----------------------!
106	istp = nit000
107	!
108	IF( ln_rnf ) CALL sbc_rnf(istp) ! runoffs initialization
109	!
110	CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
111	!
112	DO WHILE ( istp <= nitend .AND. nstop == 0 ) !== OFF time-stepping ==!
113	!
114	IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init)
115	CALL iom_setkt ( istp - nit000 + 1, cxios_context ) ! say to iom that we are at time step kstp
116	#if defined key_sed_off
117	CALL dta_dyn_sed( istp, Nnn ) ! Interpolation of the dynamical fields
118	#else
119	CALL dta_dyn ( istp, Nbb, Nnn, Naa ) ! Interpolation of the dynamical fields
120	#endif
121	CALL trc_stp ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping
122	#if ! defined key_sed_off
123	IF( .NOT.ln_linssh ) CALL dta_dyn_atf( istp, Nbb, Nnn, Naa ) ! time filter of sea surface height and vertical scale factors
124	#endif
125	! Swap time levels
126	Nrhs = Nbb
127	Nbb = Nnn
128	Nnn = Naa
129	Naa = Nrhs
130	!
131	#if ! defined key_sed_off
132	IF( .NOT.ln_linssh ) CALL dta_dyn_sf_interp( istp, Nnn ) ! calculate now grid parameters
133	#endif
134	CALL stp_ctl ( istp, indic ) ! Time loop: control and print
135	istp = istp + 1
136	END DO
137	!
138	#if defined key_iomput
139	CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
140	#endif
141
142	! !------------------------!
143	! !== finalize the run ==!
144	! !------------------------!
145	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
146
147	IF( nstop /= 0 .AND. lwp ) THEN ! error print
148	WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
149	CALL ctl_stop( ctmp1 )
150	ENDIF
151	!
152	IF( ln_timing ) CALL timing_finalize
153	!
154	CALL nemo_closefile
155	!
156	#if defined key_iomput
157	CALL xios_finalize ! end mpp communications with xios
158	#else
159	IF( lk_mpp ) CALL mppstop ! end mpp communications
160	#endif
161	!
162	IF(lwm) THEN
163	IF( nstop == 0 ) THEN ; STOP 0
164	ELSE ; STOP 123
165	ENDIF
166	ENDIF
167	!
168	END SUBROUTINE nemo_gcm
169
170
171	SUBROUTINE nemo_init
172	!!----------------------------------------------------------------------
173	!! * ROUTINE nemo_init *
174	!!
175	!! ** Purpose : initialization of the nemo model in off-line mode
176	!!----------------------------------------------------------------------
177	INTEGER :: ios, ilocal_comm ! local integers
178	!!
179	NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle, &
180	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
181	& ln_timing, ln_diacfl
182	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr, ln_xios_cfg
183	!!----------------------------------------------------------------------
184	!
185	cxios_context = 'nemo'
186	!
187	! !-------------------------------------------------!
188	! ! set communicator & select the local rank !
189	! ! must be done as soon as possible to get narea !
190	! !-------------------------------------------------!
191	!
192	#if defined key_iomput
193	CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios
194	CALL mpp_start( ilocal_comm )
195	#else
196	CALL mpp_start( )
197	#endif
198	!
199	narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 )
200	lwm = (narea == 1) ! control of output namelists
201	!
202	! !---------------------------------------------------------------!
203	! ! Open output files, reference and configuration namelist files !
204	! !---------------------------------------------------------------!
205	!
206	! open ocean.output as soon as possible to get all output prints (including errors messages)
207	IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
208	! open reference and configuration namelist files
209	CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm )
210	CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm )
211	IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
212	! open /dev/null file to be able to supress output write easily
213	IF( Agrif_Root() ) THEN
214	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
215	#ifdef key_agrif
216	ELSE
217	numnul = Agrif_Parent(numnul)
218	#endif
219	ENDIF
220	!
221	! !--------------------!
222	! ! Open listing units ! -> need sn_cfctl from namctl to define lwp
223	! !--------------------!
224	!
225	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
226	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' )
227	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
228	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' )
229	!
230	! finalize the definition of namctl variables
231	IF( sn_cfctl%l_allon ) THEN
232	! Turn on all options.
233	CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. )
234	! Ensure all processors are active
235	sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1
236	ELSEIF( sn_cfctl%l_config ) THEN
237	! Activate finer control of report outputs
238	! optionally switch off output from selected areas (note this only
239	! applies to output which does not involve global communications)
240	IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &
241	& ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &
242	& CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
243	ELSE
244	! turn off all options.
245	CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. )
246	ENDIF
247	!
248	lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print
249	!
250	IF(lwp) THEN ! open listing units
251	!
252	IF( .NOT. lwm ) & ! alreay opened for narea == 1
253	& CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
254	!
255	WRITE(numout,*)
256	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
257	WRITE(numout,*) ' NEMO team'
258	WRITE(numout,*) ' Off-line TOP Model'
259	WRITE(numout,*) ' NEMO version 4.0 (2019) '
260	WRITE(numout,*)
261	WRITE(numout,*) " ._ ._ ._ ._ ._ "
262	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
263	WRITE(numout,*)
264	WRITE(numout,*) " o _, _, "
265	WRITE(numout,*) " o .' ( .-' / "
266	WRITE(numout,*) " o _/..._'. .' / "
267	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
268	WRITE(numout,*) " ) ( o) ;= <_ ( "
269	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
270	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
271	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
272	WRITE(numout,*) " ) ) ` ( ( "
273	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
274	WRITE(numout,*)
275	!
276	WRITE(numout,cform_aaa) ! Flag AAAAAAA
277	!
278	ENDIF
279	!
280	IF(lwm) WRITE( numond, namctl )
281	!
282	! !------------------------------------!
283	! ! Set global domain size parameters !
284	! !------------------------------------!
285	!
286	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
287	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' )
288	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
289	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' )
290	!
291	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
292	CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
293	ELSE ! user-defined namelist
294	CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
295	ENDIF
296	!
297	IF(lwm) WRITE( numond, namcfg )
298	l_offline = .true. ! passive tracers are run offline
299	!
300	! !-----------------------------------------!
301	! ! mpp parameters and domain decomposition !
302	! !-----------------------------------------!
303	!
304	CALL mpp_init
305
306	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
307	CALL nemo_alloc()
308
309	! Initialise time level indices
310	Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa
311
312	! !-------------------------------!
313	! ! NEMO general initialization !
314	! !-------------------------------!
315
316	CALL nemo_ctl ! Control prints
317	!
318	! ! General initialization
319	IF( ln_timing ) CALL timing_init
320	IF( ln_timing ) CALL timing_start( 'nemo_init')
321	!
322	CALL phy_cst ! Physical constants
323	CALL eos_init ! Equation of state
324	IF( lk_c1d ) CALL c1d_init ! 1D column configuration
325	CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain
326	IF( sn_cfctl%l_prtctl ) &
327	& CALL prt_ctl_init ! Print control
328
329	CALL istate_init( Nnn, Naa ) ! ocean initial state (Dynamics and tracers)
330
331	CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module
332	CALL bdy_init ! Open boundaries initialisation
333
334	! ! Tracer physics
335	CALL ldf_tra_init ! Lateral ocean tracer physics
336	CALL ldf_eiv_init ! Eddy induced velocity param
337	CALL tra_ldf_init ! lateral mixing
338	IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing
339	IF( ln_traqsr ) CALL tra_qsr_init ! penetrative solar radiation
340	IF( ln_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme
341
342	! ! Passive tracers
343	CALL trc_nam_run ! Needed to get restart parameters for passive tracers
344	CALL trc_rst_cal( nit000, 'READ' ) ! calendar
345	#if defined key_sed_off
346	CALL dta_dyn_sed_init( Nnn ) ! Initialization for the dynamics
347	#else
348	CALL dta_dyn_init( Nbb, Nnn, Naa ) ! Initialization for the dynamics
349	#endif
350
351	CALL trc_init( Nbb, Nnn, Naa ) ! Passive tracers initialization
352	CALL dia_ptr_init ! Poleward TRansports initialization
353
354	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
355	!
356	IF( ln_timing ) CALL timing_stop( 'nemo_init')
357	!
358	END SUBROUTINE nemo_init
359
360
361	SUBROUTINE nemo_ctl
362	!!----------------------------------------------------------------------
363	!! * ROUTINE nemo_ctl *
364	!!
365	!! ** Purpose : control print setting
366	!!
367	!! ** Method : - print namctl and namcfg information and check some consistencies
368	!!----------------------------------------------------------------------
369	!
370	IF(lwp) THEN ! control print
371	WRITE(numout,*)
372	WRITE(numout,*) 'nemo_ctl: Control prints'
373	WRITE(numout,*) '~~~~~~~~'
374	WRITE(numout,*) ' Namelist namctl'
375	WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk
376	WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon
377	WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config
378	WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
379	WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
380	WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout
381	WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout
382	WRITE(numout,*) ' sn_cfctl%l_prtctl = ', sn_cfctl%l_prtctl
383	WRITE(numout,*) ' sn_cfctl%l_prttrc = ', sn_cfctl%l_prttrc
384	WRITE(numout,*) ' sn_cfctl%l_oasout = ', sn_cfctl%l_oasout
385	WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin
386	WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax
387	WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr
388	WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr
389	WRITE(numout,*) ' level of print nn_print = ', nn_print
390	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
391	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
392	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
393	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
394	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
395	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
396	WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing
397	WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl
398	ENDIF
399	!
400	nprint = nn_print ! convert DOCTOR namelist names into OLD names
401	nictls = nn_ictls
402	nictle = nn_ictle
403	njctls = nn_jctls
404	njctle = nn_jctle
405	isplt = nn_isplt
406	jsplt = nn_jsplt
407
408	IF(lwp) THEN ! control print
409	WRITE(numout,*)
410	WRITE(numout,*) ' Namelist namcfg'
411	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
412	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
413	WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea
414	WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg
415	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
416	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
417	ENDIF
418	IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file
419	!
420	! ! Parameter control
421	!
422	IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints
423	IF( lk_mpp .AND. jpnij > 1 ) THEN
424	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
425	ELSE
426	IF( isplt == 1 .AND. jsplt == 1 ) THEN
427	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
428	& ' - the print control will be done over the whole domain' )
429	ENDIF
430	ijsplt = isplt * jsplt ! total number of processors ijsplt
431	ENDIF
432	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
433	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
434	!
435	! ! indices used for the SUM control
436	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
437	lsp_area = .FALSE.
438	ELSE ! print control done over a specific area
439	lsp_area = .TRUE.
440	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
441	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
442	nictls = 1
443	ENDIF
444	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
445	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
446	nictle = jpiglo
447	ENDIF
448	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
449	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
450	njctls = 1
451	ENDIF
452	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
453	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
454	njctle = jpjglo
455	ENDIF
456	ENDIF
457	ENDIF
458	!
459	IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', &
460	& 'Compile with key_nosignedzero enabled' )
461	!
462	END SUBROUTINE nemo_ctl
463
464
465	SUBROUTINE nemo_closefile
466	!!----------------------------------------------------------------------
467	!! * ROUTINE nemo_closefile *
468	!!
469	!! ** Purpose : Close the files
470	!!----------------------------------------------------------------------
471	!
472	IF( lk_mpp ) CALL mppsync
473	!
474	CALL iom_close ! close all input/output files managed by iom_*
475	!
476	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
477	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
478	!
479	numout = 6 ! redefine numout in case it is used after this point...
480	!
481	END SUBROUTINE nemo_closefile
482
483
484	SUBROUTINE nemo_alloc
485	!!----------------------------------------------------------------------
486	!! * ROUTINE nemo_alloc *
487	!!
488	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
489	!!
490	!! ** Method :
491	!!----------------------------------------------------------------------
492	USE diawri , ONLY : dia_wri_alloc
493	USE dom_oce, ONLY : dom_oce_alloc
494	USE zdf_oce, ONLY : zdf_oce_alloc
495	USE trc_oce, ONLY : trc_oce_alloc
496	USE bdy_oce, ONLY : bdy_oce_alloc
497	!
498	INTEGER :: ierr
499	!!----------------------------------------------------------------------
500	!
501	ierr = oce_alloc () ! ocean
502	ierr = ierr + dia_wri_alloc()
503	ierr = ierr + dom_oce_alloc() ! ocean domain
504	ierr = ierr + zdf_oce_alloc() ! ocean vertical physics
505	ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays
506	ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization)
507	!
508	CALL mpp_sum( 'nemogcm', ierr )
509	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
510	!
511	END SUBROUTINE nemo_alloc
512
513	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
514	!!----------------------------------------------------------------------
515	!! * ROUTINE nemo_set_cfctl *
516	!!
517	!! ** Purpose : Set elements of the output control structure to setto.
518	!! for_all should be .false. unless all areas are to be
519	!! treated identically.
520	!!
521	!! ** Method : Note this routine can be used to switch on/off some
522	!! types of output for selected areas but any output types
523	!! that involve global communications (e.g. mpp_max, glob_sum)
524	!! should be protected from selective switching by the
525	!! for_all argument
526	!!----------------------------------------------------------------------
527	LOGICAL :: setto, for_all
528	TYPE(sn_ctl) :: sn_cfctl
529	!!----------------------------------------------------------------------
530	IF( for_all ) THEN
531	sn_cfctl%l_runstat = setto
532	sn_cfctl%l_trcstat = setto
533	ENDIF
534	sn_cfctl%l_oceout = setto
535	sn_cfctl%l_layout = setto
536	sn_cfctl%l_prtctl = setto
537	sn_cfctl%l_prttrc = setto
538	sn_cfctl%l_oasout = setto
539	END SUBROUTINE nemo_set_cfctl
540
541	SUBROUTINE istate_init( Kmm, Kaa )
542	!!----------------------------------------------------------------------
543	!! * ROUTINE istate_init *
544	!!
545	!! ** Purpose : Initialization to zero of the dynamics and tracers.
546	!!----------------------------------------------------------------------
547	INTEGER, INTENT(in) :: Kmm, Kaa ! ocean time level indices
548	!
549	! now fields ! after fields !
550	uu (:,:,:,Kmm) = 0._wp ; uu(:,:,:,Kaa) = 0._wp !
551	vv (:,:,:,Kmm) = 0._wp ; vv(:,:,:,Kaa) = 0._wp !
552	ww (:,:,:) = 0._wp ! !
553	hdiv (:,:,:) = 0._wp ! !
554	ts (:,:,:,:,Kmm) = 0._wp ! !
555	!
556	rhd (:,:,:) = 0.e0
557	rhop (:,:,:) = 0.e0
558	rn2 (:,:,:) = 0.e0
559	!
560	END SUBROUTINE istate_init
561
562
563	SUBROUTINE stp_ctl( kt, kindic )
564	!!----------------------------------------------------------------------
565	!! * ROUTINE stp_ctl *
566	!!
567	!! ** Purpose : Control the run
568	!!
569	!! ** Method : - Save the time step in numstp
570	!!
571	!! ** Actions : 'time.step' file containing the last ocean time-step
572	!!----------------------------------------------------------------------
573	INTEGER, INTENT(in ) :: kt ! ocean time-step index
574	INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence
575	!!----------------------------------------------------------------------
576	!
577	IF( kt == nit000 .AND. lwm ) THEN
578	WRITE(numout,*)
579	WRITE(numout,*) 'stp_ctl : time-stepping control'
580	WRITE(numout,*) '~~~~~~~'
581	! open time.step file
582	CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
583	ENDIF
584	!
585	IF(lwm) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp
586	IF(lwm) REWIND( numstp ) ! --------------------------
587	!
588	END SUBROUTINE stp_ctl
589	!!======================================================================
590	END MODULE nemogcm

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

Download in other formats: