SUBROUTINE mpp_init2 !!---------------------------------------------------------------------- !! *** ROUTINE mpp_init2 *** !! !! * Purpose : Lay out the global domain over processors. !! FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED !! FOR DEFINING BETTER CUTTING OUT. !! This routine is used with a the bathymetry file. !! In this version, the land processors are avoided and the adress !! processor (nproc, narea,noea, ...) are calculated again. !! The jpnij parameter can be lesser than jpni x jpnj !! and this jpnij parameter must be calculated before with an !! algoritmic preprocessing program. !! !! ** Method : Global domain is distributed in smaller local domains. !! Periodic condition is a function of the local domain position !! (global boundary or neighbouring domain) and of the global !! periodic !! Type : jperio global periodic condition !! nperio local periodic condition !! !! ** Action : nimpp : longitudinal index !! njmpp : latitudinal index !! nperio : lateral condition type !! narea : number for local area !! nlci : first dimension !! nlcj : second dimension !! nproc : number for local processor !! noea : number for local neighboring processor !! nowe : number for local neighboring processor !! noso : number for local neighboring processor !! nono : number for local neighboring processor !! !! History : !! ! 94-11 (M. Guyon) Original code !! ! 95-04 (J. Escobar, M. Imbard) !! ! 98-02 (M. Guyon) FETI method !! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions !! 9.0 ! 04-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 !!---------------------------------------------------------------------- USE in_out_manager ! I/O Manager USE iom !! INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices INTEGER :: inum ! temporary logical unit INTEGER :: idir ! temporary integers INTEGER :: jstartrow ! temporary integers INTEGER :: ios ! Local integer output status for namelist read INTEGER :: & ii, ij, ifreq, il1, il2, & ! temporary integers icont, ili, ilj, & ! " " isurf, ijm1, imil, & ! " " iino, ijno, iiso, ijso, & ! " " iiea, ijea, iiwe, ijwe, & ! " " iinw, ijnw, iine, ijne, & ! " " iisw, ijsw, iise, ijse, & ! " " iresti, irestj, iproc ! " " INTEGER, DIMENSION(jpnij) :: & iin, ijn INTEGER, DIMENSION(jpni,jpnj) :: & iimppt, ijmppt, ilci , ilcj , & ! temporary workspace ipproc, ibondj, ibondi, ipolj , & ! " " ilei , ilej , ildi , ildj , & ! " " ioea , iowe , ioso , iono , & ! " " ione , ionw , iose , iosw , & ! " " ibne , ibnw , ibse , ibsw ! " " INTEGER, DIMENSION(jpiglo,jpjglo) :: & imask ! temporary global workspace REAL(wp), DIMENSION(jpiglo,jpjglo) :: & zdta, zdtaisf ! temporary data workspace REAL(wp) :: zidom , zjdom ! temporary scalars ! read namelist for ln_zco NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Id: mppini_2.h90 4990 2014-12-15 16:42:49Z timgraham $ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) IF(lwm) WRITE ( numond, namzgr ) IF(lwp)WRITE(numout,*) IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI' IF(lwp)WRITE(numout,*) '~~~~~~~~' IF(lwp)WRITE(numout,*) ' ' IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) ! 0. initialisation ! ----------------- ! open the file ! Remember that at this level in the code, mpp is not yet initialized, so ! the file must be open with jpdom_unknown, and kstart and kcount forced jstartrow = 1 IF ( ln_zco ) THEN CALL iom_open ( 'bathy_level.nc', inum ) ! Level bathymetry ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found jstartrow = MAX(1,jstartrow) CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) ) ELSE CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps IF ( ln_isfcav ) THEN CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) ELSE ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found jstartrow = MAX(1,jstartrow) CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/) & & , kcount=(/jpiglo,jpjglo/) ) ENDIF ENDIF CALL iom_close (inum) ! used to compute the land processor in case of not masked bathy file. zdtaisf(:,:) = 0.0_wp IF ( ln_isfcav ) THEN CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) END IF CALL iom_close (inum) ! land/sea mask over the global/zoom domain imask(:,:)=1 WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0 ! 1. Dimension arrays for subdomains ! ----------------------------------- ! Computation of local domain sizes ilci() ilcj() ! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo ! The subdomains are squares leeser than or equal to the global ! dimensions divided by the number of processors minus the overlap ! array. nreci=2*jpreci nrecj=2*jprecj iresti = 1 + MOD( jpiglo - nreci -1 , jpni ) irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) #if defined key_nemocice_decomp ! Change padding to be consistent with CICE ilci(1:jpni-1 ,:) = jpi ilci(jpni ,:) = jpiglo - (jpni - 1) * (jpi - nreci) ilcj(:, 1:jpnj-1) = jpj ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) #else ilci(1:iresti ,:) = jpi ilci(iresti+1:jpni ,:) = jpi-1 ilcj(:, 1:irestj) = jpj ilcj(:, irestj+1:jpnj) = jpj-1 #endif nfilcit(:,:) = ilci(:,:) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains' IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------' IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj zidom = nreci + sum(ilci(:,1) - nreci ) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo zjdom = nrecj + sum(ilcj(1,:) - nrecj ) IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo IF(lwp) WRITE(numout,*) ! 2. Index arrays for subdomains ! ------------------------------- iimppt(:,:) = 1 ijmppt(:,:) = 1 ipproc(:,:) = -1 IF( jpni > 1 )THEN DO jj = 1, jpnj DO ji = 2, jpni iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci END DO END DO ENDIF nfiimpp(:,:) = iimppt(:,:) IF( jpnj > 1 )THEN DO jj = 2, jpnj DO ji = 1, jpni ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj END DO END DO ENDIF ! 3. Subdomain description in the Regular Case ! -------------------------------------------- nperio = 0 icont = -1 DO jarea = 1, jpni*jpnj ii = 1 + MOD(jarea-1,jpni) ij = 1 + (jarea-1)/jpni ili = ilci(ii,ij) ilj = ilcj(ii,ij) ibondj(ii,ij) = -1 IF( jarea > jpni ) ibondj(ii,ij) = 0 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1 IF( jpnj == 1 ) ibondj(ii,ij) = 2 ibondi(ii,ij) = 0 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1 IF( jpni == 1 ) ibondi(ii,ij) = 2 ! 2.4 Subdomain neighbors iproc = jarea - 1 ioso(ii,ij) = iproc - jpni iowe(ii,ij) = iproc - 1 ioea(ii,ij) = iproc + 1 iono(ii,ij) = iproc + jpni ildi(ii,ij) = 1 + jpreci ilei(ii,ij) = ili -jpreci ionw(ii,ij) = iono(ii,ij) - 1 ione(ii,ij) = iono(ii,ij) + 1 iosw(ii,ij) = ioso(ii,ij) - 1 iose(ii,ij) = ioso(ii,ij) + 1 ibsw(ii,ij) = 1 ibnw(ii,ij) = 1 IF( MOD(iproc,jpni) == 0 ) THEN ibsw(ii,ij) = 0 ibnw(ii,ij) = 0 ENDIF ibse(ii,ij) = 1 ibne(ii,ij) = 1 IF( MOD(iproc,jpni) == jpni-1 ) THEN ibse(ii,ij) = 0 ibne(ii,ij) = 0 ENDIF IF( iproc < jpni ) THEN ibsw(ii,ij) = 0 ibse(ii,ij) = 0 ENDIF IF( iproc >= (jpnj-1)*jpni ) THEN ibnw(ii,ij) = 0 ibne(ii,ij) = 0 ENDIF IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili ildj(ii,ij) = 1 + jprecj ilej(ii,ij) = ilj - jprecj IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj ! warning ii*ij (zone) /= nproc (processors)! IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN IF( jpni == 1 )THEN ibondi(ii,ij) = 2 nperio = 1 ELSE ibondi(ii,ij) = 0 ENDIF IF( MOD(jarea,jpni) == 0 ) THEN ioea(ii,ij) = iproc - (jpni-1) ione(ii,ij) = ione(ii,ij) - jpni iose(ii,ij) = iose(ii,ij) - jpni ENDIF IF( MOD(jarea,jpni) == 1 ) THEN iowe(ii,ij) = iproc + jpni - 1 ionw(ii,ij) = ionw(ii,ij) + jpni iosw(ii,ij) = iosw(ii,ij) + jpni ENDIF ibsw(ii,ij) = 1 ibnw(ii,ij) = 1 ibse(ii,ij) = 1 ibne(ii,ij) = 1 IF( iproc < jpni ) THEN ibsw(ii,ij) = 0 ibse(ii,ij) = 0 ENDIF IF( iproc >= (jpnj-1)*jpni ) THEN ibnw(ii,ij) = 0 ibne(ii,ij) = 0 ENDIF ENDIF ipolj(ii,ij) = 0 IF( jperio == 3 .OR. jperio == 4 ) THEN ijm1 = jpni*(jpnj-1) imil = ijm1+(jpni+1)/2 IF( jarea > ijm1 ) ipolj(ii,ij) = 3 IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4 IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour ENDIF IF( jperio == 5 .OR. jperio == 6 ) THEN ijm1 = jpni*(jpnj-1) imil = ijm1+(jpni+1)/2 IF( jarea > ijm1) ipolj(ii,ij) = 5 IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6 IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour ENDIF ! Check wet points over the entire domain to preserve the MPI communication stencil isurf = 0 DO jj = 1, ilj DO ji = 1, ili IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 END DO END DO IF(isurf /= 0) THEN icont = icont + 1 ipproc(ii,ij) = icont iin(icont+1) = ii ijn(icont+1) = ij ENDIF END DO nfipproc(:,:) = ipproc(:,:) ! Control IF(icont+1 /= jpnij) THEN WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) ENDIF ! 4. Subdomain print ! ------------------ IF(lwp) THEN ifreq = 4 il1 = 1 DO jn = 1,(jpni-1)/ifreq+1 il2 = MIN(jpni,il1+ifreq-1) WRITE(numout,*) WRITE(numout,9400) ('***',ji=il1,il2-1) DO jj = jpnj, 1, -1 WRITE(numout,9403) (' ',ji=il1,il2-1) WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2) WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2) WRITE(numout,9403) (' ',ji=il1,il2-1) WRITE(numout,9400) ('***',ji=il1,il2-1) END DO WRITE(numout,9401) (ji,ji=il1,il2) il1 = il1+ifreq END DO 9400 FORMAT(' ***',20('*************',a3)) 9403 FORMAT(' * ',20(' * ',a3)) 9401 FORMAT(' ',20(' ',i3,' ')) 9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ')) 9404 FORMAT(' * ',20(' ',i3,' * ')) ENDIF ! 5. neighbour treatment ! ---------------------- DO jarea = 1, jpni*jpnj iproc = jarea-1 ii = 1 + MOD(jarea-1,jpni) ij = 1 + (jarea-1)/jpni IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 & .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN iino = 1 + MOD(iono(ii,ij),jpni) ijno = 1 + (iono(ii,ij))/jpni ! Need to reverse the logical direction of communication ! for northern neighbours of northern row processors (north-fold) ! i.e. need to check that the northern neighbour only communicates ! to the SOUTH (or not at all) if this area is land-only (#1057) idir = 1 IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1 IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2 IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir ENDIF IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 & .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN iiso = 1 + MOD(ioso(ii,ij),jpni) ijso = 1 + (ioso(ii,ij))/jpni IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 ENDIF IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 & .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN iiea = 1 + MOD(ioea(ii,ij),jpni) ijea = 1 + (ioea(ii,ij))/jpni IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 ENDIF IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 & .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN iiwe = 1 + MOD(iowe(ii,ij),jpni) ijwe = 1 + (iowe(ii,ij))/jpni IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 ENDIF IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN iine = 1 + MOD(ione(ii,ij),jpni) ijne = 1 + (ione(ii,ij))/jpni IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0 ENDIF IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN iisw = 1 + MOD(iosw(ii,ij),jpni) ijsw = 1 + (iosw(ii,ij))/jpni IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0 ENDIF IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN iinw = 1 + MOD(ionw(ii,ij),jpni) ijnw = 1 + (ionw(ii,ij))/jpni IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0 ENDIF IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN iise = 1 + MOD(iose(ii,ij),jpni) ijse = 1 + (iose(ii,ij))/jpni IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0 ENDIF END DO ! 6. Change processor name ! ------------------------ nproc = narea-1 ii = iin(narea) ij = ijn(narea) ! set default neighbours noso = ioso(ii,ij) nowe = iowe(ii,ij) noea = ioea(ii,ij) nono = iono(ii,ij) npse = iose(ii,ij) npsw = iosw(ii,ij) npne = ione(ii,ij) npnw = ionw(ii,ij) ! check neighbours location IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN iiso = 1 + MOD(ioso(ii,ij),jpni) ijso = 1 + (ioso(ii,ij))/jpni noso = ipproc(iiso,ijso) ENDIF IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN iiwe = 1 + MOD(iowe(ii,ij),jpni) ijwe = 1 + (iowe(ii,ij))/jpni nowe = ipproc(iiwe,ijwe) ENDIF IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN iiea = 1 + MOD(ioea(ii,ij),jpni) ijea = 1 + (ioea(ii,ij))/jpni noea = ipproc(iiea,ijea) ENDIF IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN iino = 1 + MOD(iono(ii,ij),jpni) ijno = 1 + (iono(ii,ij))/jpni nono = ipproc(iino,ijno) ENDIF IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN iise = 1 + MOD(iose(ii,ij),jpni) ijse = 1 + (iose(ii,ij))/jpni npse = ipproc(iise,ijse) ENDIF IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN iisw = 1 + MOD(iosw(ii,ij),jpni) ijsw = 1 + (iosw(ii,ij))/jpni npsw = ipproc(iisw,ijsw) ENDIF IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN iine = 1 + MOD(ione(ii,ij),jpni) ijne = 1 + (ione(ii,ij))/jpni npne = ipproc(iine,ijne) ENDIF IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN iinw = 1 + MOD(ionw(ii,ij),jpni) ijnw = 1 + (ionw(ii,ij))/jpni npnw = ipproc(iinw,ijnw) ENDIF nbnw = ibnw(ii,ij) nbne = ibne(ii,ij) nbsw = ibsw(ii,ij) nbse = ibse(ii,ij) nlcj = ilcj(ii,ij) nlci = ilci(ii,ij) nldi = ildi(ii,ij) nlei = ilei(ii,ij) nldj = ildj(ii,ij) nlej = ilej(ii,ij) nbondi = ibondi(ii,ij) nbondj = ibondj(ii,ij) nimpp = iimppt(ii,ij) njmpp = ijmppt(ii,ij) DO jproc = 1, jpnij ii = iin(jproc) ij = ijn(jproc) nimppt(jproc) = iimppt(ii,ij) njmppt(jproc) = ijmppt(ii,ij) nlcjt(jproc) = ilcj(ii,ij) nlcit(jproc) = ilci(ii,ij) nldit(jproc) = ildi(ii,ij) nleit(jproc) = ilei(ii,ij) nldjt(jproc) = ildj(ii,ij) nlejt(jproc) = ilej(ii,ij) END DO ! Save processor layout in ascii file IF (lwp) THEN CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo' WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' DO jproc = 1, jpnij WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), & nldit(jproc), nldjt(jproc), & nleit(jproc), nlejt(jproc), & nimppt(jproc), njmppt(jproc) END DO CLOSE(inum) END IF ! Defined npolj, either 0, 3 , 4 , 5 , 6 ! In this case the important thing is that npolj /= 0 ! Because if we go through these line it is because jpni >1 and thus ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0 npolj = 0 ij = ijn(narea) IF( jperio == 3 .OR. jperio == 4 ) THEN IF( ij == jpnj ) npolj = 3 ENDIF IF( jperio == 5 .OR. jperio == 6 ) THEN IF( ij == jpnj ) npolj = 5 ENDIF ! Periodicity : no corner if nbondi = 2 and nperio != 1 IF(lwp) THEN WRITE(numout,*) ' nproc = ', nproc WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea WRITE(numout,*) ' nono = ', nono , ' noso = ', noso WRITE(numout,*) ' nbondi = ', nbondi WRITE(numout,*) ' nbondj = ', nbondj WRITE(numout,*) ' npolj = ', npolj WRITE(numout,*) ' nperio = ', nperio WRITE(numout,*) ' nlci = ', nlci WRITE(numout,*) ' nlcj = ', nlcj WRITE(numout,*) ' nimpp = ', nimpp WRITE(numout,*) ' njmpp = ', njmpp WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw WRITE(numout,*) ' jpreci = ', jpreci , ' npne = ', npne WRITE(numout,*) ' jprecj = ', jprecj , ' npnw = ', npnw WRITE(numout,*) ENDIF IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' ) ! Prepare mpp north fold IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN CALL mpp_ini_north IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1' ENDIF ! Prepare NetCDF output file (if necessary) CALL mpp_init_ioipsl END SUBROUTINE mpp_init2