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.

opa.F90 in trunk/NEMO/OPA_SRC – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/opa.F90 @ 1627

Last change on this file since 1627 was 1627, checked in by smasson, 15 years ago
make sure that numout is open until the end of the job, see ticket:540
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 18.9 KB

Line
1	MODULE opa
2	!!==============================================================================
3	!! * MODULE opa *
4	!! Ocean system : OPA ocean dynamics (including on-line tracers 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	!!----------------------------------------------------------------------
28
29	!!----------------------------------------------------------------------
30	!! opa_model : solve ocean dynamics, tracer and/or sea-ice
31	!! opa_init : initialization of the opa model
32	!! opa_flg : initialisation of algorithm flag
33	!! opa_closefile : close remaining files
34	!!----------------------------------------------------------------------
35	USE oce ! dynamics and tracers variables
36	USE dom_oce ! ocean space domain variables
37	USE sbc_oce ! surface boundary condition: ocean
38	USE trdmod_oce ! ocean variables trends
39	USE daymod ! calendar
40	USE domcfg ! domain configuration (dom_cfg routine)
41	USE mppini ! shared/distributed memory setting (mpp_init routine)
42	USE domain ! domain initialization (dom_init routine)
43	USE obc_par ! open boundary cond. parameters
44	USE obcini ! open boundary cond. initialization (obc_ini routine)
45	USE bdy_par ! unstructured open boundary cond. parameters
46	USE bdyini ! unstructured open boundary cond. initialization (bdy_init routine)
47	USE istate ! initial state setting (istate_init routine)
48	USE eosbn2 ! equation of state (eos_init routine)
49	USE dynhpg ! hydrostatic pressure gradient
50	USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine)
51	USE ldftra ! lateral diffusivity setting (ldftra_init routine)
52	USE zdfini
53	USE phycst ! physical constant (par_cst routine)
54	USE trdmod ! momentum/tracers trends (trd_mod_init routine)
55	USE diaptr ! poleward transports (dia_ptr_init routine)
56	USE step ! OPA time-stepping (stp routine)
57	#if defined key_oasis3
58	USE cpl_oasis3 ! OASIS3 coupling
59	#elif defined key_oasis4
60	USE cpl_oasis4 ! OASIS4 coupling (not working)
61	#endif
62	USE dynspg_oce ! Control choice of surface pressure gradient schemes
63	USE prtctl ! Print control (prt_ctl_init routine)
64	USE c1d ! 1D configuration
65	USE dyncor_c1d ! Coriolis factor at T-point
66	USE step_c1d ! Time stepping loop for the 1D configuration
67	#if defined key_top
68	USE trcini ! passive tracer initialisation
69	#endif
70
71	USE iom
72	USE in_out_manager ! I/O manager
73	USE lib_mpp ! distributed memory computing
74	#if defined key_iomput
75	USE mod_ioclient
76	#endif
77
78	IMPLICIT NONE
79	PRIVATE
80
81	PUBLIC opa_model ! called by model.F90
82	PUBLIC opa_init ! needed by AGRIF
83
84	CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
85
86	!!----------------------------------------------------------------------
87	!! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
88	!! $Id$
89	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
90	!!----------------------------------------------------------------------
91
92	CONTAINS
93
94	SUBROUTINE opa_model
95	!!----------------------------------------------------------------------
96	!! * ROUTINE opa *
97	!!
98	!! ** Purpose : opa solves the primitive equations on an orthogonal
99	!! curvilinear mesh on the sphere.
100	!!
101	!! ** Method : - model general initialization
102	!! - launch the time-stepping (stp routine)
103	!! - finalize the run by closing files and communications
104	!!
105	!! References : Madec, Delecluse,Imbard, and Levy, 1997: internal report, IPSL.
106	!! Madec, 2008, internal report, IPSL.
107	!!----------------------------------------------------------------------
108	INTEGER :: istp ! time step index
109	!!----------------------------------------------------------------------
110
111	#if defined key_agrif
112	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
113	#endif
114
115	! !-----------------------!
116	CALL opa_init !== Initialisations ==!
117	! !-----------------------!
118
119	! check that all process are still there... If some process have an error,
120	! they will never enter in step and other processes will wait until the end of the cpu time!
121	IF( lk_mpp ) CALL mpp_max( nstop )
122
123	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
124
125	! !-----------------------!
126	! !== time stepping ==!
127	! !-----------------------!
128	istp = nit000
129	IF( lk_c1d ) THEN !== 1D configuration ==!
130	DO WHILE ( istp <= nitend .AND. nstop == 0 )
131	CALL stp_c1d( istp )
132	istp = istp + 1
133	END DO
134	ELSE !== 3D ocean with ==!
135	DO WHILE ( istp <= nitend .AND. nstop == 0 )
136	#if defined key_agrif
137	CALL Agrif_Step( stp ) ! AGRIF: time stepping
138	#else
139	CALL stp( istp ) ! standard time stepping
140	#endif
141	istp = istp + 1
142	IF( lk_mpp ) CALL mpp_max( nstop )
143	END DO
144	ENDIF
145
146	! !------------------------!
147	! !== finalize the run ==!
148	! !------------------------!
149	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
150	!
151	IF( nstop /= 0 .AND. lwp ) THEN ! error print
152	WRITE(numout,cform_err)
153	WRITE(numout,*) nstop, ' error have been found'
154	ENDIF
155	!
156	CALL opa_closefile
157	#if defined key_oasis3 \|\| defined key_oasis4
158	CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS
159	#else
160	IF( lk_mpp ) CALL mppstop ! end mpp communications
161	#endif
162	!
163	END SUBROUTINE opa_model
164
165
166	SUBROUTINE opa_init
167	!!----------------------------------------------------------------------
168	!! * ROUTINE opa_init *
169	!!
170	!! ** Purpose : initialization of the opa model
171	!!
172	!!----------------------------------------------------------------------
173	#if defined key_oasis3 \|\| defined key_oasis4 \|\| defined key_iomput
174	INTEGER :: ilocal_comm
175	#endif
176	CHARACTER(len=80),dimension(10) :: cltxt = ''
177	INTEGER :: ji ! local loop indices
178	!!
179	NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &
180	& nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench, nn_bit_cmp
181	!!----------------------------------------------------------------------
182	!
183	! ! open Namelist file
184	CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
185	!
186	READ( numnam, namctl ) ! Namelist namctl : Control prints & Benchmark
187	!
188	! !--------------------------------------------!
189	! ! set communicator & select the local node !
190	! !--------------------------------------------!
191	#if defined key_iomput
192	# if defined key_oasis3 \|\| defined key_oasis4
193	CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis
194	CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it)
195	# else
196	CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server
197	# endif
198	narea = mynode( cltxt, ilocal_comm ) ! Nodes selection
199
200	#else
201	# if defined key_oasis3 \|\| defined key_oasis4
202	CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis
203	narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt)
204	# else
205	narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt)
206	# endif
207	#endif
208	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
209
210	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
211
212	IF(lwp) THEN ! open listing units
213	!
214	CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
215	!
216	WRITE(numout,*)
217	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean'
218	WRITE(numout,*) ' NEMO team'
219	WRITE(numout,*) ' Ocean General Circulation Model'
220	WRITE(numout,*) ' version 3.2 (2009) '
221	WRITE(numout,*)
222	WRITE(numout,*)
223	DO ji = 1, SIZE(cltxt)
224	IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode
225	END DO
226	WRITE(numout,cform_aaa) ! Flag AAAAAAA
227	!
228	ENDIF
229	! !--------------------------------!
230	! ! Model general initialization !
231	! !--------------------------------!
232
233	CALL opa_flg ! Control prints & Benchmark
234
235	! Domain decomposition
236	IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out
237	ELSE ; CALL mpp_init2 ! eliminate land processors
238	ENDIF
239
240	CALL phy_cst ! Physical constants
241	CALL eos_init ! Equation of state
242	CALL dom_cfg ! Domain configuration
243	CALL dom_init ! Domain
244	!!gm c1d case can be moved in dom_init routine
245	IF( lk_c1d ) THEN ! 1D configuration
246	CALL cor_c1d ! Coriolis defined at T-point
247	umask(:,:,:) = tmask(:,:,:) ! U, V and T-points are the same
248	vmask(:,:,:) = tmask(:,:,:) !
249	ENDIF
250	!!gm c1d end
251
252	IF( ln_ctl ) CALL prt_ctl_init ! Print control
253
254	IF( lk_obc ) CALL obc_init ! Open boundaries
255	IF( lk_bdy ) CALL bdy_init ! Unstructured open boundaries
256
257	CALL istate_init ! ocean initial state (Dynamics and tracers)
258
259	! ! Ocean physics
260	CALL ldf_tra_init ! Lateral ocean tracer physics
261	CALL ldf_dyn_init ! Lateral ocean momentum physics
262	CALL zdf_init ! Vertical ocean physics
263
264	#if defined key_top
265	CALL trc_ini ! Passive tracers
266	#endif
267
268	! ! diagnostics
269	CALL iom_init( fjulday - adatrj ) ! iom_put initialization
270	CALL dia_ptr_init ! Poleward TRansports initialization
271	CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends
272	!
273	END SUBROUTINE opa_init
274
275
276	SUBROUTINE opa_flg
277	!!----------------------------------------------------------------------
278	!! * ROUTINE opa *
279	!!
280	!! ** Purpose : Initialise logical flags that control the choice of
281	!! some algorithm or control print
282	!!
283	!! ** Method : - print namctl information
284	!! - Read in namilist namflg logical flags
285	!!----------------------------------------------------------------------
286	NAMELIST/namdyn_hpg/ ln_hpg_zco , ln_hpg_zps , ln_hpg_sco, ln_hpg_hel, &
287	& ln_hpg_wdj , ln_hpg_djc , ln_hpg_rot, rn_gamma , &
288	& ln_dynhpg_imp, nn_dynhpg_rst
289	!!----------------------------------------------------------------------
290
291	IF(lwp) THEN ! Parameter print
292	WRITE(numout,*)
293	WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
294	WRITE(numout,*) '~~~~~~~ '
295	WRITE(numout,*) ' Namelist namctl'
296	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
297	WRITE(numout,*) ' level of print nn_print = ', nn_print
298	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
299	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
300	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
301	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
302	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
303	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
304	WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench
305	WRITE(numout,*) ' bit comparison mode (0/1) nn_bit_cmp = ', nn_bit_cmp
306	ENDIF
307
308	nprint = nn_print ! convert DOCTOR namelist names into OLD names
309	nictls = nn_ictls
310	nictle = nn_ictle
311	njctls = nn_jctls
312	njctle = nn_jctle
313	isplt = nn_isplt
314	jsplt = nn_jsplt
315	nbench = nn_bench
316	nbit_cmp = nn_bit_cmp
317
318	! ! Parameter control
319	!
320	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
321	IF( lk_mpp ) THEN
322	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real splitted domain
323	ELSE
324	IF( isplt == 1 .AND. jsplt == 1 ) THEN
325	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
326	& ' - the print control will be done over the whole domain' )
327	ENDIF
328	ijsplt = isplt * jsplt ! total number of processors ijsplt
329	ENDIF
330	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
331	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
332	!
333	! ! indices used for the SUM control
334	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
335	lsp_area = .FALSE.
336	ELSE ! print control done over a specific area
337	lsp_area = .TRUE.
338	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
339	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
340	nictls = 1
341	ENDIF
342	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
343	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
344	nictle = jpiglo
345	ENDIF
346	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
347	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
348	njctls = 1
349	ENDIF
350	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
351	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
352	njctle = jpjglo
353	ENDIF
354	ENDIF
355	ENDIF
356
357	IF( nbench == 1 ) THEN ! Benchmark
358	SELECT CASE ( cp_cfg )
359	CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' )
360	CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', &
361	& ' key_gyre must be used or set nbench = 0' )
362	END SELECT
363	ENDIF
364
365	IF( nbit_cmp == 1 ) THEN ! Bit compare
366	CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', &
367	& ' WARNING: RESULTS ARE NOT PHYSICAL.' )
368	ENDIF
369
370	REWIND( numnam ) ! Read Namelist namdyn_hpg : ln_dynhpg_imp must be read at the initialisation phase
371	READ ( numnam, namdyn_hpg )
372	!
373	END SUBROUTINE opa_flg
374
375
376	SUBROUTINE opa_closefile
377	!!----------------------------------------------------------------------
378	!! * ROUTINE opa_closefile *
379	!!
380	!! ** Purpose : Close the files
381	!!----------------------------------------------------------------------
382	USE dtatem ! temperature data
383	USE dtasal ! salinity data
384	!!----------------------------------------------------------------------
385	!
386	IF( lk_mpp ) CALL mppsync
387	!
388	IF(lwp) CLOSE( numstp ) ! time-step file
389	IF(lwp) CLOSE( numsol ) ! solver file
390	!
391	CALL iom_close ! close all input/output files
392	!
393	CLOSE( numnam ) ! namelist
394	CLOSE( numout ) ! standard model output file
395	!
396	END SUBROUTINE opa_closefile
397
398	!!======================================================================
399	END MODULE opa

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

Download in other formats: