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.

nemogcm.F90 in trunk/NEMOGCM/NEMO/SAS_SRC – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90 @ 5510

Last change on this file since 5510 was 5510, checked in by clem, 9 years ago
enable the use of BDY with ice (LIM3) in case of SAS. Calls to bdy had to be added in SAS eventhough it is not very clean. This is something that needs to be rethought in the future but it does the job for now
Property svn:keywords set to `Id`
File size: 33.7 KB

Rev	Line
[3324]	1	MODULE nemogcm
	2	!!======================================================================
	3	!! * MODULE nemogcm *
	4	!! Ocean system : NEMO GCM (ocean dynamics, on-line tracers, biochemistry 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	!! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
	28	!! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
	29	!! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
	30	!! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE
	31	!!----------------------------------------------------------------------
	32
	33	!!----------------------------------------------------------------------
	34	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
	35	!! nemo_init : initialization of the NEMO system
	36	!! nemo_ctl : initialisation of the contol print
	37	!! nemo_closefile : close remaining open files
	38	!! nemo_alloc : dynamical allocation
	39	!! nemo_partition : calculate MPP domain decomposition
	40	!! factorise : calculate the factors of the no. of MPI processes
	41	!!----------------------------------------------------------------------
	42	USE step_oce ! module used in the ocean time stepping module
	43	USE sbc_oce ! surface boundary condition: ocean
	44	USE domcfg ! domain configuration (dom_cfg routine)
[3331]	45	USE daymod ! calendar
[3324]	46	USE mppini ! shared/distributed memory setting (mpp_init routine)
	47	USE domain ! domain initialization (dom_init routine)
	48	USE phycst ! physical constant (par_cst routine)
	49	USE step ! NEMO time-stepping (stp routine)
	50	USE lib_mpp ! distributed memory computing
[5407]	51	#if defined key_nosignedzero
	52	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
	53	#endif
[3324]	54	#if defined key_iomput
[3769]	55	USE xios
[3324]	56	#endif
[5407]	57	USE cpl_oasis3
[3362]	58	USE sbcssm
[5407]	59	USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
	60	USE icbstp ! handle bergs, calving, themodynamics and transport
[5510]	61	#if defined key_bdy
	62	USE bdyini ! open boundary cond. setting (bdy_init routine). clem: mandatory for LIM3
	63	USE bdydta ! open boundary cond. setting (bdy_dta_init routine). clem: mandatory for LIM3
	64	#endif
	65	USE bdy_par
[3324]	66
	67	IMPLICIT NONE
	68	PRIVATE
	69
	70	PUBLIC nemo_gcm ! called by model.F90
	71	PUBLIC nemo_init ! needed by AGRIF
	72
	73	CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
	74
	75	!!----------------------------------------------------------------------
	76	!! NEMO/OPA 4.0 , NEMO Consortium (2011)
[5215]	77	!! $Id$
[3324]	78	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	79	!!----------------------------------------------------------------------
	80	CONTAINS
	81
	82	SUBROUTINE nemo_gcm
	83	!!----------------------------------------------------------------------
	84	!! * ROUTINE nemo_gcm *
	85	!!
	86	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
	87	!! curvilinear mesh on the sphere.
	88	!!
	89	!! ** Method : - model general initialization
	90	!! - launch the time-stepping (stp routine)
	91	!! - finalize the run by closing files and communications
	92	!!
	93	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
	94	!! Madec, 2008, internal report, IPSL.
	95	!!----------------------------------------------------------------------
	96	INTEGER :: istp ! time step index
	97	!!----------------------------------------------------------------------
	98	!
	99	#if defined key_agrif
	100	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
	101	#endif
	102
	103	! !-----------------------!
	104	CALL nemo_init !== Initialisations ==!
	105	! !-----------------------!
	106	#if defined key_agrif
[5407]	107	CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM
	108	CALL Agrif_Declare_Var ! " " " " " DYN/TRA
	109	# if defined key_top
	110	CALL Agrif_Declare_Var_top ! " " " " " TOP
	111	# endif
	112	# if defined key_lim2
	113	CALL Agrif_Declare_Var_lim2 ! " " " " " LIM
	114	# endif
[3324]	115	#endif
	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
[3331]	127	DO WHILE ( istp <= nitend .AND. nstop == 0 )
[3324]	128	#if defined key_agrif
[3331]	129	CALL Agrif_Step( stp ) ! AGRIF: time stepping
[3324]	130	#else
[3331]	131	CALL stp( istp ) ! standard time stepping
[3324]	132	#endif
[3331]	133	istp = istp + 1
	134	IF( lk_mpp ) CALL mpp_max( nstop )
	135	END DO
[5407]	136	!
	137	IF( ln_icebergs ) CALL icb_end( nitend )
	138
[3324]	139	! !------------------------!
	140	! !== finalize the run ==!
	141	! !------------------------!
	142	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	143	!
	144	IF( nstop /= 0 .AND. lwp ) THEN ! error print
	145	WRITE(numout,cform_err)
	146	WRITE(numout,*) nstop, ' error have been found'
	147	ENDIF
	148	!
	149	#if defined key_agrif
	150	CALL Agrif_ParentGrid_To_ChildGrid()
	151	IF( nn_timing == 1 ) CALL timing_finalize
	152	CALL Agrif_ChildGrid_To_ParentGrid()
	153	#endif
	154	IF( nn_timing == 1 ) CALL timing_finalize
	155	!
	156	CALL nemo_closefile
[5407]	157	!
[3769]	158	#if defined key_iomput
	159	CALL xios_finalize ! end mpp communications with xios
[5407]	160	IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
[3769]	161	#else
[5407]	162	IF( lk_oasis ) THEN
	163	CALL cpl_finalize ! end coupling and mpp communications with OASIS
	164	ELSE
	165	IF( lk_mpp ) CALL mppstop ! end mpp communications
	166	ENDIF
[3769]	167	#endif
[3324]	168	!
	169	END SUBROUTINE nemo_gcm
	170
	171
	172	SUBROUTINE nemo_init
	173	!!----------------------------------------------------------------------
	174	!! * ROUTINE nemo_init *
	175	!!
	176	!! ** Purpose : initialization of the NEMO GCM
	177	!!----------------------------------------------------------------------
	178	INTEGER :: ji ! dummy loop indices
[4147]	179	INTEGER :: ilocal_comm ! local integer
	180	INTEGER :: ios
[3324]	181	CHARACTER(len=80), DIMENSION(16) :: cltxt
[5407]	182	CHARACTER(len=80) :: clname
	183	!
[3324]	184	NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &
	185	& nn_isplt, nn_jsplt, nn_jctls, nn_jctle, &
	186	& nn_bench, nn_timing
[4147]	187	NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
[5118]	188	& jpizoom, jpjzoom, jperio, ln_use_jattr
[3324]	189	!!----------------------------------------------------------------------
[5407]	190	!
[4290]	191	cltxt = ''
[3324]	192	!
[4147]	193	! ! Open reference namelist and configuration namelist files
[5407]	194	IF( lk_oasis ) THEN
	195	CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	196	CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	197	cxios_context = 'sas'
	198	clname = 'output.namelist_sas.dyn'
	199	ELSE
	200	CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	201	CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	202	cxios_context = 'nemo'
	203	clname = 'output.namelist.dyn'
	204	ENDIF
[3324]	205	!
[4147]	206	REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark
	207	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
[4290]	208	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
[4147]	209
	210	REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist : Control prints & Benchmark
	211	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
[4290]	212	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
	213
[3324]	214	!
[4147]	215	REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints & Benchmark
	216	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
[4290]	217	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
[4147]	218
	219	REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark
	220	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
[4290]	221	904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )
	222
[5407]	223	! Force values for AGRIF zoom (cf. agrif_user.F90)
	224	#if defined key_agrif
	225	IF( .NOT. Agrif_Root() ) THEN
	226	jpiglo = nbcellsx + 2 + 2*nbghostcells
	227	jpjglo = nbcellsy + 2 + 2*nbghostcells
	228	jpi = ( jpiglo-2jpreci + (jpni-1+0) ) / jpni + 2jpreci
	229	jpj = ( jpjglo-2jprecj + (jpnj-1+0) ) / jpnj + 2jprecj
	230	jpidta = jpiglo
	231	jpjdta = jpjglo
	232	jpizoom = 1
	233	jpjzoom = 1
	234	nperio = 0
	235	jperio = 0
	236	ln_use_jattr = .false.
	237	ENDIF
	238	#endif
	239	!
[3324]	240	! !--------------------------------------------!
	241	! ! set communicator & select the local node !
[4624]	242	! ! NB: mynode also opens output.namelist.dyn !
	243	! ! on unit number numond on first proc !
[3324]	244	! !--------------------------------------------!
	245	#if defined key_iomput
	246	IF( Agrif_Root() ) THEN
[5407]	247	IF( lk_oasis ) THEN
	248	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
	249	CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios
	250	ELSE
	251	CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
	252	ENDIF
[3324]	253	ENDIF
[5407]	254	narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
[3324]	255	#else
[5407]	256	IF( lk_oasis ) THEN
	257	IF( Agrif_Root() ) THEN
	258	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
	259	ENDIF
	260	narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)
	261	ELSE
	262	ilocal_comm = 0
	263	narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
	264	ENDIF
[3324]	265	#endif
	266	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
	267
[4624]	268	lwm = (narea == 1) ! control of output namelists
[3324]	269	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
	270
[4624]	271	IF(lwm) THEN
	272	! write merged namelists from earlier to output namelist now that the
	273	! file has been opened in call to mynode. nammpp has already been
	274	! written in mynode (if lk_mpp_mpi)
	275	WRITE( numond, namctl )
	276	WRITE( numond, namcfg )
	277	ENDIF
	278
[3324]	279	! If dimensions of processor grid weren't specified in the namelist file
	280	! then we calculate them here now that we have our communicator size
	281	IF( (jpni < 1) .OR. (jpnj < 1) )THEN
	282	#if defined key_mpp_mpi
	283	IF( Agrif_Root() ) CALL nemo_partition(mppsize)
	284	#else
	285	jpni = 1
	286	jpnj = 1
	287	jpnij = jpni*jpnj
	288	#endif
	289	END IF
	290
	291	! Calculate domain dimensions given calculated jpni and jpnj
	292	! This used to be done in par_oce.F90 when they were parameters rather
	293	! than variables
	294	IF( Agrif_Root() ) THEN
	295	#if defined key_nemocice_decomp
[5407]	296	jpi = ( nx_global+2-2jpreci + (jpni-1) ) / jpni + 2jpreci ! first dim.
	297	jpj = ( ny_global+2-2jprecj + (jpnj-1) ) / jpnj + 2jprecj ! second dim.
[3324]	298	#else
[5407]	299	jpi = ( jpiglo-2jpreci + (jpni-1) ) / jpni + 2jpreci ! first dim.
[3324]	300	jpj = ( jpjglo-2jprecj + (jpnj-1) ) / jpnj + 2jprecj ! second dim.
	301	#endif
[5407]	302	ENDIF
[3324]	303	jpk = jpkdta ! third dim
	304	jpim1 = jpi-1 ! inner domain indices
	305	jpjm1 = jpj-1 ! " "
	306	jpkm1 = jpk-1 ! " "
	307	jpij = jpi*jpj ! jpi x j
	308
	309	IF(lwp) THEN ! open listing units
	310	!
[5407]	311	IF( lk_oasis ) THEN
	312	CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
	313	ELSE
	314	CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
	315	ENDIF
[3324]	316	!
	317	WRITE(numout,*)
	318	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
	319	WRITE(numout,*) ' NEMO team'
	320	WRITE(numout,*) ' Ocean General Circulation Model'
[5120]	321	WRITE(numout,*) ' version 3.6 (2015) '
[3331]	322	WRITE(numout,*) ' StandAlone Surface version (SAS) '
[3324]	323	WRITE(numout,*)
	324	WRITE(numout,*)
	325	DO ji = 1, SIZE(cltxt)
	326	IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode
	327	END DO
	328	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	329	!
	330	ENDIF
	331
	332	! Now we know the dimensions of the grid and numout has been set we can
	333	! allocate arrays
	334	CALL nemo_alloc()
	335
	336	! !-------------------------------!
	337	! ! NEMO general initialization !
	338	! !-------------------------------!
	339
	340	CALL nemo_ctl ! Control prints & Benchmark
	341
	342	! ! Domain decomposition
	343	IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out
	344	ELSE ; CALL mpp_init2 ! eliminate land processors
	345	ENDIF
	346	!
	347	IF( nn_timing == 1 ) CALL timing_init
	348	!
[3331]	349	! ! General initialization
	350	CALL phy_cst ! Physical constants
	351	CALL eos_init ! Equation of state
	352	CALL dom_cfg ! Domain configuration
	353	CALL dom_init ! Domain
[3324]	354
	355	IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined)
	356
	357	IF( ln_ctl ) CALL prt_ctl_init ! Print control
[3331]	358	CALL day_init ! model calendar (using both namelist and restart infos)
[3324]	359
[3331]	360	CALL sbc_init ! Forcings : surface module
[5510]	361
	362	! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from
	363	! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
	364	! This is not clean and should be changed in the future.
	365	IF( lk_bdy ) CALL bdy_init
	366	IF( lk_bdy ) CALL bdy_dta_init
	367	! ==>
[3324]	368
	369	IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
	370	!
	371	END SUBROUTINE nemo_init
	372
	373
	374	SUBROUTINE nemo_ctl
	375	!!----------------------------------------------------------------------
	376	!! * ROUTINE nemo_ctl *
	377	!!
	378	!! ** Purpose : control print setting
	379	!!
	380	!! ** Method : - print namctl information and check some consistencies
	381	!!----------------------------------------------------------------------
	382	!
	383	IF(lwp) THEN ! control print
	384	WRITE(numout,*)
	385	WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
	386	WRITE(numout,*) '~~~~~~~ '
	387	WRITE(numout,*) ' Namelist namctl'
	388	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
	389	WRITE(numout,*) ' level of print nn_print = ', nn_print
	390	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
	391	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
	392	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
	393	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
	394	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
	395	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
	396	WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench
	397	ENDIF
	398	!
	399	nprint = nn_print ! convert DOCTOR namelist names into OLD names
	400	nictls = nn_ictls
	401	nictle = nn_ictle
	402	njctls = nn_jctls
	403	njctle = nn_jctle
	404	isplt = nn_isplt
	405	jsplt = nn_jsplt
	406	nbench = nn_bench
[4147]	407
	408	IF(lwp) THEN ! control print
	409	WRITE(numout,*)
	410	WRITE(numout,*) 'namcfg : configuration initialization through namelist read'
	411	WRITE(numout,*) '~~~~~~~ '
	412	WRITE(numout,*) ' Namelist namcfg'
	413	WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg)
	414	WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz)
	415	WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg
	416	WRITE(numout,*) ' 1st lateral dimension ( >= jpi ) jpidta = ', jpidta
	417	WRITE(numout,*) ' 2nd " " ( >= jpj ) jpjdta = ', jpjdta
	418	WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta
	419	WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo
	420	WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo
	421	WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
	422	WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
	423	WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio
[5118]	424	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
[4147]	425	ENDIF
[3324]	426	! ! Parameter control
	427	!
	428	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
	429	IF( lk_mpp .AND. jpnij > 1 ) THEN
	430	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
	431	ELSE
	432	IF( isplt == 1 .AND. jsplt == 1 ) THEN
	433	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
	434	& ' - the print control will be done over the whole domain' )
	435	ENDIF
	436	ijsplt = isplt * jsplt ! total number of processors ijsplt
	437	ENDIF
	438	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
	439	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
	440	!
	441	! ! indices used for the SUM control
	442	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
	443	lsp_area = .FALSE.
	444	ELSE ! print control done over a specific area
	445	lsp_area = .TRUE.
	446	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
	447	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
	448	nictls = 1
	449	ENDIF
	450	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
	451	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
	452	nictle = jpiglo
	453	ENDIF
	454	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
	455	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
	456	njctls = 1
	457	ENDIF
	458	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
	459	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
	460	njctle = jpjglo
	461	ENDIF
	462	ENDIF
	463	ENDIF
	464	!
	465	IF( nbench == 1 ) THEN ! Benchmark
	466	SELECT CASE ( cp_cfg )
	467	CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' )
	468	CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', &
[4147]	469	& ' cp_cfg="gyre" in namelist &namcfg or set nbench = 0' )
[3324]	470	END SELECT
	471	ENDIF
	472	!
[5407]	473	IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', &
	474	& 'f2003 standard. ' , &
	475	& 'Compile with key_nosignedzero enabled' )
	476	!
[3324]	477	END SUBROUTINE nemo_ctl
	478
	479
	480	SUBROUTINE nemo_closefile
	481	!!----------------------------------------------------------------------
	482	!! * ROUTINE nemo_closefile *
	483	!!
	484	!! ** Purpose : Close the files
	485	!!----------------------------------------------------------------------
	486	!
	487	IF( lk_mpp ) CALL mppsync
	488	!
	489	CALL iom_close ! close all input/output files managed by iom_*
	490	!
[4147]	491	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
	492	IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist
	493	IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist
[4624]	494	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
[4147]	495	IF( numnam_ice_ref /= -1 ) CLOSE( numnam_ice_ref ) ! ice reference namelist
	496	IF( numnam_ice_cfg /= -1 ) CLOSE( numnam_ice_cfg ) ! ice configuration namelist
[4624]	497	IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist
[4147]	498	IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)
	499	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
[3324]	500	!
	501	numout = 6 ! redefine numout in case it is used after this point...
	502	!
	503	END SUBROUTINE nemo_closefile
	504
	505
	506	SUBROUTINE nemo_alloc
	507	!!----------------------------------------------------------------------
	508	!! * ROUTINE nemo_alloc *
	509	!!
	510	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	511	!!
	512	!! ** Method :
	513	!!----------------------------------------------------------------------
	514	USE diawri , ONLY: dia_wri_alloc
	515	USE dom_oce , ONLY: dom_oce_alloc
[5510]	516	#if defined key_bdy
	517	USE bdy_oce , ONLY: bdy_oce_alloc
	518	USE oce ! clem: mandatory for LIM3 because needed for bdy arrays
	519	#else
	520	USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
	521	#endif
[3324]	522	!
[5407]	523	INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6
	524	INTEGER :: jpm
[3324]	525	!!----------------------------------------------------------------------
	526	!
[3335]	527	ierr = dia_wri_alloc ()
[3324]	528	ierr = ierr + dom_oce_alloc () ! ocean domain
[5510]	529	#if defined key_bdy
	530	ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization)
	531	ierr = ierr + oce_alloc () ! (tsn...)
	532	#endif
	533
	534	#if ! defined key_bdy
	535	ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), &
	536	& snwice_fmass(jpi,jpj) , STAT= ierr1 )
[3324]	537	!
[5407]	538	! lim code currently uses surface temperature and salinity in tsn array for initialisation
[5510]	539	! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use
	540	! clem: should not be needed. To be checked out
[5407]	541	jpm = MAX(jp_tem, jp_sal)
	542	ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 )
	543	ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 )
	544	ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 )
	545	ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 )
	546	ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 )
	547	ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6
[5510]	548	#endif
[5407]	549	!
[3324]	550	IF( lk_mpp ) CALL mpp_sum( ierr )
	551	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
	552	!
	553	END SUBROUTINE nemo_alloc
	554
	555
	556	SUBROUTINE nemo_partition( num_pes )
	557	!!----------------------------------------------------------------------
	558	!! * ROUTINE nemo_partition *
	559	!!
	560	!! ** Purpose :
	561	!!
	562	!! ** Method :
	563	!!----------------------------------------------------------------------
	564	INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
	565	!
	566	INTEGER, PARAMETER :: nfactmax = 20
	567	INTEGER :: nfact ! The no. of factors returned
	568	INTEGER :: ierr ! Error flag
	569	INTEGER :: ji
	570	INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
	571	INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
	572	!!----------------------------------------------------------------------
[5407]	573	!
[3324]	574	ierr = 0
[5407]	575	!
[3324]	576	CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
[5407]	577	!
[3324]	578	IF( nfact <= 1 ) THEN
	579	WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
	580	WRITE (numout, *) ' : using grid of ',num_pes,' x 1'
	581	jpnj = 1
	582	jpni = num_pes
	583	ELSE
	584	! Search through factors for the pair that are closest in value
	585	mindiff = 1000000
	586	imin = 1
	587	DO ji = 1, nfact-1, 2
	588	idiff = ABS( ifact(ji) - ifact(ji+1) )
	589	IF( idiff < mindiff ) THEN
	590	mindiff = idiff
	591	imin = ji
	592	ENDIF
	593	END DO
	594	jpnj = ifact(imin)
	595	jpni = ifact(imin + 1)
	596	ENDIF
	597	!
	598	jpnij = jpni*jpnj
	599	!
	600	END SUBROUTINE nemo_partition
	601
	602
	603	SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
	604	!!----------------------------------------------------------------------
	605	!! * ROUTINE factorise *
	606	!!
	607	!! ** Purpose : return the prime factors of n.
	608	!! knfax factors are returned in array kfax which is of
	609	!! maximum dimension kmaxfax.
	610	!! ** Method :
	611	!!----------------------------------------------------------------------
	612	INTEGER , INTENT(in ) :: kn, kmaxfax
	613	INTEGER , INTENT( out) :: kerr, knfax
	614	INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax
	615	!
	616	INTEGER :: ifac, jl, inu
	617	INTEGER, PARAMETER :: ntest = 14
	618	INTEGER :: ilfax(ntest)
[5407]	619	!
[3324]	620	! lfax contains the set of allowed factors.
	621	data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, &
	622	& 128, 64, 32, 16, 8, 4, 2 /
	623	!!----------------------------------------------------------------------
	624
	625	! Clear the error flag and initialise output vars
	626	kerr = 0
	627	kfax = 1
	628	knfax = 0
	629
	630	! Find the factors of n.
	631	IF( kn == 1 ) GOTO 20
	632
	633	! nu holds the unfactorised part of the number.
	634	! knfax holds the number of factors found.
	635	! l points to the allowed factor list.
	636	! ifac holds the current factor.
	637
	638	inu = kn
	639	knfax = 0
	640
	641	DO jl = ntest, 1, -1
	642	!
	643	ifac = ilfax(jl)
	644	IF( ifac > inu ) CYCLE
	645
	646	! Test whether the factor will divide.
	647
	648	IF( MOD(inu,ifac) == 0 ) THEN
	649	!
	650	knfax = knfax + 1 ! Add the factor to the list
	651	IF( knfax > kmaxfax ) THEN
	652	kerr = 6
	653	write (,) 'FACTOR: insufficient space in factor array ', knfax
	654	return
	655	ENDIF
	656	kfax(knfax) = ifac
	657	! Store the other factor that goes with this one
	658	knfax = knfax + 1
	659	kfax(knfax) = inu / ifac
	660	!WRITE (,) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
	661	ENDIF
	662	!
	663	END DO
	664
	665	20 CONTINUE ! Label 20 is the exit point from the factor search loop.
	666	!
	667	END SUBROUTINE factorise
	668
	669	#if defined key_mpp_mpi
	670	SUBROUTINE nemo_northcomms
	671	!!======================================================================
	672	!! * ROUTINE nemo_northcomms *
[4232]	673	!! nemo_northcomms : Setup for north fold exchanges with explicit
	674	!! point-to-point messaging
[3324]	675	!!=====================================================================
	676	!!----------------------------------------------------------------------
[4232]	677	!!
[3324]	678	!! ** Purpose : Initialization of the northern neighbours lists.
	679	!!----------------------------------------------------------------------
[4232]	680	!! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)
	681	!! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
[3324]	682	!!----------------------------------------------------------------------
	683
[4232]	684	INTEGER :: sxM, dxM, sxT, dxT, jn
	685	INTEGER :: njmppmax
[3324]	686
[4232]	687	njmppmax = MAXVAL( njmppt )
	688
	689	!initializes the north-fold communication variables
	690	isendto(:) = 0
[3324]	691	nsndto = 0
	692
[4232]	693	!if I am a process in the north
	694	IF ( njmpp == njmppmax ) THEN
	695	!sxM is the first point (in the global domain) needed to compute the
	696	!north-fold for the current process
	697	sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
	698	!dxM is the last point (in the global domain) needed to compute the
	699	!north-fold for the current process
	700	dxM = jpiglo - nimppt(narea) + 2
[3324]	701
[4232]	702	!loop over the other north-fold processes to find the processes
	703	!managing the points belonging to the sxT-dxT range
[5407]	704
	705	DO jn = 1, jpni
[4232]	706	!sxT is the first point (in the global domain) of the jn
	707	!process
[5407]	708	sxT = nfiimpp(jn, jpnj)
[4232]	709	!dxT is the last point (in the global domain) of the jn
	710	!process
[5407]	711	dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
[4232]	712	IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
	713	nsndto = nsndto + 1
[5407]	714	isendto(nsndto) = jn
	715	ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
[4232]	716	nsndto = nsndto + 1
	717	isendto(nsndto) = jn
	718	ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
	719	nsndto = nsndto + 1
	720	isendto(nsndto) = jn
	721	END IF
	722	END DO
[5407]	723	nfsloop = 1
	724	nfeloop = nlci
	725	DO jn = 2,jpni-1
	726	IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
	727	IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
	728	nfsloop = nldi
	729	ENDIF
	730	IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
	731	nfeloop = nlei
	732	ENDIF
	733	ENDIF
	734	END DO
	735
[3324]	736	ENDIF
[4232]	737	l_north_nogather = .TRUE.
	738	END SUBROUTINE nemo_northcomms
[3324]	739
	740	#else
	741	SUBROUTINE nemo_northcomms ! Dummy routine
	742	WRITE(,) 'nemo_northcomms: You should not have seen this print! error?'
	743	END SUBROUTINE nemo_northcomms
	744	#endif
	745	!!======================================================================
	746	END MODULE nemogcm

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

Download in other formats: