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

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

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

Download in other formats: