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 branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/SAS_SRC – NEMO

Context Navigation

source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90 @ 8809

Last change on this file since 8809 was 8758, checked in by acc, 6 years ago
Branch 2017/dev_r8126_ROBUST08_no_ghost. Changes to eliminate ghost rows and columns. Currently the halo width is still fixed as 1 but a single variable (nn_hls) has been introduced for the halo-size in preparation for allowing this to vary. nn_hls replaces jpreci and jprecj. These changes have passed full SETTE tests but iceberg exchanges across the north-fold remain untested (SETTE tests only release bergs in the SO) and will require further attention. Note layout.dat now reports the jpi and jpj values for the reporting processor only.
Property svn:keywords set to `Id`
File size: 32.1 KB

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

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

Download in other formats: