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.

mppini_2.h90 in trunk/NEMO/OPA_SRC – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/mppini_2.h90 @ 417

Last change on this file since 417 was 392, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of Agrif :

add agrif to dynspg_flt_jki.F90
cosmetic change of key_AGRIF in key_agrif

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 22.1 KB

Rev	Line
[3]	1	SUBROUTINE mpp_init2
	2	!!----------------------------------------------------------------------
	3	!! * ROUTINE mpp_init2 *
	4	!!
	5	!! * Purpose : Lay out the global domain over processors.
	6	!! FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
	7	!! FOR DEFINING BETTER CUTTING OUT.
	8	!! This routine is used with a the bathymetry file.
	9	!! In this version, the land processors are avoided and the adress
	10	!! processor (nproc, narea,noea, ...) are calculated again.
	11	!! The jpnij parameter can be lesser than jpni x jpnj
	12	!! and this jpnij parameter must be calculated before with an
	13	!! algoritmic preprocessing program.
	14	!!
	15	!! ** Method : Global domain is distributed in smaller local domains.
	16	!! Periodic condition is a function of the local domain position
	17	!! (global boundary or neighbouring domain) and of the global
	18	!! periodic
	19	!! Type : jperio global periodic condition
	20	!! nperio local periodic condition
	21	!!
	22	!! ** Action : nimpp : longitudinal index
	23	!! njmpp : latitudinal index
	24	!! nperio : lateral condition type
	25	!! narea : number for local area
	26	!! nlci : first dimension
	27	!! nlcj : second dimension
	28	!! nproc : number for local processor
	29	!! noea : number for local neighboring processor
	30	!! nowe : number for local neighboring processor
	31	!! noso : number for local neighboring processor
	32	!! nono : number for local neighboring processor
	33	!!
	34	!! History :
	35	!! ! 94-11 (M. Guyon) Original code
	36	!! ! 95-04 (J. Escobar, M. Imbard)
	37	!! ! 98-02 (M. Guyon) FETI method
	38	!! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions
	39	!! 9.0 ! 04-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1
	40	!!----------------------------------------------------------------------
[128]	41	!! * Modules used
	42	USE ioipsl
	43
[3]	44	!! Local variables
[169]	45	CHARACTER (len=25) :: & ! temporary name
[128]	46	clname , clvar ! filename and cdf variable name for bathy
[69]	47	LOGICAL :: llbon ! check the existence of bathy files
[3]	48	INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices
	49	INTEGER :: inum = 11 ! temporary logical unit
	50	INTEGER :: &
	51	ii, ij, ifreq, il1, il2, & ! temporary integers
[169]	52	icont, ili, ilj, & ! " "
[3]	53	isurf, ijm1, imil, & ! " "
	54	iino, ijno, iiso, ijso, & ! " "
	55	iiea, ijea, iiwe, ijwe, & ! " "
	56	iinw, ijnw, iine, ijne, & ! " "
	57	iisw, ijsw, iise, ijse, & ! " "
	58	iresti, irestj, iproc ! " "
	59	INTEGER, DIMENSION(jpnij) :: &
	60	iin, ijn
	61	INTEGER, DIMENSION(jpni,jpnj) :: &
	62	iimppt, ijmppt, ilci , ilcj , & ! temporary workspace
	63	ipproc, ibondj, ibondi, ipolj , & ! " "
	64	ilei , ilej , ildi , ildj , & ! " "
	65	ioea , iowe , ioso , iono , & ! " "
	66	ione , ionw , iose , iosw , & ! " "
	67	ibne , ibnw , ibse , ibsw ! " "
[128]	68	INTEGER :: &
	69	ipi, ipj, ipk, & ! temporary integers
	70	itime ! " "
	71	INTEGER, DIMENSION (1) :: istep
	72
[3]	73	INTEGER, DIMENSION(jpiglo,jpjglo) :: &
	74	imask ! temporary global workspace
[128]	75
[290]	76	REAL(wp), DIMENSION(jpidta,jpjdta) :: &
[128]	77	zlamt, zphit, zdta ! temporary data workspace
	78	REAL(wp), DIMENSION(jpk) :: &
	79	zdept ! temporary workspace (NetCDF read)
	80	REAL(wp) :: zidom , zjdom, & ! temporary scalars
	81	zdt, zdate0
[169]	82
[3]	83	!!----------------------------------------------------------------------
[247]	84	!! OPA 9.0 , LOCEAN-IPSL (2005)
	85	!! $Header$
	86	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
[3]	87	!!----------------------------------------------------------------------
	88
	89	#if defined key_mpp_shmem
	90	IF(lwp)WRITE(numout,*)
	91	IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
	92	IF(lwp)WRITE(numout,*) '~~~~~~~~'
	93	IF(lwp)WRITE(numout,*) ' '
	94
	95	CALL mppshmem ! Initialisation of shmem array
	96
	97	#endif
	98	#if defined key_mpp_mpi
	99	IF(lwp)WRITE(numout,*)
	100	IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
	101	IF(lwp)WRITE(numout,*) '~~~~~~~~'
	102	IF(lwp)WRITE(numout,*) ' '
	103	#endif
	104
	105
	106	IF( jpni*jpnj < jpnij ) THEN
	107	IF(lwp) WRITE(numout,cform_err)
	108	IF(lwp) WRITE(numout,*) ' jpnij > jpni x jpnj impossible'
	109	nstop = nstop + 1
	110	ENDIF
	111
	112
	113	! 0. initialisation
	114	! -----------------
	115
	116	! open the file
[128]	117	IF ( lk_zps ) THEN
	118	clname = 'bathy_meter.nc' ! Meter bathy in case of partial steps
	119	clvar = 'Bathymetry'
	120	ELSE
	121	clname = 'bathy_level.nc' ! Level bathymetry
	122	clvar = 'Bathy_level'
	123	ENDIF
[392]	124	#if defined key_agrif
[389]	125	if ( .NOT. Agrif_Root() ) then
	126	clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
	127	endif
	128	#endif
[128]	129
	130	INQUIRE( FILE=clname, EXIST=llbon )
[69]	131	IF( llbon ) THEN
[128]	132	IF(lwp) WRITE(numout,*)
[290]	133	IF(lwp) WRITE(numout,*) ' read bathymetry in ', clname
[128]	134	IF(lwp) WRITE(numout,*)
	135	itime = 1
	136	ipi = jpidta
	137	ipj = jpjdta
	138	ipk = 1
	139	zdt = rdt
[221]	140
[290]	141	CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., &
[128]	142	ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum )
[290]	143	CALL flinget( inum, clvar, jpidta, jpjdta, 1, &
	144	itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) )
[128]	145	CALL flinclo( inum )
[69]	146	ELSE
	147	IF(lwp) WRITE(numout,cform_err)
[169]	148	IF(lwp) WRITE(numout,*)' mppini_2 : unable to read the file ', clname
[69]	149	nstop = nstop + 1
	150	ENDIF
	151
[3]	152	! land/sea mask over the global/zoom domain
[128]	153
[169]	154	imask(:,:)=1
[290]	155	WHERE ( zdta(jpizoom:(jpizoom+jpiglo-1),jpjzoom:(jpjglo+jpjzoom-1)) <= 0. ) imask = 0
[128]	156
[3]	157	! 1. Dimension arrays for subdomains
	158	! -----------------------------------
	159
	160	! Computation of local domain sizes ilci() ilcj()
	161	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
	162	! The subdomains are squares leeser than or equal to the global
	163	! dimensions divided by the number of processors minus the overlap
	164	! array.
[169]	165
[3]	166	nreci=2*jpreci
	167	nrecj=2*jprecj
[128]	168	iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
	169	irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
[3]	170
[128]	171	ilci(1:iresti ,:) = jpi
	172	ilci(iresti+1:jpni ,:) = jpi-1
	173
[169]	174	ilcj(:, 1:irestj) = jpj
	175	ilcj(:, irestj+1:jpnj) = jpj-1
[128]	176
[3]	177	IF(lwp) WRITE(numout,*)
	178	IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
	179	IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------'
	180	IF(lwp) WRITE(numout,*)
	181	IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
	182	IF(lwp) WRITE(numout,*)
	183	IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
	184
[128]	185	zidom = nreci + sum(ilci(:,1) - nreci )
[3]	186	IF(lwp) WRITE(numout,*)
	187	IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
	188
[128]	189	zjdom = nrecj + sum(ilcj(1,:) - nrecj )
	190	IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
[3]	191	IF(lwp) WRITE(numout,*)
	192
	193
	194	! 2. Index arrays for subdomains
	195	! -------------------------------
	196
[128]	197	iimppt(:,:) = 1
	198	ijmppt(:,:) = 1
	199	ipproc(:,:) = -1
[169]	200
[3]	201	IF( jpni > 1 )THEN
	202	DO jj = 1, jpnj
	203	DO ji = 2, jpni
	204	iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
	205	END DO
	206	END DO
	207	ENDIF
	208
	209	IF( jpnj > 1 )THEN
	210	DO jj = 2, jpnj
	211	DO ji = 1, jpni
	212	ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
	213	END DO
	214	END DO
	215	ENDIF
[169]	216
	217
[3]	218	! 3. Subdomain description in the Regular Case
	219	! --------------------------------------------
[169]	220
[3]	221	nperio = 0
	222	icont = -1
	223	DO jarea = 1, jpni*jpnj
	224	ii = 1 + MOD(jarea-1,jpni)
	225	ij = 1 + (jarea-1)/jpni
	226	ili = ilci(ii,ij)
	227	ilj = ilcj(ii,ij)
[169]	228
[3]	229	ibondj(ii,ij) = -1
	230	IF( jarea > jpni ) ibondj(ii,ij) = 0
	231	IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1
	232	IF( jpnj == 1 ) ibondj(ii,ij) = 2
[169]	233
[3]	234	ibondi(ii,ij) = 0
	235	IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1
	236	IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1
	237	IF( jpni == 1 ) ibondi(ii,ij) = 2
[169]	238
[3]	239	! 2.4 Subdomain neighbors
[169]	240
[3]	241	iproc = jarea - 1
	242	ioso(ii,ij) = iproc - jpni
	243	iowe(ii,ij) = iproc - 1
	244	ioea(ii,ij) = iproc + 1
	245	iono(ii,ij) = iproc + jpni
	246	ildi(ii,ij) = 1 + jpreci
	247	ilei(ii,ij) = ili -jpreci
	248	ionw(ii,ij) = iono(ii,ij) - 1
	249	ione(ii,ij) = iono(ii,ij) + 1
	250	iosw(ii,ij) = ioso(ii,ij) - 1
	251	iose(ii,ij) = ioso(ii,ij) + 1
	252	ibsw(ii,ij) = 1
	253	ibnw(ii,ij) = 1
	254	IF( MOD(iproc,jpni) == 0 ) THEN
	255	ibsw(ii,ij) = 0
	256	ibnw(ii,ij) = 0
	257	ENDIF
	258	ibse(ii,ij) = 1
	259	ibne(ii,ij) = 1
	260	IF( MOD(iproc,jpni) == jpni-1 ) THEN
	261	ibse(ii,ij) = 0
	262	ibne(ii,ij) = 0
	263	ENDIF
	264	IF( iproc < jpni ) THEN
	265	ibsw(ii,ij) = 0
	266	ibse(ii,ij) = 0
	267	ENDIF
	268	IF( iproc >= (jpnj-1)*jpni ) THEN
	269	ibnw(ii,ij) = 0
	270	ibne(ii,ij) = 0
	271	ENDIF
	272	IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
	273	IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
	274	ildj(ii,ij) = 1 + jprecj
	275	ilej(ii,ij) = ilj - jprecj
	276	IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
	277	IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
[169]	278
[3]	279	! warning ii*ij (zone) /= nproc (processors)!
[169]	280
[3]	281	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
	282	IF( jpni == 1 )THEN
	283	ibondi(ii,ij) = 2
	284	nperio = 1
	285	ELSE
	286	ibondi(ii,ij) = 0
	287	ENDIF
	288	IF( MOD(jarea,jpni) == 0 ) THEN
	289	ioea(ii,ij) = iproc - (jpni-1)
	290	ione(ii,ij) = ione(ii,ij) - jpni
	291	iose(ii,ij) = iose(ii,ij) - jpni
	292	ENDIF
	293	IF( MOD(jarea,jpni) == 1 ) THEN
	294	iowe(ii,ij) = iproc + jpni - 1
	295	ionw(ii,ij) = ionw(ii,ij) + jpni
	296	iosw(ii,ij) = iosw(ii,ij) + jpni
	297	ENDIF
	298	ibsw(ii,ij) = 1
	299	ibnw(ii,ij) = 1
	300	ibse(ii,ij) = 1
	301	ibne(ii,ij) = 1
	302	IF( iproc < jpni ) THEN
	303	ibsw(ii,ij) = 0
	304	ibse(ii,ij) = 0
	305	ENDIF
	306	IF( iproc >= (jpnj-1)*jpni ) THEN
	307	ibnw(ii,ij) = 0
	308	ibne(ii,ij) = 0
	309	ENDIF
	310	ENDIF
[169]	311	ipolj(ii,ij) = 0
[3]	312	IF( jperio == 3 .OR. jperio == 4 ) THEN
	313	ijm1 = jpni*(jpnj-1)
	314	imil = ijm1+(jpni+1)/2
	315	IF( jarea > ijm1 ) ipolj(ii,ij) = 3
	316	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
	317	IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
	318	ENDIF
	319	IF( jperio == 5 .OR. jperio == 6 ) THEN
	320	ijm1 = jpni*(jpnj-1)
	321	imil = ijm1+(jpni+1)/2
	322	IF( jarea > ijm1) ipolj(ii,ij) = 5
	323	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
	324	IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
	325	ENDIF
[169]	326
[3]	327	isurf = 0
[290]	328	DO jj = 1+jprecj, ilj-jprecj
	329	DO ji = 1+jpreci, ili-jpreci
[3]	330	IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
	331	END DO
	332	END DO
	333	IF(isurf /= 0) THEN
	334	icont = icont + 1
	335	ipproc(ii,ij) = icont
	336	iin(icont+1) = ii
	337	ijn(icont+1) = ij
	338	ENDIF
	339	END DO
[169]	340
[3]	341	! Control
	342	IF(icont+1 /= jpnij) THEN
	343	IF(lwp) THEN
	344	WRITE(numout,*) ' Eliminate land processors algorithm'
	345	WRITE(numout,*)
	346	WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj
	347	WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj'
	348	WRITE(numout,*)
	349	WRITE(numout,*) ' E R R O R '
	350	WRITE(numout,) ' **********, mpp_init2 finds jpnij=',icont+1
	351	WRITE(numout,*) ' we stop'
	352	ENDIF
	353	STOP 'mpp_init2'
	354	ENDIF
[169]	355
	356
[3]	357	! 4. Subdomain print
	358	! ------------------
[169]	359
[3]	360	IF(lwp) THEN
	361	ifreq = 4
	362	il1 = 1
	363	DO jn = 1,(jpni-1)/ifreq+1
	364	il2 = MIN(jpni,il1+ifreq-1)
	365	WRITE(numout,*)
	366	WRITE(numout,9401) (ji,ji=il1,il2)
	367	WRITE(numout,9400) ('***',ji=il1,il2-1)
	368	DO jj = 1, jpnj
	369	! WRITE(numout,9400)
	370	WRITE(numout,9403) (' ',ji=il1,il2-1)
	371	WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
	372	WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
	373	WRITE(numout,9403) (' ',ji=il1,il2-1)
	374	WRITE(numout,9400) ('***',ji=il1,il2-1)
	375	! WRITE(numout,9400)
	376	END DO
	377	il1 = il1+ifreq
	378	END DO
	379	9400 FORMAT(' *',20('***********',a3))
	380	9403 FORMAT(' * ',20(' * ',a3))
	381	9401 FORMAT(' ',20(' ',i3,' '))
	382	9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
	383	9404 FORMAT(' * ',20(' ',i3,' * '))
	384	ENDIF
	385
	386
	387	! 5. neighbour treatment
	388	! ----------------------
[169]	389
[3]	390	DO jarea = 1, jpni*jpnj
	391	iproc = jarea-1
	392	ii = 1 + MOD(jarea-1,jpni)
	393	ij = 1 + (jarea-1)/jpni
	394	IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 &
	395	.AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
	396	iino = 1 + MOD(iono(ii,ij),jpni)
	397	ijno = 1 + (iono(ii,ij))/jpni
	398	IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
	399	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
	400	ENDIF
	401	IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 &
	402	.AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
	403	iiso = 1 + MOD(ioso(ii,ij),jpni)
	404	ijso = 1 + (ioso(ii,ij))/jpni
	405	IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
	406	IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1
	407	ENDIF
	408	IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 &
	409	.AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
	410	iiea = 1 + MOD(ioea(ii,ij),jpni)
	411	ijea = 1 + (ioea(ii,ij))/jpni
	412	IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
	413	IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
	414	ENDIF
	415	IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 &
	416	.AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
	417	iiwe = 1 + MOD(iowe(ii,ij),jpni)
	418	ijwe = 1 + (iowe(ii,ij))/jpni
	419	IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
	420	IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1
	421	ENDIF
	422	IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
	423	iine = 1 + MOD(ione(ii,ij),jpni)
	424	ijne = 1 + (ione(ii,ij))/jpni
	425	IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
	426	ENDIF
	427	IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
	428	iisw = 1 + MOD(iosw(ii,ij),jpni)
	429	ijsw = 1 + (iosw(ii,ij))/jpni
	430	IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
	431	ENDIF
	432	IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
	433	iinw = 1 + MOD(ionw(ii,ij),jpni)
	434	ijnw = 1 + (ionw(ii,ij))/jpni
	435	IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
	436	ENDIF
	437	IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
	438	iise = 1 + MOD(iose(ii,ij),jpni)
	439	ijse = 1 + (iose(ii,ij))/jpni
	440	IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
	441	ENDIF
	442	END DO
[169]	443
	444
[3]	445	! 6. Change processor name
	446	! ------------------------
[169]	447
[3]	448	nproc = narea-1
	449	ii = iin(narea)
	450	ij = ijn(narea)
	451	IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
	452	iiso = 1 + MOD(ioso(ii,ij),jpni)
	453	ijso = 1 + (ioso(ii,ij))/jpni
	454	noso = ipproc(iiso,ijso)
	455	ENDIF
	456	IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
	457	iiwe = 1 + MOD(iowe(ii,ij),jpni)
	458	ijwe = 1 + (iowe(ii,ij))/jpni
	459	nowe = ipproc(iiwe,ijwe)
	460	ENDIF
	461	IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
	462	iiea = 1 + MOD(ioea(ii,ij),jpni)
	463	ijea = 1 + (ioea(ii,ij))/jpni
	464	noea = ipproc(iiea,ijea)
	465	ENDIF
	466	IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
	467	iino = 1 + MOD(iono(ii,ij),jpni)
	468	ijno = 1 + (iono(ii,ij))/jpni
	469	nono = ipproc(iino,ijno)
	470	ENDIF
	471	IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
	472	iise = 1 + MOD(iose(ii,ij),jpni)
	473	ijse = 1 + (iose(ii,ij))/jpni
	474	npse = ipproc(iise,ijse)
	475	ENDIF
	476	IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
	477	iisw = 1 + MOD(iosw(ii,ij),jpni)
	478	ijsw = 1 + (iosw(ii,ij))/jpni
	479	npsw = ipproc(iisw,ijsw)
	480	ENDIF
	481	IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
	482	iine = 1 + MOD(ione(ii,ij),jpni)
	483	ijne = 1 + (ione(ii,ij))/jpni
	484	npne = ipproc(iine,ijne)
	485	ENDIF
	486	IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
	487	iinw = 1 + MOD(ionw(ii,ij),jpni)
	488	ijnw = 1 + (ionw(ii,ij))/jpni
	489	npnw = ipproc(iinw,ijnw)
	490	ENDIF
	491	nbnw = ibnw(ii,ij)
	492	nbne = ibne(ii,ij)
	493	nbsw = ibsw(ii,ij)
	494	nbse = ibse(ii,ij)
	495	nlcj = ilcj(ii,ij)
	496	nlci = ilci(ii,ij)
	497	nldi = ildi(ii,ij)
	498	nlei = ilei(ii,ij)
	499	nldj = ildj(ii,ij)
	500	nlej = ilej(ii,ij)
	501	nbondi = ibondi(ii,ij)
	502	nbondj = ibondj(ii,ij)
	503	nimpp = iimppt(ii,ij)
	504	njmpp = ijmppt(ii,ij)
	505	DO jproc = 1, jpnij
	506	ii = iin(jproc)
	507	ij = ijn(jproc)
	508	nimppt(jproc) = iimppt(ii,ij)
	509	njmppt(jproc) = ijmppt(ii,ij)
	510	nlcjt(jproc) = ilcj(ii,ij)
	511	nlcit(jproc) = ilci(ii,ij)
	512	nldit(jproc) = ildi(ii,ij)
	513	nleit(jproc) = ilei(ii,ij)
	514	nldjt(jproc) = ildj(ii,ij)
	515	nlejt(jproc) = ilej(ii,ij)
	516	END DO
	517
	518	! Save processor layout in ascii file
	519	IF (lwp) THEN
	520	OPEN(inum,FILE='layout.dat')
	521	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
	522	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
	523
	524	DO jproc = 1, jpnij
	525	WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
	526	nldit(jproc), nldjt(jproc), &
	527	nleit(jproc), nlejt(jproc), &
	528	nimppt(jproc), njmppt(jproc)
	529	END DO
	530	CLOSE(inum)
	531	END IF
	532
	533
	534	! FETI method
[169]	535
[3]	536	IF( nperio == 1 .AND. nsolv == 3 ) THEN
[169]	537
[3]	538	! general CASE : Earth == infinite tube
[169]	539
[3]	540	nbnw = 1
	541	npnw = narea
	542	nbne = 1
	543	npne = narea
	544	nbsw = 1
	545	npsw = (narea-2)
	546	nbse = 1
	547	npse = (narea-2)
[169]	548
[3]	549	! REAL boundary condition
[169]	550
[3]	551	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
	552	nbsw = 0
	553	nbse = 0
	554	ENDIF
[169]	555
[3]	556	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
	557	nbsw = 0
	558	nbse = 0
	559	ENDIF
[169]	560
[3]	561	IF( nbondj == 1 .OR. nbondj == 2 ) THEN
	562	nbnw = 0
	563	nbne = 0
	564	ENDIF
	565	ENDIF
[169]	566
[3]	567	IF( nperio == 1 .AND.jpni /= 1 ) THEN
	568	IF(lwp) WRITE(numout,cform_err)
	569	IF(lwp) WRITE(numout,*) ' mpp_init2: error on cyclicity'
	570	nstop = nstop + 1
	571	ENDIF
	572
	573	! Prepare mpp north fold
	574
[290]	575	IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
[3]	576	CALL mpp_ini_north
	577	IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
[290]	578	ENDIF
[3]	579
	580	! Defined npolj, either 0, 3 , 4 , 5 , 6
	581	! In this case the important thing is that npolj /= 0
	582	! Because if we go through these line it is because jpni >1 and thus
	583	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
	584
	585	npolj = 0
	586	ij = ijn(narea)
	587
[290]	588	IF( jperio == 3 .OR. jperio == 4 ) THEN
	589	IF( ij == jpnj ) npolj = 3
[3]	590	ENDIF
	591
	592	IF( jperio == 5 .OR. jperio == 6 ) THEN
[290]	593	IF( ij == jpnj ) npolj = 5
[3]	594	ENDIF
[389]	595
[290]	596	! Prepare NetCDF output file (if necessary)
	597	CALL mpp_init_ioipsl
[3]	598
[290]	599	! Periodicity : no corner if nbondi = 2 and nperio != 1
[3]	600
[290]	601	IF(lwp) THEN
	602	WRITE(numout,*) ' nproc= ',nproc
	603	WRITE(numout,*) ' nowe= ',nowe
	604	WRITE(numout,*) ' noea= ',noea
	605	WRITE(numout,*) ' nono= ',nono
	606	WRITE(numout,*) ' noso= ',noso
	607	WRITE(numout,*) ' nbondi= ',nbondi
	608	WRITE(numout,*) ' nbondj= ',nbondj
	609	WRITE(numout,*) ' npolj= ',npolj
	610	WRITE(numout,*) ' nperio= ',nperio
	611	WRITE(numout,*) ' nlci= ',nlci
	612	WRITE(numout,*) ' nlcj= ',nlcj
	613	WRITE(numout,*) ' nimpp= ',nimpp
	614	WRITE(numout,*) ' njmpp= ',njmpp
	615	WRITE(numout,*) ' nbse= ',nbse,' npse= ',npse
	616	WRITE(numout,*) ' nbsw= ',nbsw,' npsw= ',npsw
	617	WRITE(numout,*) ' nbne= ',nbne,' npne= ',npne
	618	WRITE(numout,*) ' nbnw= ',nbnw,' npnw= ',npnw
	619	ENDIF
	620
[3]	621	END SUBROUTINE mpp_init2

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

Download in other formats:

Original Format