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

Last change on this file since 900 was 900, checked in by rblod, 16 years ago
Update 1D configuration according to SBC and LIM3, see ticket #117
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 18.6 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 ocfzpt ! ocean freezing point (oc_fz_pt routine)
63	USE trdmod ! momentum/tracers trends (trd_mod_init routine)
64
65	USE diaptr ! poleward transports (dia_ptr_init routine)
66
67	USE step ! OPA time-stepping (stp routine)
68	#if defined key_oasis3
69	USE cpl_oasis3 ! OASIS3 coupling (to ECHAM5)
70	#elif defined key_oasis4
71	USE cpl_oasis4 ! OASIS4 coupling (to ECHAM5)
72	#endif
73	USE dynspg_oce ! Control choice of surface pressure gradient schemes
74	USE prtctl ! Print control (prt_ctl_init routine)
75	USE c1d ! 1D configuration
76	USE dyncor_c1d ! Coriolis factor at T-point
77	USE step_c1d ! Time stepping loop for the 1D configuration
78
79	USE initrc ! Initialization of the passive tracers
80
81	IMPLICIT NONE
82	PRIVATE
83
84	!! * Module variables
85	CHARACTER (len=64) :: &
86	cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
87
88	!! * Routine accessibility
89	PUBLIC opa_model ! called by model.F90
90	PUBLIC opa_init
91	!!----------------------------------------------------------------------
92	!! OPA 9.0 , LOCEAN-IPSL (2005)
93	!! $Id$
94	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
95	!!----------------------------------------------------------------------
96
97	CONTAINS
98
99	SUBROUTINE opa_model
100	!!----------------------------------------------------------------------
101	!! * ROUTINE opa *
102	!!
103	!! ** Purpose : opa solves the primitive equations on an orthogonal
104	!! curvilinear mesh on the sphere.
105	!!
106	!! ** Method : - model general initialization
107	!! - launch the time-stepping (stp routine)
108	!!
109	!! References :
110	!! Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
111	!! internal report, IPSL.
112	!!----------------------------------------------------------------------
113	INTEGER :: istp ! time step index
114	!!----------------------------------------------------------------------
115
116	#if defined key_agrif
117	CALL Agrif_Init_Grids()
118	#endif
119
120	CALL opa_init ! Initializations
121
122	! check that all process are still there... If some process have an error,
123	! they will never enter in step and other processes will wait until the end of the cpu time!
124	IF( lk_mpp ) CALL mpp_max( nstop )
125
126	istp = nit000
127	IF( lk_c1d ) THEN ! 1D configuration (no AGRIF zoom)
128	!
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 or without AGRIF zoom
134	!
135	DO WHILE ( istp <= nitend .AND. nstop == 0 )
136	#if defined key_agrif
137	CALL Agrif_Step( stp )
138	#else
139	CALL stp( istp )
140	#endif
141	istp = istp + 1
142	IF( lk_mpp ) CALL mpp_max( nstop )
143	END DO
144	ENDIF
145	! ! ========= !
146	! ! Job end !
147	! ! ========= !
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
159	#else
160	IF( lk_mpp ) CALL mppstop ! Close all files (mpp)
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_coupled
174	INTEGER :: itro, istp0 ! ???
175	#endif
176	#if defined key_oasis3 \|\| defined key_oasis4
177	INTEGER :: localComm
178	#endif
179	CHARACTER (len=20) :: namelistname
180	CHARACTER (len=28) :: file_out
181	NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, &
182	& isplt , jsplt , njctls, njctle, nbench, nbit_cmp
183	!!----------------------------------------------------------------------
184
185	! Initializations
186	! ===============
187
188	file_out = 'ocean.output'
189
190	! open listing and namelist units
191	CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &
192	& 'SEQUENTIAL', 1, 6, .FALSE., 1 )
193
194	WRITE(numout,*)
195	WRITE(numout,*) ' L O D Y C - I P S L'
196	WRITE(numout,*) ' O P A model'
197	WRITE(numout,*) ' Ocean General Circulation Model'
198	WRITE(numout,*) ' version OPA 9.0 (2005) '
199	WRITE(numout,*)
200	WRITE(numout,*)
201
202	namelistname = 'namelist'
203	CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', &
204	& 1, numout, .FALSE., 1 )
205
206	! Namelist namctl : Control prints & Benchmark
207	REWIND( numnam )
208	READ ( numnam, namctl )
209
210	#if defined key_oasis3 \|\| defined key_oasis4
211	call cpl_prism_init(localComm)
212	! Nodes selection
213	narea = mynode(localComm)
214	#else
215	! Nodes selection
216	narea = mynode()
217	#endif
218	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
219	lwp = narea == 1
220
221	! open additionnal listing
222	IF( ln_ctl ) THEN
223	IF( narea-1 > 0 ) THEN
224	WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1
225	CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &
226	& 'SEQUENTIAL', 1, numout, .FALSE., 1 )
227	lwp = .TRUE.
228	!
229	WRITE(numout,*)
230	WRITE(numout,*) ' L O D Y C - I P S L'
231	WRITE(numout,*) ' O P A model'
232	WRITE(numout,*) ' Ocean General Circulation Model'
233	WRITE(numout,*) ' version OPA 9.0 (2005) '
234	WRITE(numout,*) ' MPI Ocean output '
235	WRITE(numout,*)
236	WRITE(numout,*)
237	ENDIF
238	ENDIF
239
240	! ! ============================== !
241	! ! Model general initialization !
242	! ! ============================== !
243
244	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
245
246	CALL opa_flg ! Control prints & Benchmark
247
248	! Domain decomposition
249	IF( jpni*jpnj == jpnij ) THEN
250	CALL mpp_init ! standard cutting out
251	ELSE
252	CALL mpp_init2 ! eliminate land processors
253	ENDIF
254
255	CALL phy_cst ! Physical constants
256
257	CALL dom_cfg ! Domain configuration
258
259	CALL dom_init ! Domain
260
261	IF( lk_c1d ) THEN ! adaptation for 1D configuration
262	CALL cor_c1d ! redefine Coriolis at T-point
263	umask(:,:,:) = tmask(:,:,:) ! U, V and T-points are the same
264	vmask(:,:,:) = tmask(:,:,:) !
265	ENDIF
266
267	IF( ln_ctl ) CALL prt_ctl_init ! Print control
268
269	IF( lk_obc ) CALL obc_init ! Open boundaries
270
271	CALL istate_init ! ocean initial state (Dynamics and tracers)
272
273	CALL oc_fz_pt ! Surface freezing point
274
275	! ! Ocean physics
276
277	CALL ldf_dyn_init ! Lateral ocean momentum physics
278
279	CALL ldf_tra_init ! Lateral ocean tracer physics
280
281	CALL zdf_init ! Vertical ocean physics
282
283	CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends
284
285
286	#if defined key_passivetrc
287	CALL ini_trc ! Passive tracers
288	#endif
289
290	#if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4
291	itro = nitend - nit000 + 1 ! Coupled
292	istp0 = NINT( rdt )
293	CALL cpl_init( itro, nexco, istp0 ) ! Signal processing and process id exchange
294	#endif
295
296	#if defined key_oasis3 \|\| defined key_oasis4
297	CALL cpl_prism_define
298	#endif
299
300	CALL dia_ptr_init ! Poleward TRansports initialization
301
302	! ! =============== !
303	! ! time stepping !
304	! ! =============== !
305
306	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
307
308	END SUBROUTINE opa_init
309
310
311	SUBROUTINE opa_flg
312	!!----------------------------------------------------------------------
313	!! * ROUTINE opa *
314	!!
315	!! ** Purpose : Initialize logical flags that control the choice of
316	!! some algorithm or control print
317	!!
318	!! ** Method : Read in namilist namflg logical flags
319	!!
320	!! History :
321	!! 9.0 ! 03-11 (G. Madec) Original code
322	!!----------------------------------------------------------------------
323	!! * Local declarations
324
325	NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst
326	!!----------------------------------------------------------------------
327
328	! Parameter control and print
329	! ---------------------------
330	IF(lwp) THEN
331	WRITE(numout,*)
332	WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
333	WRITE(numout,*) '~~~~~~~ '
334	WRITE(numout,*) ' Namelist namctl'
335	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
336	WRITE(numout,*) ' level of print nprint = ', nprint
337	WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls
338	WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle
339	WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls
340	WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle
341	WRITE(numout,*) ' number of proc. following i isplt = ', isplt
342	WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt
343	WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench
344	WRITE(numout,*) ' bit comparison mode (0/1) nbit_cmp = ', nbit_cmp
345	ENDIF
346
347	! ... Control the sub-domain area indices for the control prints
348	IF( ln_ctl ) THEN
349	IF( lk_mpp ) THEN
350	! the domain is forced to the real splitted domain in MPI
351	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
352	ELSE
353	IF( isplt == 1 .AND. jsplt == 1 ) THEN
354	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
355	& ' - the print control will be done over the whole domain' )
356	ENDIF
357
358	! compute the total number of processors ijsplt
359	ijsplt = isplt*jsplt
360	ENDIF
361
362	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
363	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
364
365	! Control the indices used for the SUM control
366	IF( nictls+nictle+njctls+njctle == 0 ) THEN
367	! the print control is done over the default area
368	lsp_area = .FALSE.
369	ELSE
370	! the print control is done over a specific area
371	lsp_area = .TRUE.
372	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
373	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
374	nictls = 1
375	ENDIF
376
377	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
378	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
379	nictle = jpiglo
380	ENDIF
381
382	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
383	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
384	njctls = 1
385	ENDIF
386
387	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
388	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
389	njctle = jpjglo
390	ENDIF
391
392	ENDIF ! IF( nictls+nictle+njctls+njctle == 0 )
393	ENDIF ! IF(ln_ctl)
394
395	IF( nbench == 1 ) THEN
396	SELECT CASE ( cp_cfg )
397	CASE ( 'gyre' )
398	CALL ctl_warn( ' The Benchmark is activated ' )
399	CASE DEFAULT
400	CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must &
401	& be used or set nbench = 0' )
402	END SELECT
403	ENDIF
404
405	IF( nbit_cmp == 1 ) THEN
406	CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', &
407	& ' WARNING: RESULTS ARE NOT PHYSICAL.' )
408	ENDIF
409
410
411	! Read Namelist namflg : algorithm FLaG
412	! --------------------
413	REWIND ( numnam )
414	READ ( numnam, namflg )
415
416	! Parameter control and print
417	! ---------------------------
418	IF(lwp) THEN
419	WRITE(numout,*)
420	WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm'
421	WRITE(numout,*) '~~~~~~~'
422	WRITE(numout,*) ' Namelist namflg : set algorithm flags'
423	WRITE(numout,*) ' centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp
424	WRITE(numout,*) ' hydrostatic pressure gradient'
425	WRITE(numout,*) ' add dynhpg implicit variable nn_dynhpg_rst = ', nn_dynhpg_rst
426	WRITE(numout,*) ' in restart ot not nn_dynhpg_rst'
427	ENDIF
428	IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no adding dynhpg implicit variables in restart
429
430	END SUBROUTINE opa_flg
431
432
433	SUBROUTINE opa_closefile
434	!!----------------------------------------------------------------------
435	!! * ROUTINE opa_closefile *
436	!!
437	!! ** Purpose : Close the files
438	!!
439	!! ** Method :
440	!!
441	!! History :
442	!! 9.0 ! 05-01 (O. Le Galloudec) Original code
443	!!----------------------------------------------------------------------
444	!! * Modules used
445	USE dtatem ! temperature data
446	USE dtasal ! salinity data
447	!!----------------------------------------------------------------------
448
449	IF ( lk_mpp ) CALL mppsync
450
451	! 1. Unit close
452	! -------------
453
454	CLOSE( numnam ) ! namelist
455	CLOSE( numout ) ! standard model output file
456
457	IF(lwp) CLOSE( numstp ) ! time-step file
458	IF(lwp) CLOSE( numsol )
459
460	END SUBROUTINE opa_closefile
461
462	!!======================================================================
463	END MODULE opa

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

Download in other formats: