Context Navigation

mppini.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

Property svn:keywords set to Id

File size: 17.4 KB

Rev	Line
[3]	1	MODULE mppini
	2	!!==============================================================================
	3	!! * MODULE mppini *
	4	!! Ocean initialization : distributed memory computing initialization
	5	!!==============================================================================
	6
	7	!!----------------------------------------------------------------------
	8	!! mpp_init : Lay out the global domain over processors
	9	!! mpp_init2 : Lay out the global domain over processors
	10	!! with land processor elimination
[88]	11	!! mpp_init_ioispl: IOIPSL initialization in mpp
[3]	12	!!----------------------------------------------------------------------
	13	USE dom_oce ! ocean space and time domain
	14	USE in_out_manager ! I/O Manager
	15	USE lib_mpp ! distribued memory computing library
[352]	16	USE ioipsl
[3]	17
	18	IMPLICIT NONE
	19	PRIVATE
	20
	21	PUBLIC mpp_init ! called by opa.F90
	22	PUBLIC mpp_init2 ! called by opa.F90
	23
	24	!!----------------------------------------------------------------------
[2287]	25	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]	26	!! $Id$
[2715]	27	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	28	!!----------------------------------------------------------------------
	29	CONTAINS
	30
[1556]	31	#if ! defined key_mpp_mpi
[3]	32	!!----------------------------------------------------------------------
	33	!! Default option : shared memory computing
	34	!!----------------------------------------------------------------------
	35
	36	SUBROUTINE mpp_init
	37	!!----------------------------------------------------------------------
	38	!! * ROUTINE mpp_init *
	39	!!
	40	!! ** Purpose : Lay out the global domain over processors.
	41	!!
	42	!! ** Method : Shared memory computing, set the local processor
	43	!! variables to the value of the global domain
	44	!!
	45	!! History :
	46	!! 9.0 ! 04-01 (G. Madec, J.M. Molines) F90 : free form, north fold jpni >1
	47	!!----------------------------------------------------------------------
[352]	48
[3]	49	! No mpp computation
	50	nimpp = 1
	51	njmpp = 1
	52	nlci = jpi
	53	nlcj = jpj
	54	nldi = 1
	55	nldj = 1
	56	nlei = jpi
	57	nlej = jpj
	58	nperio = jperio
	59	nbondi = 2
	60	nbondj = 2
[352]	61	nidom = FLIO_DOM_NONE
[1344]	62	npolj = jperio
[352]	63
[3]	64	IF(lwp) THEN
	65	WRITE(numout,*)
	66	WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
	67	WRITE(numout,*) '~~~~~~~~~~~: '
	68	WRITE(numout,*) ' nperio = ', nperio
[88]	69	WRITE(numout,*) ' npolj = ', npolj
[3]	70	WRITE(numout,*) ' nimpp = ', nimpp
	71	WRITE(numout,*) ' njmpp = ', njmpp
	72	ENDIF
	73
[474]	74	IF( jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
	75	CALL ctl_stop( 'equality jpni = jpnj = jpnij = 1 is not satisfied', &
	76	& 'the domain is lay out for distributed memory computing! ' )
[3]	77
	78	END SUBROUTINE mpp_init
	79
	80
	81	SUBROUTINE mpp_init2
	82	CALL mpp_init ! same routine as mpp_init
	83	END SUBROUTINE mpp_init2
	84
	85	#else
	86	!!----------------------------------------------------------------------
[15]	87	!! 'key_mpp_mpi' OR MPI massively parallel processing
[3]	88	!!----------------------------------------------------------------------
	89
	90	SUBROUTINE mpp_init
	91	!!----------------------------------------------------------------------
	92	!! * ROUTINE mpp_init *
	93	!!
	94	!! ** Purpose : Lay out the global domain over processors.
	95	!!
	96	!! ** Method : Global domain is distributed in smaller local domains.
	97	!! Periodic condition is a function of the local domain position
	98	!! (global boundary or neighbouring domain) and of the global
	99	!! periodic
	100	!! Type : jperio global periodic condition
	101	!! nperio local periodic condition
	102	!!
	103	!! ** Action : - set domain parameters
	104	!! nimpp : longitudinal index
	105	!! njmpp : latitudinal index
	106	!! nperio : lateral condition type
	107	!! narea : number for local area
	108	!! nlci : first dimension
	109	!! nlcj : second dimension
	110	!! nbondi : mark for "east-west local boundary"
	111	!! nbondj : mark for "north-south local boundary"
	112	!! nproc : number for local processor
	113	!! noea : number for local neighboring processor
	114	!! nowe : number for local neighboring processor
	115	!! noso : number for local neighboring processor
	116	!! nono : number for local neighboring processor
	117	!!
	118	!! History :
	119	!! ! 94-11 (M. Guyon) Original code
	120	!! ! 95-04 (J. Escobar, M. Imbard)
	121	!! ! 98-02 (M. Guyon) FETI method
	122	!! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions
	123	!! 8.5 ! 02-08 (G. Madec) F90 : free form
[3294]	124	!! 3.4 ! 11-11 (C. Harris) decomposition changes for running with CICE
[3]	125	!!----------------------------------------------------------------------
[2715]	126	INTEGER :: ji, jj, jn ! dummy loop indices
	127	INTEGER :: ii, ij, ifreq, il1, il2 ! local integers
	128	INTEGER :: iresti, irestj, ijm1, imil, inum ! - -
	129	REAL(wp) :: zidom, zjdom ! local scalars
	130	INTEGER, DIMENSION(jpni,jpnj) :: iimppt, ijmppt, ilcit, ilcjt ! local workspace
[3]	131	!!----------------------------------------------------------------------
	132
[88]	133	IF(lwp) WRITE(numout,*)
	134	IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
	135	IF(lwp) WRITE(numout,*) '~~~~~~~~'
[3]	136
	137
	138	! 1. Dimension arrays for subdomains
	139	! -----------------------------------
	140	! Computation of local domain sizes ilcit() ilcjt()
	141	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
	142	! The subdomains are squares leeser than or equal to the global
	143	! dimensions divided by the number of processors minus the overlap
	144	! array (cf. par_oce.F90).
	145
	146	nreci = 2 * jpreci
	147	nrecj = 2 * jprecj
	148	iresti = MOD( jpiglo - nreci , jpni )
	149	irestj = MOD( jpjglo - nrecj , jpnj )
	150
	151	IF( iresti == 0 ) iresti = jpni
[3294]	152
	153	#if defined key_nemocice_decomp
	154	! In order to match CICE the size of domains in NEMO has to be changed
	155	! The last line of blocks (west) will have fewer points
	156
[3]	157	DO jj = 1, jpnj
[3294]	158	DO ji=1, jpni-1
	159	ilcit(ji,jj) = jpi
	160	END DO
	161	ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci)
	162	END DO
	163
	164	#else
	165
	166	DO jj = 1, jpnj
[3]	167	DO ji = 1, iresti
	168	ilcit(ji,jj) = jpi
	169	END DO
	170	DO ji = iresti+1, jpni
	171	ilcit(ji,jj) = jpi -1
	172	END DO
	173	END DO
	174
[3294]	175	#endif
[4671]	176	nfilcit(:,:) = ilcit(:,:)
[3]	177	IF( irestj == 0 ) irestj = jpnj
[3294]	178
	179	#if defined key_nemocice_decomp
	180	! Same change to domains in North-South direction as in East-West.
	181	DO ji=1,jpni
	182	DO jj=1,jpnj-1
	183	ilcjt(ji,jj) = jpj
	184	END DO
	185	ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
	186	END DO
	187
	188	#else
	189
[3]	190	DO ji = 1, jpni
	191	DO jj = 1, irestj
	192	ilcjt(ji,jj) = jpj
	193	END DO
	194	DO jj = irestj+1, jpnj
	195	ilcjt(ji,jj) = jpj -1
	196	END DO
	197	END DO
	198
[3294]	199	#endif
[3]	200	IF(lwp) THEN
	201	WRITE(numout,*)
	202	WRITE(numout,*) ' defines mpp subdomains'
	203	WRITE(numout,*) ' ----------------------'
[516]	204	WRITE(numout,*) ' iresti=',iresti,' irestj=',irestj
	205	WRITE(numout,*) ' jpni =',jpni ,' jpnj =',jpnj
[3]	206	ifreq = 4
	207	il1 = 1
	208	DO jn = 1, (jpni-1)/ifreq+1
	209	il2 = MIN( jpni, il1+ifreq-1 )
	210	WRITE(numout,*)
	211	WRITE(numout,9200) ('***',ji = il1,il2-1)
[516]	212	DO jj = jpnj, 1, -1
[3]	213	WRITE(numout,9203) (' ',ji = il1,il2-1)
	214	WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
	215	WRITE(numout,9203) (' ',ji = il1,il2-1)
	216	WRITE(numout,9200) ('***',ji = il1,il2-1)
	217	END DO
[516]	218	WRITE(numout,9201) (ji,ji = il1,il2)
[3]	219	il1 = il1+ifreq
	220	END DO
	221	9200 FORMAT(' *',20('***********',a3))
	222	9203 FORMAT(' * ',20(' * ',a3))
	223	9201 FORMAT(' ',20(' ',i3,' '))
	224	9202 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
	225	ENDIF
	226
	227	zidom = nreci
	228	DO ji = 1, jpni
	229	zidom = zidom + ilcit(ji,1) - nreci
	230	END DO
	231	IF(lwp) WRITE(numout,*)
	232	IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
	233
	234	zjdom = nrecj
	235	DO jj = 1, jpnj
	236	zjdom = zjdom + ilcjt(1,jj) - nrecj
	237	END DO
	238	IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
	239	IF(lwp) WRITE(numout,*)
	240
	241
	242	! 2. Index arrays for subdomains
	243	! -------------------------------
	244
	245	iimppt(:,:) = 1
	246	ijmppt(:,:) = 1
	247
	248	IF( jpni > 1 ) THEN
	249	DO jj = 1, jpnj
	250	DO ji = 2, jpni
	251	iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
	252	END DO
	253	END DO
	254	ENDIF
[4671]	255	nfiimpp(:,:)=iimppt(:,:)
[3]	256
	257	IF( jpnj > 1 ) THEN
	258	DO jj = 2, jpnj
	259	DO ji = 1, jpni
	260	ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
	261	END DO
	262	END DO
	263	ENDIF
	264
	265	! 3. Subdomain description
	266	! ------------------------
	267
	268	DO jn = 1, jpnij
	269	ii = 1 + MOD( jn-1, jpni )
	270	ij = 1 + (jn-1) / jpni
[4679]	271	nfipproc(ii,ij) = jn - 1
[3]	272	nimppt(jn) = iimppt(ii,ij)
	273	njmppt(jn) = ijmppt(ii,ij)
	274	nlcit (jn) = ilcit (ii,ij)
	275	nlci = nlcit (jn)
	276	nlcjt (jn) = ilcjt (ii,ij)
	277	nlcj = nlcjt (jn)
	278	nbondj = -1 ! general case
	279	IF( jn > jpni ) nbondj = 0 ! first row of processor
	280	IF( jn > (jpnj-1)*jpni ) nbondj = 1 ! last row of processor
	281	IF( jpnj == 1 ) nbondj = 2 ! one processor only in j-direction
	282	ibonjt(jn) = nbondj
	283
	284	nbondi = 0 !
	285	IF( MOD( jn, jpni ) == 1 ) nbondi = -1 !
	286	IF( MOD( jn, jpni ) == 0 ) nbondi = 1 !
	287	IF( jpni == 1 ) nbondi = 2 ! one processor only in i-direction
	288	ibonit(jn) = nbondi
	289
	290	nldi = 1 + jpreci
	291	nlei = nlci - jpreci
	292	IF( nbondi == -1 .OR. nbondi == 2 ) nldi = 1
	293	IF( nbondi == 1 .OR. nbondi == 2 ) nlei = nlci
	294	nldj = 1 + jprecj
	295	nlej = nlcj - jprecj
	296	IF( nbondj == -1 .OR. nbondj == 2 ) nldj = 1
	297	IF( nbondj == 1 .OR. nbondj == 2 ) nlej = nlcj
	298	nldit(jn) = nldi
	299	nleit(jn) = nlei
	300	nldjt(jn) = nldj
	301	nlejt(jn) = nlej
	302	END DO
	303
	304
	305	! 4. From global to local
	306	! -----------------------
	307
	308	nperio = 0
	309	IF( jperio == 2 .AND. nbondj == -1 ) nperio = 2
	310
	311
	312	! 5. Subdomain neighbours
	313	! ----------------------
	314
	315	nproc = narea - 1
	316	noso = nproc - jpni
	317	nowe = nproc - 1
	318	noea = nproc + 1
	319	nono = nproc + jpni
	320	! great neighbours
	321	npnw = nono - 1
	322	npne = nono + 1
	323	npsw = noso - 1
	324	npse = noso + 1
	325	nbsw = 1
	326	nbnw = 1
	327	IF( MOD( nproc, jpni ) == 0 ) THEN
	328	nbsw = 0
	329	nbnw = 0
	330	ENDIF
	331	nbse = 1
	332	nbne = 1
	333	IF( MOD( nproc, jpni ) == jpni-1 ) THEN
	334	nbse = 0
	335	nbne = 0
	336	ENDIF
	337	IF(nproc < jpni) THEN
	338	nbsw = 0
	339	nbse = 0
	340	ENDIF
	341	IF( nproc >= (jpnj-1)*jpni ) THEN
	342	nbnw = 0
	343	nbne = 0
	344	ENDIF
	345	nlcj = nlcjt(narea)
	346	nlci = nlcit(narea)
	347	nldi = nldit(narea)
	348	nlei = nleit(narea)
	349	nldj = nldjt(narea)
	350	nlej = nlejt(narea)
	351	nbondi = ibonit(narea)
	352	nbondj = ibonjt(narea)
	353	nimpp = nimppt(narea)
	354	njmpp = njmppt(narea)
	355
	356	! Save processor layout in layout.dat file
	357	IF (lwp) THEN
[1581]	358	CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
[434]	359	WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo'
[3]	360	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
	361	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
	362
	363	DO jn = 1, jpnij
	364	WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
	365	nldit(jn), nldjt(jn), &
	366	nleit(jn), nlejt(jn), &
	367	nimppt(jn), njmppt(jn)
	368	END DO
	369	CLOSE(inum)
	370	END IF
	371
	372
	373	! w a r n i n g narea (zone) /= nproc (processors)!
	374
	375	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
	376	IF( jpni == 1 )THEN
	377	nbondi = 2
	378	nperio = 1
	379	ELSE
	380	nbondi = 0
	381	ENDIF
	382	IF( MOD( narea, jpni ) == 0 ) THEN
	383	noea = nproc-(jpni-1)
	384	npne = npne-jpni
	385	npse = npse-jpni
	386	ENDIF
	387	IF( MOD( narea, jpni ) == 1 ) THEN
	388	nowe = nproc+(jpni-1)
	389	npnw = npnw+jpni
	390	npsw = npsw+jpni
	391	ENDIF
	392	nbsw = 1
	393	nbnw = 1
	394	nbse = 1
	395	nbne = 1
	396	IF( nproc < jpni ) THEN
	397	nbsw = 0
	398	nbse = 0
	399	ENDIF
	400	IF( nproc >= (jpnj-1)*jpni ) THEN
	401	nbnw = 0
	402	nbne = 0
	403	ENDIF
	404	ENDIF
	405	npolj = 0
	406	IF( jperio == 3 .OR. jperio == 4 ) THEN
	407	ijm1 = jpni*(jpnj-1)
	408	imil = ijm1+(jpni+1)/2
	409	IF( narea > ijm1 ) npolj = 3
	410	IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
	411	IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
	412	ENDIF
	413	IF( jperio == 5 .OR. jperio == 6 ) THEN
	414	ijm1 = jpni*(jpnj-1)
	415	imil = ijm1+(jpni+1)/2
	416	IF( narea > ijm1) npolj = 5
	417	IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
	418	IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
	419	ENDIF
	420
	421	! Periodicity : no corner if nbondi = 2 and nperio != 1
	422
	423	IF(lwp) THEN
	424	WRITE(numout,*) ' nproc = ', nproc
	425	WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea
	426	WRITE(numout,*) ' nono = ', nono , ' noso = ', noso
	427	WRITE(numout,*) ' nbondi = ', nbondi
	428	WRITE(numout,*) ' nbondj = ', nbondj
	429	WRITE(numout,*) ' npolj = ', npolj
	430	WRITE(numout,*) ' nperio = ', nperio
	431	WRITE(numout,*) ' nlci = ', nlci
	432	WRITE(numout,*) ' nlcj = ', nlcj
	433	WRITE(numout,*) ' nimpp = ', nimpp
	434	WRITE(numout,*) ' njmpp = ', njmpp
	435	WRITE(numout,*) ' nbse = ', nbse , ' npse = ', npse
	436	WRITE(numout,*) ' nbsw = ', nbsw , ' npsw = ', npsw
	437	WRITE(numout,*) ' nbne = ', nbne , ' npne = ', npne
	438	WRITE(numout,*) ' nbnw = ', nbnw , ' npnw = ', npnw
	439	ENDIF
	440
[474]	441	IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
[3]	442
	443	! Prepare mpp north fold
	444
	445	IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
	446	CALL mpp_ini_north
	447	END IF
	448
[88]	449	! Prepare NetCDF output file (if necessary)
	450	CALL mpp_init_ioipsl
[3]	451
	452	END SUBROUTINE mpp_init
	453
	454	# include "mppini_2.h90"
	455
[88]	456	SUBROUTINE mpp_init_ioipsl
	457	!!----------------------------------------------------------------------
	458	!! * ROUTINE mpp_init_ioipsl *
	459	!!
	460	!! ** Purpose :
	461	!!
	462	!! ** Method :
	463	!!
	464	!! History :
[1238]	465	!! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL
	466	!! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij
[88]	467	!!----------------------------------------------------------------------
[2715]	468	INTEGER, DIMENSION(2) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid
[88]	469	!!----------------------------------------------------------------------
[352]	470
[1238]	471	! The domain is split only horizontally along i- or/and j- direction
	472	! So we need at the most only 1D arrays with 2 elements.
	473	! Set idompar values equivalent to the jpdom_local_noextra definition
	474	! used in IOM. This works even if jpnij .ne. jpni*jpnj.
[88]	475	iglo(1) = jpiglo
	476	iglo(2) = jpjglo
	477	iloc(1) = nlci
	478	iloc(2) = nlcj
	479	iabsf(1) = nimppt(narea)
	480	iabsf(2) = njmppt(narea)
	481	iabsl(:) = iabsf(:) + iloc(:) - 1
[1238]	482	ihals(1) = nldi - 1
	483	ihals(2) = nldj - 1
	484	ihale(1) = nlci - nlei
	485	ihale(2) = nlcj - nlej
[352]	486	idid(1) = 1
	487	idid(2) = 2
	488
[88]	489	IF(lwp) THEN
[516]	490	WRITE(numout,*)
[352]	491	WRITE(numout,*) 'mpp_init_ioipsl : iloc = ', iloc (1), iloc (2)
	492	WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf(1), iabsf(2)
	493	WRITE(numout,*) ' ihals = ', ihals(1), ihals(2)
	494	WRITE(numout,*) ' ihale = ', ihale(1), ihale(2)
[88]	495	ENDIF
[2715]	496	!
[352]	497	CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
[2715]	498	!
[88]	499	END SUBROUTINE mpp_init_ioipsl
	500
[3]	501	#endif
[88]	502
[3]	503	!!======================================================================
	504	END MODULE mppini

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90 @ 6140

Download in other formats: