Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

nemogcm.F90

Last change on this file was 15279, checked in by jchanut, 3 years ago
#2222 and #2638: Enable creating agrif meshes with different vertical grids (geopotential only as a start)
File size: 22.4 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) LIM 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	!! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
31	!! - ! 2011-11 (C. Harris) decomposition changes for running with CICE
32	!! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening
33	!! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication
34	!! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla)
35	!!----------------------------------------------------------------------
36
37	!!----------------------------------------------------------------------
38	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
39	!! nemo_init : initialization of the NEMO system
40	!! nemo_ctl : initialisation of the contol print
41	!! nemo_closefile: close remaining open files
42	!! nemo_alloc : dynamical allocation
43	!! nemo_partition: calculate MPP domain decomposition
44	!! factorise : calculate the factors of the no. of MPI processes
45	!!----------------------------------------------------------------------
46	USE dom_oce ! ocean space and time domain variables
47	USE in_out_manager ! I/O manager
48	USE iom !
49	USE domcfg ! domain configuration (dom_cfg routine)
50	USE mppini ! shared/distributed memory setting (mpp_init routine)
51	USE domain ! domain initialization (dom_init routine)
52	USE phycst ! physical constant (par_cst routine)
53	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
54	USE lib_mpp ! distributed memory computing
55
56
57	USE agrif_connect
58	USE agrif_dom_update
59	USE agrif_recompute_scales
60
61	USE halo_mng
62
63	IMPLICIT NONE
64	PRIVATE
65
66	PUBLIC nemo_gcm ! called by model.F90
67	PUBLIC nemo_init ! needed by AGRIF
68	PUBLIC nemo_alloc ! needed by TAM
69
70	CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
71
72	!!----------------------------------------------------------------------
73	!! NEMO/OPA 3.7 , NEMO Consortium (2015)
74	!! $Id: nemogcm.F90 6152 2015-12-21 22:33:57Z acc $
75	!! Software governed by the CeCILL licence (./LICENSE)
76	!!----------------------------------------------------------------------
77	CONTAINS
78
79	SUBROUTINE nemo_gcm
80	!!----------------------------------------------------------------------
81	!! * ROUTINE nemo_gcm *
82	!!
83	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
84	!! curvilinear mesh on the sphere.
85	!!
86	!! ** Method : - model general initialization
87	!! - launch the time-stepping (stp routine)
88	!! - finalize the run by closing files and communications
89	!!
90	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
91	!! Madec, 2008, internal report, IPSL.
92	!!----------------------------------------------------------------------
93	INTEGER :: istp ! time step index
94	!!----------------------------------------------------------------------
95	!
96	#if defined key_agrif
97	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
98	#endif
99	! !-----------------------!
100	CALL nemo_init !== Initialisations ==!
101	! !-----------------------!
102
103	#if defined key_agrif
104	CALL Agrif_Regrid()
105
106	! CALL Agrif_Step_Child(agrif_boundary_connections)
107
108	CALL Agrif_Step_Child_adj(agrif_update_all)
109
110	! CALL Agrif_Step_Child(agrif_recompute_scalefactors)
111
112	CALL Agrif_Step_Child(cfg_write)
113	#endif
114
115	! check that all process are still there... If some process have an error,
116	! they will never enter in step and other processes will wait until the end of the cpu time!
117	IF( lk_mpp ) CALL mpp_max( 'nemogcm',nstop )
118
119	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
120
121	! !-----------------------!
122	! !== finalize the run ==!
123	! !------------------------!
124	!
125	IF( nstop /= 0 .AND. lwp ) THEN ! error print
126	ngrdstop = Agrif_Fixed()
127	WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
128	IF( ngrdstop > 0 ) THEN
129	WRITE(ctmp9,'(i2)') ngrdstop
130	WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9)
131	WRITE(ctmp3,) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output files'
132	CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 )
133	ELSE
134	WRITE(ctmp2,) ' Look for "E R R O R" messages in all existing ocean_output files'
135	CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 )
136	ENDIF
137	ENDIF
138	!
139	!
140	CALL nemo_closefile
141	!
142	!
143	END SUBROUTINE nemo_gcm
144
145
146	SUBROUTINE nemo_init
147	!!----------------------------------------------------------------------
148	!! * ROUTINE nemo_init *
149	!!
150	!! ** Purpose : initialization of the NEMO GCM
151	!!----------------------------------------------------------------------
152	INTEGER :: ji ! dummy loop indices
153	INTEGER :: ios, ilocal_comm ! local integers
154	CHARACTER(len=120), DIMENSION(60) :: cltxt, cltxt2, clnam
155	!!
156	NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, &
157	& nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle
158	NAMELIST/namcfg/ ln_e3_dep, &
159	& cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, Ni0glo, Nj0glo, &
160	& jpkglo, jperio, ln_use_jattr, ln_domclo
161	!!----------------------------------------------------------------------
162	!
163
164	!
165	! !-------------------------------------------------!
166	! ! set communicator & select the local rank !
167	! ! must be done as soon as possible to get narea !
168	! !-------------------------------------------------!
169	!
170	#if defined key_iomput
171	IF( Agrif_Root() ) THEN
172	IF( lk_oasis ) THEN
173	CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
174	CALL xios_initialize( "not used" , local_comm =ilocal_comm ) ! send nemo communicator to xios
175	ELSE
176	CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios
177	ENDIF
178	ENDIF
179	CALL mpp_start( ilocal_comm )
180	#else
181	! IF( lk_oasis ) THEN
182	! IF( Agrif_Root() ) THEN
183	! CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
184	! ENDIF
185	! CALL mpp_start( ilocal_comm )
186	! ELSE
187	CALL mpp_start( )
188	! ENDIF
189	#endif
190	!
191	narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 )
192	lwm = (narea == 1) ! control of output namelists
193
194	cltxt = ''
195	!
196	!
197	! !---------------------------------------------------------------!
198	! ! Open output files, reference and configuration namelist files !
199	! !---------------------------------------------------------------!
200	!
201	! open ocean.output as soon as possible to get all output prints (including errors messages)
202	IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
203	! open reference and configuration namelist files
204	CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm )
205	CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm )
206	IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
207	! open /dev/null file to be able to supress output write easily
208	IF( Agrif_Root() ) THEN
209	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
210	#ifdef key_agrif
211	ELSE
212	numnul = Agrif_Parent(numnul)
213	#endif
214	ENDIF
215
216	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
217	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist')
218	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
219	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist')
220
221	lwp = (narea == 1) ! control of all listing output print
222
223	IF(lwm) THEN
224	! write merged namelists from earlier to output namelist now that the
225	! file has been opened in call to mynode. nammpp has already been
226	! written in mynode (if lk_mpp_mpi)
227	WRITE( numond, namcfg )
228	ENDIF
229
230	! !--------------------!
231	! ! Open listing units ! -> need sn_cfctl from namctl to define lwp
232	! !--------------------!
233	!
234	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
235	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' )
236	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
237	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' )
238	!
239	! finalize the definition of namctl variables
240	IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) &
241	& CALL nemo_set_cfctl( sn_cfctl, .FALSE. )
242	!
243	lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print
244	!
245	IF(lwp) THEN ! open listing units
246	!
247	IF( .NOT. lwm ) & ! alreay opened for narea == 1
248	& CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
249	!
250	WRITE(numout,*)
251	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
252	WRITE(numout,*) ' NEMO team'
253	WRITE(numout,*) ' Ocean General Circulation Model'
254	WRITE(numout,*) ' NEMO version 4.0 (2019) '
255	WRITE(numout,*)
256	WRITE(numout,*) " ._ ._ ._ ._ ._ "
257	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
258	WRITE(numout,*)
259	WRITE(numout,*) " o _, _, "
260	WRITE(numout,*) " o .' ( .-' / "
261	WRITE(numout,*) " o _/..._'. .' / "
262	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
263	WRITE(numout,*) " ) ( o) ;= <_ ( "
264	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
265	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
266	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
267	WRITE(numout,*) " ) ) jgs ` ( ( "
268	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
269	WRITE(numout,*)
270
271	! Print the working precision to ocean.output
272	IF (wp == dp) THEN
273	WRITE(numout,*) "Working precision = double-precision"
274	ELSE
275	WRITE(numout,*) "Working precision = single-precision"
276	ENDIF
277	WRITE(numout,*)
278	!
279	WRITE(numout,cform_aaa) ! Flag AAAAAAA
280	!
281	ENDIF
282	!
283	IF(lwm) WRITE( numond, namctl )
284	!
285	! !-----------------------------------------!
286	! ! mpp parameters and domain decomposition !
287	! !-----------------------------------------!
288	CALL mpp_init
289	CALL halo_mng_init()
290	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
291
292	! IF( Agrif_Root() ) THEN
293	! jpi = ( jpiglo -2jpreci + (jpni-1) ) / jpni + 2jpreci ! first dim.
294	! jpj = ( jpjglo -2jprecj + (jpnj-1) ) / jpnj + 2jprecj ! second dim.
295	! ENDIF
296	jpk = jpkdta ! third dim
297	jpim1 = jpi-1 ! inner domain indices
298	jpjm1 = jpj-1 ! " "
299	jpkm1 = jpk-1 ! " "
300	jpij = jpi*jpj ! jpi x j
301
302	#if defined key_agrif
303	CALL Agrif_Declare_Var
304	#endif
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	! !-------------------------------!
310	! ! NEMO general initialization !
311	! !-------------------------------!
312
313	! ! Domain decomposition
314	!
315	! ! General initialization
316	CALL phy_cst ! Physical constants
317	CALL dom_cfg ! Domain configuration
318	CALL dom_init ! Domain
319	!
320	END SUBROUTINE nemo_init
321
322	SUBROUTINE nemo_closefile
323	!!----------------------------------------------------------------------
324	!! * ROUTINE nemo_closefile *
325	!!
326	!! ** Purpose : Close the files
327	!!----------------------------------------------------------------------
328	!
329	IF( lk_mpp ) CALL mppsync
330	!
331	CALL iom_close ! close all input/output files managed by iom_*
332	!
333	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
334	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
335	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
336	!
337	numout = 6 ! redefine numout in case it is used after this point...
338	!
339	END SUBROUTINE nemo_closefile
340
341
342	SUBROUTINE nemo_alloc
343	!!----------------------------------------------------------------------
344	!! * ROUTINE nemo_alloc *
345	!!
346	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
347	!!
348	!! ** Method :
349	!!----------------------------------------------------------------------
350	USE dom_oce , ONLY: dom_oce_alloc
351	!
352	INTEGER :: ierr
353	!!----------------------------------------------------------------------
354	!
355	ierr = 0
356	ierr = ierr + dom_oce_alloc () ! ocean domain
357	!
358	CALL mpp_sum( 'nemogcm', ierr )
359	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
360	!
361	END SUBROUTINE nemo_alloc
362
363	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto )
364	!!----------------------------------------------------------------------
365	!! * ROUTINE nemo_set_cfctl *
366	!!
367	!! ** Purpose : Set elements of the output control structure to setto.
368	!!
369	!! ** Method : Note this routine can be used to switch on/off some
370	!! types of output for selected areas.
371	!!----------------------------------------------------------------------
372	TYPE(sn_ctl), INTENT(inout) :: sn_cfctl
373	LOGICAL , INTENT(in ) :: setto
374	!!----------------------------------------------------------------------
375	sn_cfctl%l_runstat = setto
376	sn_cfctl%l_trcstat = setto
377	sn_cfctl%l_oceout = setto
378	sn_cfctl%l_layout = setto
379	sn_cfctl%l_prtctl = setto
380	sn_cfctl%l_prttrc = setto
381	sn_cfctl%l_oasout = setto
382	END SUBROUTINE nemo_set_cfctl
383
384	SUBROUTINE nemo_partition( num_pes )
385	!!----------------------------------------------------------------------
386	!! * ROUTINE nemo_partition *
387	!!
388	!! ** Purpose :
389	!!
390	!! ** Method :
391	!!----------------------------------------------------------------------
392	INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
393	!
394	INTEGER, PARAMETER :: nfactmax = 20
395	INTEGER :: nfact ! The no. of factors returned
396	INTEGER :: ierr ! Error flag
397	INTEGER :: ji
398	INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
399	INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
400	!!----------------------------------------------------------------------
401	!
402	ierr = 0
403	!
404	CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
405	!
406	IF( nfact <= 1 ) THEN
407	WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
408	WRITE (numout, *) ' : using grid of ',num_pes,' x 1'
409	jpnj = 1
410	jpni = num_pes
411	ELSE
412	! Search through factors for the pair that are closest in value
413	mindiff = 1000000
414	imin = 1
415	DO ji = 1, nfact-1, 2
416	idiff = ABS( ifact(ji) - ifact(ji+1) )
417	IF( idiff < mindiff ) THEN
418	mindiff = idiff
419	imin = ji
420	ENDIF
421	END DO
422	jpnj = ifact(imin)
423	jpni = ifact(imin + 1)
424	ENDIF
425	!
426	jpnij = jpni*jpnj
427	!
428	END SUBROUTINE nemo_partition
429
430
431	SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
432	!!----------------------------------------------------------------------
433	!! * ROUTINE factorise *
434	!!
435	!! ** Purpose : return the prime factors of n.
436	!! knfax factors are returned in array kfax which is of
437	!! maximum dimension kmaxfax.
438	!! ** Method :
439	!!----------------------------------------------------------------------
440	INTEGER , INTENT(in ) :: kn, kmaxfax
441	INTEGER , INTENT( out) :: kerr, knfax
442	INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax
443	!
444	INTEGER :: ifac, jl, inu
445	INTEGER, PARAMETER :: ntest = 14
446	INTEGER, DIMENSION(ntest) :: ilfax
447	!!----------------------------------------------------------------------
448	!
449	! lfax contains the set of allowed factors.
450	ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
451	!
452	! Clear the error flag and initialise output vars
453	kerr = 0
454	kfax = 1
455	knfax = 0
456	!
457	! Find the factors of n.
458	IF( kn == 1 ) GOTO 20
459
460	! nu holds the unfactorised part of the number.
461	! knfax holds the number of factors found.
462	! l points to the allowed factor list.
463	! ifac holds the current factor.
464	!
465	inu = kn
466	knfax = 0
467	!
468	DO jl = ntest, 1, -1
469	!
470	ifac = ilfax(jl)
471	IF( ifac > inu ) CYCLE
472
473	! Test whether the factor will divide.
474
475	IF( MOD(inu,ifac) == 0 ) THEN
476	!
477	knfax = knfax + 1 ! Add the factor to the list
478	IF( knfax > kmaxfax ) THEN
479	kerr = 6
480	write (,) 'FACTOR: insufficient space in factor array ', knfax
481	return
482	ENDIF
483	kfax(knfax) = ifac
484	! Store the other factor that goes with this one
485	knfax = knfax + 1
486	kfax(knfax) = inu / ifac
487	!WRITE (,) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
488	ENDIF
489	!
490	END DO
491	!
492	20 CONTINUE ! Label 20 is the exit point from the factor search loop.
493	!
494	END SUBROUTINE factorise
495
496	!!======================================================================
497	END MODULE nemogcm
498

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

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

Context Navigation

source: utils/tools/DOMAINcfg/src/nemogcm.F90

Download in other formats: