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

Last change on this file since 1656 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

Rev	Line
[3]	1	MODULE opa
	2	!!==============================================================================
	3	!! * MODULE opa *
	4	!! Ocean system : OPA ocean dynamics (including on-line tracers and sea-ice)
	5	!!==============================================================================
[1593]	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	!!----------------------------------------------------------------------
[3]	28
	29	!!----------------------------------------------------------------------
	30	!! opa_model : solve ocean dynamics, tracer and/or sea-ice
[467]	31	!! opa_init : initialization of the opa model
[3]	32	!! opa_flg : initialisation of algorithm flag
[300]	33	!! opa_closefile : close remaining files
[3]	34	!!----------------------------------------------------------------------
[888]	35	USE oce ! dynamics and tracers variables
[3]	36	USE dom_oce ! ocean space domain variables
[888]	37	USE sbc_oce ! surface boundary condition: ocean
[216]	38	USE trdmod_oce ! ocean variables trends
[3]	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)
[911]	45	USE bdy_par ! unstructured open boundary cond. parameters
	46	USE bdyini ! unstructured open boundary cond. initialization (bdy_init routine)
[3]	47	USE istate ! initial state setting (istate_init routine)
[1593]	48	USE eosbn2 ! equation of state (eos_init routine)
[1601]	49	USE dynhpg ! hydrostatic pressure gradient
[3]	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)
[503]	54	USE trdmod ! momentum/tracers trends (trd_mod_init routine)
[132]	55	USE diaptr ! poleward transports (dia_ptr_init routine)
[3]	56	USE step ! OPA time-stepping (stp routine)
[532]	57	#if defined key_oasis3
[1359]	58	USE cpl_oasis3 ! OASIS3 coupling
[599]	59	#elif defined key_oasis4
[1359]	60	USE cpl_oasis4 ! OASIS4 coupling (not working)
[532]	61	#endif
	62	USE dynspg_oce ! Control choice of surface pressure gradient schemes
[258]	63	USE prtctl ! Print control (prt_ctl_init routine)
[900]	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
[1594]	67	#if defined key_top
[1593]	68	USE trcini ! passive tracer initialisation
[1594]	69	#endif
[1593]	70
[1359]	71	USE iom
[1593]	72	USE in_out_manager ! I/O manager
	73	USE lib_mpp ! distributed memory computing
[1412]	74	#if defined key_iomput
	75	USE mod_ioclient
[1359]	76	#endif
[268]	77
[3]	78	IMPLICIT NONE
	79	PRIVATE
	80
[1593]	81	PUBLIC opa_model ! called by model.F90
	82	PUBLIC opa_init ! needed by AGRIF
[467]	83
[1593]	84	CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
	85
[3]	86	!!----------------------------------------------------------------------
[1593]	87	!! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
[888]	88	!! $Id$
[467]	89	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[3]	90	!!----------------------------------------------------------------------
	91
	92	CONTAINS
	93
	94	SUBROUTINE opa_model
	95	!!----------------------------------------------------------------------
	96	!! * ROUTINE opa *
	97	!!
	98	!! ** Purpose : opa solves the primitive equations on an orthogonal
[1593]	99	!! curvilinear mesh on the sphere.
[3]	100	!!
	101	!! ** Method : - model general initialization
	102	!! - launch the time-stepping (stp routine)
[1593]	103	!! - finalize the run by closing files and communications
[3]	104	!!
[1593]	105	!! References : Madec, Delecluse,Imbard, and Levy, 1997: internal report, IPSL.
	106	!! Madec, 2008, internal report, IPSL.
[3]	107	!!----------------------------------------------------------------------
	108	INTEGER :: istp ! time step index
[389]	109	!!----------------------------------------------------------------------
	110
[392]	111	#if defined key_agrif
[1593]	112	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
[389]	113	#endif
	114
[1593]	115	! !-----------------------!
	116	CALL opa_init !== Initialisations ==!
	117	! !-----------------------!
	118
[682]	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!
[900]	121	IF( lk_mpp ) CALL mpp_max( nstop )
[682]	122
[1593]	123	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	124
	125	! !-----------------------!
	126	! !== time stepping ==!
	127	! !-----------------------!
[900]	128	istp = nit000
[1593]	129	IF( lk_c1d ) THEN !== 1D configuration ==!
[389]	130	DO WHILE ( istp <= nitend .AND. nstop == 0 )
[900]	131	CALL stp_c1d( istp )
[389]	132	istp = istp + 1
	133	END DO
[1593]	134	ELSE !== 3D ocean with ==!
[389]	135	DO WHILE ( istp <= nitend .AND. nstop == 0 )
[392]	136	#if defined key_agrif
[1593]	137	CALL Agrif_Step( stp ) ! AGRIF: time stepping
[389]	138	#else
[1593]	139	CALL stp( istp ) ! standard time stepping
[389]	140	#endif
	141	istp = istp + 1
[900]	142	IF( lk_mpp ) CALL mpp_max( nstop )
[389]	143	END DO
	144	ENDIF
[1593]	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
[682]	152	WRITE(numout,cform_err)
	153	WRITE(numout,*) nstop, ' error have been found'
[389]	154	ENDIF
[1593]	155	!
[389]	156	CALL opa_closefile
[532]	157	#if defined key_oasis3 \|\| defined key_oasis4
[1593]	158	CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS
[532]	159	#else
[1593]	160	IF( lk_mpp ) CALL mppstop ! end mpp communications
[532]	161	#endif
[900]	162	!
[389]	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	!!----------------------------------------------------------------------
[1412]	173	#if defined key_oasis3 \|\| defined key_oasis4 \|\| defined key_iomput
[1593]	174	INTEGER :: ilocal_comm
[532]	175	#endif
[1581]	176	CHARACTER(len=80),dimension(10) :: cltxt = ''
[1593]	177	INTEGER :: ji ! local loop indices
	178	!!
[1601]	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
[3]	181	!!----------------------------------------------------------------------
[1593]	182	!
	183	! ! open Namelist file
[1581]	184	CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
[1593]	185	!
	186	READ( numnam, namctl ) ! Namelist namctl : Control prints & Benchmark
	187	!
	188	! !--------------------------------------------!
	189	! ! set communicator & select the local node !
	190	! !--------------------------------------------!
[1412]	191	#if defined key_iomput
	192	# if defined key_oasis3 \|\| defined key_oasis4
[1593]	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)
[1412]	195	# else
[1593]	196	CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server
[1412]	197	# endif
[1593]	198	narea = mynode( cltxt, ilocal_comm ) ! Nodes selection
	199
[532]	200	#else
[1412]	201	# if defined key_oasis3 \|\| defined key_oasis4
[1593]	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)
[1412]	204	# else
[1593]	205	narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt)
[1412]	206	# endif
[532]	207	#endif
[1593]	208	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
[3]	209
[1593]	210	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
[1579]	211
[1593]	212	IF(lwp) THEN ! open listing units
	213	!
[1581]	214	CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
[1593]	215	!
[1579]	216	WRITE(numout,*)
[1593]	217	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean'
	218	WRITE(numout,*) ' NEMO team'
[1579]	219	WRITE(numout,*) ' Ocean General Circulation Model'
[1593]	220	WRITE(numout,*) ' version 3.2 (2009) '
[1579]	221	WRITE(numout,*)
	222	WRITE(numout,*)
[1593]	223	DO ji = 1, SIZE(cltxt)
	224	IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode
[1579]	225	END DO
[1593]	226	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	227	!
[473]	228	ENDIF
[1593]	229	! !--------------------------------!
	230	! ! Model general initialization !
	231	! !--------------------------------!
[473]	232
[531]	233	CALL opa_flg ! Control prints & Benchmark
	234
[3]	235	! Domain decomposition
[1593]	236	IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out
	237	ELSE ; CALL mpp_init2 ! eliminate land processors
[3]	238	ENDIF
	239
	240	CALL phy_cst ! Physical constants
[1493]	241	CALL eos_init ! Equation of state
[3]	242	CALL dom_cfg ! Domain configuration
	243	CALL dom_init ! Domain
[1593]	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(:,:,:) !
[900]	249	ENDIF
[1593]	250	!!gm c1d end
[258]	251
[1593]	252	IF( ln_ctl ) CALL prt_ctl_init ! Print control
[3]	253
[1593]	254	IF( lk_obc ) CALL obc_init ! Open boundaries
	255	IF( lk_bdy ) CALL bdy_init ! Unstructured open boundaries
[253]	256
[413]	257	CALL istate_init ! ocean initial state (Dynamics and tracers)
	258
[3]	259	! ! Ocean physics
[1598]	260	CALL ldf_tra_init ! Lateral ocean tracer physics
[3]	261	CALL ldf_dyn_init ! Lateral ocean momentum physics
	262	CALL zdf_init ! Vertical ocean physics
	263
[1594]	264	#if defined key_top
[1359]	265	CALL trc_ini ! Passive tracers
[1594]	266	#endif
[281]	267
[1593]	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	!
[389]	273	END SUBROUTINE opa_init
[467]	274
	275
	276	SUBROUTINE opa_flg
	277	!!----------------------------------------------------------------------
	278	!! * ROUTINE opa *
	279	!!
[1593]	280	!! ** Purpose : Initialise logical flags that control the choice of
	281	!! some algorithm or control print
[467]	282	!!
[1593]	283	!! ** Method : - print namctl information
	284	!! - Read in namilist namflg logical flags
[467]	285	!!----------------------------------------------------------------------
[1601]	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
[467]	289	!!----------------------------------------------------------------------
	290
[1601]	291	IF(lwp) THEN ! Parameter print
[531]	292	WRITE(numout,*)
	293	WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
	294	WRITE(numout,*) '~~~~~~~ '
[1593]	295	WRITE(numout,*) ' Namelist namctl'
[1601]	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
[531]	306	ENDIF
	307
[1601]	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
[1593]	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
[531]	323	ELSE
	324	IF( isplt == 1 .AND. jsplt == 1 ) THEN
[1593]	325	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
	326	& ' - the print control will be done over the whole domain' )
[531]	327	ENDIF
[1593]	328	ijsplt = isplt * jsplt ! total number of processors ijsplt
[531]	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
[1593]	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
[531]	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
[1593]	354	ENDIF
	355	ENDIF
[531]	356
[1593]	357	IF( nbench == 1 ) THEN ! Benchmark
[531]	358	SELECT CASE ( cp_cfg )
[1593]	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' )
[531]	362	END SELECT
	363	ENDIF
	364
[1593]	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.' )
[532]	368	ENDIF
[531]	369
[1601]	370	REWIND( numnam ) ! Read Namelist namdyn_hpg : ln_dynhpg_imp must be read at the initialisation phase
	371	READ ( numnam, namdyn_hpg )
[1593]	372	!
[467]	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	!!----------------------------------------------------------------------
[1593]	385	!
	386	IF( lk_mpp ) CALL mppsync
	387	!
[658]	388	IF(lwp) CLOSE( numstp ) ! time-step file
[1359]	389	IF(lwp) CLOSE( numsol ) ! solver file
[1593]	390	!
[1359]	391	CALL iom_close ! close all input/output files
[1593]	392	!
[1627]	393	CLOSE( numnam ) ! namelist
	394	CLOSE( numout ) ! standard model output file
	395	!
[467]	396	END SUBROUTINE opa_closefile
	397
[3]	398	!!======================================================================
	399	END MODULE opa

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

Download in other formats: