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

Last change on this file since 708 was 708, checked in by smasson, 17 years ago
continue changeset:704, see ticket:5
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
7	!!----------------------------------------------------------------------
8	!! opa_model : solve ocean dynamics, tracer and/or sea-ice
9	!! opa_init : initialization of the opa model
10	!! opa_flg : initialisation of algorithm flag
11	!! opa_closefile : close remaining files
12	!!----------------------------------------------------------------------
13	!! History :
14	!! 4.0 ! 90-10 (C. Levy, G. Madec) Original code
15	!! 7.0 ! 91-11 (M. Imbard, C. Levy, G. Madec)
16	!! 7.1 ! 93-03 (M. Imbard, C. Levy, G. Madec, O. Marti,
17	!! M. Guyon, A. Lazar, P. Delecluse, C. Perigaud,
18	!! G. Caniaux, B. Colot, C. Maes ) release 7.1
19	!! ! 92-06 (L.Terray) coupling implementation
20	!! ! 93-11 (M.A. Filiberti) IGLOO sea-ice
21	!! 8.0 ! 96-03 (M. Imbard, C. Levy, G. Madec, O. Marti,
22	!! M. Guyon, A. Lazar, P. Delecluse, L.Terray,
23	!! M.A. Filiberti, J. Vialar, A.M. Treguier,
24	!! M. Levy) release 8.0
25	!! 8.1 ! 97-06 (M. Imbard, G. Madec)
26	!! 8.2 ! 99-11 (M. Imbard, H. Goosse) LIM sea-ice model
27	!! ! 99-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP
28	!! ! 00-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER)
29	!! 9.0 ! 02-08 (G. Madec) F90: Free form and modules
30	!! " ! 04-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
31	!! " ! 04-08 (C. Talandier) New trends organization
32	!! " ! 05-06 (C. Ethe) Add the 1D configuration possibility
33	!! " ! 05-11 (V. Garnier) Surface pressure gradient organization
34	!! " ! 06-03 (L. Debreu, C. Mazauric) Agrif implementation
35	!! " ! 06-04 (G. Madec, R. Benshila) Step reorganization
36	!!----------------------------------------------------------------------
37	!! * Modules used
38	USE oce ! dynamics and tracers variables
39	USE cpl_oce ! ocean-atmosphere-sea ice coupled exchanges
40	USE dom_oce ! ocean space domain variables
41	USE sbc_oce ! surface boundary condition: ocean
42	USE trdmod_oce ! ocean variables trends
43	USE daymod ! calendar
44	USE in_out_manager ! I/O manager
45	USE lib_mpp ! distributed memory computing
46
47	USE domcfg ! domain configuration (dom_cfg routine)
48	USE mppini ! shared/distributed memory setting (mpp_init routine)
49	USE domain ! domain initialization (dom_init routine)
50	USE obc_par ! open boundary cond. parameters
51	USE obcini ! open boundary cond. initialization (obc_ini routine)
52	USE istate ! initial state setting (istate_init routine)
53	USE eosbn2 ! equation of state (eos bn2 routine)
54	USE zpshde ! partial step: hor. derivative (zps_hde routine)
55
56	! ocean physics
57	USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine)
58	USE ldftra ! lateral diffusivity setting (ldftra_init routine)
59	USE zdfini
60
61	USE phycst ! physical constant (par_cst routine)
62	USE iceini ! initialization of sea-ice (ice_init routine)
63	USE ocfzpt ! ocean freezing point (oc_fz_pt routine)
64	USE trdmod ! momentum/tracers trends (trd_mod_init routine)
65
66	USE diaptr ! poleward transports (dia_ptr_init routine)
67
68	USE step ! OPA time-stepping (stp routine)
69	#if defined key_oasis3
70	USE cpl_oasis3 ! OASIS3 coupling (to ECHAM5)
71	#elif defined key_oasis4
72	USE cpl_oasis4 ! OASIS4 coupling (to ECHAM5)
73	#endif
74	USE dynspg_oce ! Control choice of surface pressure gradient schemes
75	USE prtctl ! Print control (prt_ctl_init routine)
76	USE ini1d ! re-initialization of u-v mask for the 1D configuration
77	USE dyncor1d ! Coriolis factor at T-point
78	USE step1d ! Time stepping loop for the 1D configuration
79
80	USE initrc ! Initialization of the passive tracers
81
82	IMPLICIT NONE
83	PRIVATE
84
85	!! * Module variables
86	CHARACTER (len=64) :: &
87	cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
88
89	!! * Routine accessibility
90	PUBLIC opa_model ! called by model.F90
91	PUBLIC opa_init
92	!!----------------------------------------------------------------------
93	!! OPA 9.0 , LOCEAN-IPSL (2005)
94	!! $Id$
95	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
96	!!----------------------------------------------------------------------
97
98	CONTAINS
99
100	SUBROUTINE opa_model
101	!!----------------------------------------------------------------------
102	!! * ROUTINE opa *
103	!!
104	!! ** Purpose : opa solves the primitive equations on an orthogonal
105	!! curvilinear mesh on the sphere.
106	!!
107	!! ** Method : - model general initialization
108	!! - launch the time-stepping (stp routine)
109	!!
110	!! References :
111	!! Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
112	!! internal report, IPSL.
113	!!----------------------------------------------------------------------
114	INTEGER :: istp ! time step index
115	!!----------------------------------------------------------------------
116
117	#if defined key_agrif
118	CALL Agrif_Init_Grids()
119	#endif
120
121	CALL opa_init ! Initializations
122
123	! check that all process are still there... If some process have an error,
124	! they will never enter in step and other processes will wait until the end of the cpu time!
125	IF( lk_mpp ) CALL mpp_max(nstop)
126
127	IF( lk_cfg_1d ) THEN
128	istp = nit000
129	DO WHILE ( istp <= nitend .AND. nstop == 0 )
130	#if defined key_agrif
131	CALL Agrif_Step(stp_1d)
132	#else
133	CALL stp_1d( istp )
134	#endif
135	istp = istp + 1
136
137	IF( lk_mpp ) CALL mpp_max(nstop)
138
139	END DO
140	ELSE
141	istp = nit000
142	DO WHILE ( istp <= nitend .AND. nstop == 0 )
143	#if defined key_agrif
144	CALL Agrif_Step(stp)
145	#else
146	CALL stp( istp )
147	#endif
148	istp = istp + 1
149
150	IF( lk_mpp ) CALL mpp_max(nstop)
151
152	END DO
153	ENDIF
154	! ! ========= !
155	! ! Job end !
156	! ! ========= !
157
158	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
159
160	IF( nstop /= 0 .AND. lwp ) THEN ! error print
161	WRITE(numout,cform_err)
162	WRITE(numout,*) nstop, ' error have been found'
163	ENDIF
164
165	CALL opa_closefile
166	#if defined key_oasis3 \|\| defined key_oasis4
167	call cpl_prism_finalize
168	#else
169	IF( lk_mpp ) CALL mppstop ! Close all files (mpp)
170	#endif
171
172	END SUBROUTINE opa_model
173
174
175	SUBROUTINE opa_init
176	!!----------------------------------------------------------------------
177	!! * ROUTINE opa_init *
178	!!
179	!! ** Purpose : initialization of the opa model
180	!!
181	!!----------------------------------------------------------------------
182	#if defined key_coupled
183	INTEGER :: itro, istp0 ! ???
184	#endif
185	#if defined key_oasis3 \|\| defined key_oasis4
186	INTEGER :: localComm
187	#endif
188	CHARACTER (len=20) :: namelistname
189	CHARACTER (len=28) :: file_out
190	NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, &
191	& isplt , jsplt , njctls, njctle, nbench, nbit_cmp
192	!!----------------------------------------------------------------------
193
194	! Initializations
195	! ===============
196
197	file_out = 'ocean.output'
198
199	! open listing and namelist units
200	CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &
201	& 'SEQUENTIAL', 1, 6, .FALSE., 1 )
202
203	WRITE(numout,*)
204	WRITE(numout,*) ' L O D Y C - I P S L'
205	WRITE(numout,*) ' O P A model'
206	WRITE(numout,*) ' Ocean General Circulation Model'
207	WRITE(numout,*) ' version OPA 9.0 (2005) '
208	WRITE(numout,*)
209	WRITE(numout,*)
210
211	namelistname = 'namelist'
212	CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', &
213	& 1, numout, .FALSE., 1 )
214
215	! Namelist namctl : Control prints & Benchmark
216	REWIND( numnam )
217	READ ( numnam, namctl )
218
219	#if defined key_oasis3 \|\| defined key_oasis4
220	call cpl_prism_init(localComm)
221	! Nodes selection
222	narea = mynode(localComm)
223	#else
224	! Nodes selection
225	narea = mynode()
226	#endif
227	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
228	lwp = narea == 1
229
230	! open additionnal listing
231	IF( ln_ctl ) THEN
232	IF( narea-1 > 0 ) THEN
233	WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1
234	CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &
235	& 'SEQUENTIAL', 1, numout, .FALSE., 1 )
236	lwp = .TRUE.
237	!
238	WRITE(numout,*)
239	WRITE(numout,*) ' L O D Y C - I P S L'
240	WRITE(numout,*) ' O P A model'
241	WRITE(numout,*) ' Ocean General Circulation Model'
242	WRITE(numout,*) ' version OPA 9.0 (2005) '
243	WRITE(numout,*) ' MPI Ocean output '
244	WRITE(numout,*)
245	WRITE(numout,*)
246	ENDIF
247	ENDIF
248
249	! ! ============================== !
250	! ! Model general initialization !
251	! ! ============================== !
252
253	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
254
255	CALL opa_flg ! Control prints & Benchmark
256
257	! Domain decomposition
258	IF( jpni*jpnj == jpnij ) THEN
259	CALL mpp_init ! standard cutting out
260	ELSE
261	CALL mpp_init2 ! eliminate land processors
262	ENDIF
263
264	CALL phy_cst ! Physical constants
265
266	CALL dom_cfg ! Domain configuration
267
268	CALL dom_init ! Domain
269
270	IF( ln_ctl ) CALL prt_ctl_init ! Print control
271
272	IF( lk_cfg_1d ) CALL fcorio_1d ! redefine Coriolis at T-point
273
274	IF( lk_obc ) CALL obc_init ! Open boundaries
275
276	CALL day( nit000 ) ! Calendar
277
278	CALL istate_init ! ocean initial state (Dynamics and tracers)
279
280	CALL oc_fz_pt ! Surface freezing point
281
282	#if defined key_ice_lim
283	CALL ice_init ! Sea ice model
284	#endif
285
286	! ! Ocean physics
287
288	CALL ldf_dyn_init ! Lateral ocean momentum physics
289
290	CALL ldf_tra_init ! Lateral ocean tracer physics
291
292	CALL zdf_init ! Vertical ocean physics
293
294	CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends
295
296
297	#if defined key_passivetrc
298	CALL ini_trc ! Passive tracers
299	#endif
300
301	#if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4
302	itro = nitend - nit000 + 1 ! Coupled
303	istp0 = NINT( rdt )
304	CALL cpl_init( itro, nexco, istp0 ) ! Signal processing and process id exchange
305	#endif
306
307	#if defined key_oasis3 \|\| defined key_oasis4
308	CALL cpl_prism_define
309	#endif
310
311	CALL flx_init ! Thermohaline forcing initialization
312
313	CALL flx_fwb_init ! FreshWater Budget correction
314
315	CALL dia_ptr_init ! Poleward TRansports initialization
316
317	! ! =============== !
318	! ! time stepping !
319	! ! =============== !
320
321	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
322
323	IF( lk_cfg_1d ) THEN
324	CALL init_1d
325	ENDIF
326
327	END SUBROUTINE opa_init
328
329
330	SUBROUTINE opa_flg
331	!!----------------------------------------------------------------------
332	!! * ROUTINE opa *
333	!!
334	!! ** Purpose : Initialize logical flags that control the choice of
335	!! some algorithm or control print
336	!!
337	!! ** Method : Read in namilist namflg logical flags
338	!!
339	!! History :
340	!! 9.0 ! 03-11 (G. Madec) Original code
341	!!----------------------------------------------------------------------
342	!! * Local declarations
343
344	NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst
345	!!----------------------------------------------------------------------
346
347	! Parameter control and print
348	! ---------------------------
349	IF(lwp) THEN
350	WRITE(numout,*)
351	WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
352	WRITE(numout,*) '~~~~~~~ '
353	WRITE(numout,*) ' Namelist namctl'
354	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
355	WRITE(numout,*) ' level of print nprint = ', nprint
356	WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls
357	WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle
358	WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls
359	WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle
360	WRITE(numout,*) ' number of proc. following i isplt = ', isplt
361	WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt
362	WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench
363	WRITE(numout,*) ' bit comparison mode (0/1) nbit_cmp = ', nbit_cmp
364	ENDIF
365
366	! ... Control the sub-domain area indices for the control prints
367	IF( ln_ctl ) THEN
368	IF( lk_mpp ) THEN
369	! the domain is forced to the real splitted domain in MPI
370	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
371	ELSE
372	IF( isplt == 1 .AND. jsplt == 1 ) THEN
373	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
374	& ' - the print control will be done over the whole domain' )
375	ENDIF
376
377	! compute the total number of processors ijsplt
378	ijsplt = isplt*jsplt
379	ENDIF
380
381	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
382	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
383
384	! Control the indices used for the SUM control
385	IF( nictls+nictle+njctls+njctle == 0 ) THEN
386	! the print control is done over the default area
387	lsp_area = .FALSE.
388	ELSE
389	! the print control is done over a specific area
390	lsp_area = .TRUE.
391	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
392	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
393	nictls = 1
394	ENDIF
395
396	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
397	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
398	nictle = jpiglo
399	ENDIF
400
401	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
402	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
403	njctls = 1
404	ENDIF
405
406	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
407	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
408	njctle = jpjglo
409	ENDIF
410
411	ENDIF ! IF( nictls+nictle+njctls+njctle == 0 )
412	ENDIF ! IF(ln_ctl)
413
414	IF( nbench == 1 ) THEN
415	SELECT CASE ( cp_cfg )
416	CASE ( 'gyre' )
417	CALL ctl_warn( ' The Benchmark is activated ' )
418	CASE DEFAULT
419	CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must &
420	& be used or set nbench = 0' )
421	END SELECT
422	ENDIF
423
424	IF( nbit_cmp == 1 ) THEN
425	CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', &
426	& ' WARNING: RESULTS ARE NOT PHYSICAL.' )
427	ENDIF
428
429
430	! Read Namelist namflg : algorithm FLaG
431	! --------------------
432	REWIND ( numnam )
433	READ ( numnam, namflg )
434
435	! Parameter control and print
436	! ---------------------------
437	IF(lwp) THEN
438	WRITE(numout,*)
439	WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm'
440	WRITE(numout,*) '~~~~~~~'
441	WRITE(numout,*) ' Namelist namflg : set algorithm flags'
442	WRITE(numout,*) ' centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp
443	WRITE(numout,*) ' hydrostatic pressure gradient'
444	WRITE(numout,*) ' add dynhpg implicit variable nn_dynhpg_rst = ', nn_dynhpg_rst
445	WRITE(numout,*) ' in restart ot not nn_dynhpg_rst'
446	ENDIF
447	IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no adding dynhpg implicit variables in restart
448
449	END SUBROUTINE opa_flg
450
451
452	SUBROUTINE opa_closefile
453	!!----------------------------------------------------------------------
454	!! * ROUTINE opa_closefile *
455	!!
456	!! ** Purpose : Close the files
457	!!
458	!! ** Method :
459	!!
460	!! History :
461	!! 9.0 ! 05-01 (O. Le Galloudec) Original code
462	!!----------------------------------------------------------------------
463	!! * Modules used
464	USE dtatem ! temperature data
465	USE dtasal ! salinity data
466	USE dtasst ! sea surface temperature data
467	!!----------------------------------------------------------------------
468
469	IF ( lk_mpp ) CALL mppsync
470
471	! 1. Unit close
472	! -------------
473
474	CLOSE( numnam ) ! namelist
475	CLOSE( numout ) ! standard model output file
476
477	IF(lwp) CLOSE( numstp ) ! time-step file
478	IF(lwp) CLOSE( numsol )
479
480	END SUBROUTINE opa_closefile
481
482	!!======================================================================
483	END MODULE opa

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

Download in other formats: