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 @ 1594

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

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

Download in other formats: