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

Rev	Line
[3]	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
[467]	9	!! opa_init : initialization of the opa model
[3]	10	!! opa_flg : initialisation of algorithm flag
[300]	11	!! opa_closefile : close remaining files
[3]	12	!!----------------------------------------------------------------------
[467]	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
[532]	30	!! " ! 04-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
[467]	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	!!----------------------------------------------------------------------
[3]	37	!! * Modules used
[888]	38	USE oce ! dynamics and tracers variables
[145]	39	USE cpl_oce ! ocean-atmosphere-sea ice coupled exchanges
[3]	40	USE dom_oce ! ocean space domain variables
[888]	41	USE sbc_oce ! surface boundary condition: ocean
[216]	42	USE trdmod_oce ! ocean variables trends
[3]	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)
[503]	63	USE trdmod ! momentum/tracers trends (trd_mod_init routine)
[3]	64
[132]	65	USE diaptr ! poleward transports (dia_ptr_init routine)
[3]	66
	67	USE step ! OPA time-stepping (stp routine)
[532]	68	#if defined key_oasis3
	69	USE cpl_oasis3 ! OASIS3 coupling (to ECHAM5)
[599]	70	#elif defined key_oasis4
[532]	71	USE cpl_oasis4 ! OASIS4 coupling (to ECHAM5)
	72	#endif
	73	USE dynspg_oce ! Control choice of surface pressure gradient schemes
[258]	74	USE prtctl ! Print control (prt_ctl_init routine)
[900]	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
[3]	78
[268]	79	USE initrc ! Initialization of the passive tracers
	80
[3]	81	IMPLICIT NONE
	82	PRIVATE
	83
[467]	84	!! * Module variables
	85	CHARACTER (len=64) :: &
	86	cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
	87
[3]	88	!! * Routine accessibility
	89	PUBLIC opa_model ! called by model.F90
[389]	90	PUBLIC opa_init
[3]	91	!!----------------------------------------------------------------------
[247]	92	!! OPA 9.0 , LOCEAN-IPSL (2005)
[888]	93	!! $Id$
[467]	94	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[3]	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
[389]	114	!!----------------------------------------------------------------------
	115
[392]	116	#if defined key_agrif
[467]	117	CALL Agrif_Init_Grids()
[389]	118	#endif
	119
[467]	120	CALL opa_init ! Initializations
[389]	121
[682]	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!
[900]	124	IF( lk_mpp ) CALL mpp_max( nstop )
[682]	125
[900]	126	istp = nit000
	127	IF( lk_c1d ) THEN ! 1D configuration (no AGRIF zoom)
	128	!
[389]	129	DO WHILE ( istp <= nitend .AND. nstop == 0 )
[900]	130	CALL stp_c1d( istp )
[389]	131	istp = istp + 1
	132	END DO
[900]	133	ELSE ! 3D ocean with or without AGRIF zoom
	134	!
[389]	135	DO WHILE ( istp <= nitend .AND. nstop == 0 )
[392]	136	#if defined key_agrif
[900]	137	CALL Agrif_Step( stp )
[389]	138	#else
	139	CALL stp( istp )
	140	#endif
	141	istp = istp + 1
[900]	142	IF( lk_mpp ) CALL mpp_max( nstop )
[389]	143	END DO
	144	ENDIF
	145	! ! ========= !
	146	! ! Job end !
	147	! ! ========= !
	148
	149	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	150
[682]	151	IF( nstop /= 0 .AND. lwp ) THEN ! error print
	152	WRITE(numout,cform_err)
	153	WRITE(numout,*) nstop, ' error have been found'
[389]	154	ENDIF
	155
	156	CALL opa_closefile
[532]	157	#if defined key_oasis3 \|\| defined key_oasis4
	158	call cpl_prism_finalize
	159	#else
[389]	160	IF( lk_mpp ) CALL mppstop ! Close all files (mpp)
[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	!!----------------------------------------------------------------------
[3]	173	#if defined key_coupled
	174	INTEGER :: itro, istp0 ! ???
	175	#endif
[532]	176	#if defined key_oasis3 \|\| defined key_oasis4
	177	INTEGER :: localComm
	178	#endif
[467]	179	CHARACTER (len=20) :: namelistname
	180	CHARACTER (len=28) :: file_out
[531]	181	NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, &
	182	& isplt , jsplt , njctls, njctle, nbench, nbit_cmp
[3]	183	!!----------------------------------------------------------------------
[389]	184
[3]	185	! Initializations
	186	! ===============
[231]	187
	188	file_out = 'ocean.output'
[3]	189
	190	! open listing and namelist units
[624]	191	CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &
[634]	192	& 'SEQUENTIAL', 1, 6, .FALSE., 1 )
[3]	193
[300]	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,*)
[231]	201
[516]	202	namelistname = 'namelist'
	203	CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', &
[627]	204	& 1, numout, .FALSE., 1 )
[516]	205
	206	! Namelist namctl : Control prints & Benchmark
	207	REWIND( numnam )
	208	READ ( numnam, namctl )
	209
[599]	210	#if defined key_oasis3 \|\| defined key_oasis4
[532]	211	call cpl_prism_init(localComm)
[3]	212	! Nodes selection
[532]	213	narea = mynode(localComm)
	214	#else
	215	! Nodes selection
[3]	216	narea = mynode()
[532]	217	#endif
[3]	218	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
	219	lwp = narea == 1
	220
[516]	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
[627]	225	CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', &
	226	& 'SEQUENTIAL', 1, numout, .FALSE., 1 )
[516]	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,*)
[473]	237	ENDIF
	238	ENDIF
	239
[3]	240	! ! ============================== !
	241	! ! Model general initialization !
	242	! ! ============================== !
	243
	244	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	245
[531]	246	CALL opa_flg ! Control prints & Benchmark
	247
[3]	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
[467]	260
[900]	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
[258]	266
[900]	267	IF( ln_ctl ) CALL prt_ctl_init ! Print control
[3]	268
[253]	269	IF( lk_obc ) CALL obc_init ! Open boundaries
	270
[413]	271	CALL istate_init ! ocean initial state (Dynamics and tracers)
	272
[3]	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
[503]	283	CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends
[216]	284
	285
[281]	286	#if defined key_passivetrc
	287	CALL ini_trc ! Passive tracers
	288	#endif
	289
[532]	290	#if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4
[3]	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
[532]	296	#if defined key_oasis3 \|\| defined key_oasis4
	297	CALL cpl_prism_define
	298	#endif
	299
[190]	300	CALL dia_ptr_init ! Poleward TRansports initialization
[3]	301
	302	! ! =============== !
	303	! ! time stepping !
	304	! ! =============== !
	305
	306	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	307
[389]	308	END SUBROUTINE opa_init
[467]	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
[544]	325	NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst
[467]	326	!!----------------------------------------------------------------------
	327
[531]	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' )
[532]	398	CALL ctl_warn( ' The Benchmark is activated ' )
[531]	399	CASE DEFAULT
[532]	400	CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must &
	401	& be used or set nbench = 0' )
[531]	402	END SELECT
	403	ENDIF
	404
[532]	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
[531]	409
	410
[467]	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,*)
[531]	420	WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm'
[467]	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'
[544]	425	WRITE(numout,*) ' add dynhpg implicit variable nn_dynhpg_rst = ', nn_dynhpg_rst
	426	WRITE(numout,*) ' in restart ot not nn_dynhpg_rst'
[467]	427	ENDIF
[544]	428	IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no adding dynhpg implicit variables in restart
[467]	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
[658]	454	CLOSE( numnam ) ! namelist
	455	CLOSE( numout ) ! standard model output file
[467]	456
[658]	457	IF(lwp) CLOSE( numstp ) ! time-step file
[467]	458	IF(lwp) CLOSE( numsol )
	459
	460	END SUBROUTINE opa_closefile
	461
[3]	462	!!======================================================================
	463	END MODULE opa

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

Download in other formats: