Changeset 8375
- Timestamp:
- 2017-07-26T14:30:01+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r8314 r8375 1 1 MODULE mppini 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE mppini *** 4 4 !! Ocean initialization : distributed memory computing initialization 5 !!============================================================================== 6 7 !!---------------------------------------------------------------------- 8 !! mpp_init : Lay out the global domain over processors 9 !! with/without land processor elimination 10 !! mpp_init_ioispl: IOIPSL initialization in mpp 11 !!---------------------------------------------------------------------- 12 USE dom_oce ! ocean space and time domain 13 USE in_out_manager ! I/O Manager 14 USE lib_mpp ! distribued memory computing library 15 USE ioipsl 16 USE iom 5 !!====================================================================== 6 !! History : 6.0 ! 1994-11 (M. Guyon) Original code 7 !! OPA 7.0 ! 1995-04 (J. Escobar, M. Imbard) 8 !! 8.0 ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 9 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 10 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 11 !! 4.0 ! 2017-06 (J.M. Molines, T. Lovato) merge of mppini and mppini_2 12 !!---------------------------------------------------------------------- 13 14 !!---------------------------------------------------------------------- 15 !! mpp_init : Lay out the global domain over processors with/without land processor elimination 16 !! mpp_init_mask : 17 !! mpp_init_ioipsl: IOIPSL initialization in mpp 18 !!---------------------------------------------------------------------- 19 USE dom_oce ! ocean space and time domain 20 USE bdy_oce ! open BounDarY 21 ! 22 USE lib_mpp ! distribued memory computing library 23 USE iom ! nemo I/O library 24 USE ioipsl ! I/O IPSL library 25 USE in_out_manager ! I/O Manager 17 26 18 27 IMPLICIT NONE … … 40 49 !! 41 50 !! ** Method : Shared memory computing, set the local processor 42 !! variables to the value of the global domain 43 !! 44 !! History : 45 !! 9.0 ! 04-01 (G. Madec, J.M. Molines) F90 : free form, north fold jpni >1 46 !!---------------------------------------------------------------------- 47 48 ! No mpp computation 49 nimpp = 1 51 !! variables to the value of the global domain 52 !!---------------------------------------------------------------------- 53 ! 54 nimpp = 1 ! 50 55 njmpp = 1 51 56 nlci = jpi … … 60 65 nidom = FLIO_DOM_NONE 61 66 npolj = jperio 62 67 ! 63 68 IF(lwp) THEN 64 69 WRITE(numout,*) 65 WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing' 66 WRITE(numout,*) '~~~~~~~~~~~ ' 67 WRITE(numout,*) ' nperio = ', nperio 68 WRITE(numout,*) ' npolj = ', npolj 69 WRITE(numout,*) ' nimpp = ', nimpp 70 WRITE(numout,*) ' njmpp = ', njmpp 71 ENDIF 72 73 IF( jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) & 74 CALL ctl_stop( 'equality jpni = jpnj = jpnij = 1 is not satisfied', & 75 & 'the domain is lay out for distributed memory computing! ' ) 76 77 IF( jperio == 7 ) CALL ctl_stop( ' jperio = 7 needs distributed memory computing ', & 78 & ' with 1 process. Add key_mpp_mpi in the list of active cpp keys ' ) 70 WRITE(numout,*) 'mpp_init : NO massively parallel processing' 71 WRITE(numout,*) '~~~~~~~~ ' 72 WRITE(numout,*) ' nperio = ', nperio, ' nimpp = ', nimpp 73 WRITE(numout,*) ' npolj = ', npolj , ' njmpp = ', njmpp 74 ENDIF 75 ! 76 IF( jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) & 77 CALL ctl_stop( 'mpp_init: equality jpni = jpnj = jpnij = 1 is not satisfied', & 78 & 'the domain is lay out for distributed memory computing!' ) 79 ! 80 IF( jperio == 7 ) CALL ctl_stop( 'mpp_init: jperio = 7 needs distributed memory computing ', & 81 & 'with 1 process. Add key_mpp_mpi in the list of active cpp keys ' ) 82 ! 79 83 END SUBROUTINE mpp_init 80 84 81 85 #else 82 86 !!---------------------------------------------------------------------- 83 !! 'key_mpp_mpi' ORMPI massively parallel processing87 !! 'key_mpp_mpi' MPI massively parallel processing 84 88 !!---------------------------------------------------------------------- 85 89 … … 92 96 !! presence of the domain configuration file. Land processors elimination 93 97 !! is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP 94 !! preprocessing tool, he kp for defining the best cutting out.98 !! preprocessing tool, help for defining the best cutting out. 95 99 !! 96 100 !! ** Method : Global domain is distributed in smaller local domains. … … 115 119 !! noso : number for local neighboring processor 116 120 !! nono : number for local neighboring processor 117 !! 118 !! History : ! 1994-11 (M. Guyon) Original code 119 !! OPA ! 1995-04 (J. Escobar, M. Imbard) 120 !! ! 1998-02 (M. Guyon) FETI method 121 !! ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 122 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 123 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 124 !! 4.0 ! 2017-06 (J.M. Molines, T. Lovato) merge of mppini and mppini_2 125 !!---------------------------------------------------------------------- 126 !! 127 USE in_out_manager ! I/O Manager 128 !! 129 INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices 130 INTEGER :: inum ! temporary logical unit 131 INTEGER :: idir ! temporary integers 132 INTEGER :: & 133 ii, ij, ifreq, il1, il2, & ! temporary integers 134 icont, ili, ilj, & ! " " 135 isurf, ijm1, imil, & ! " " 136 iino, ijno, iiso, ijso, & ! " " 137 iiea, ijea, iiwe, ijwe, & ! " " 138 iresti, irestj, iproc ! " " 139 INTEGER, DIMENSION(jpnij) :: & 140 iin, ijn 141 INTEGER, DIMENSION(jpni,jpnj) :: & 142 iimppt, ijmppt, ilci , ilcj , & ! temporary workspace 143 ipproc, ibondj, ibondi, ipolj , & ! " " 144 ilei , ilej , ildi , ildj , & ! " " 145 ioea , iowe , ioso , iono ! " " 146 INTEGER, DIMENSION(jpiglo,jpjglo) :: imask ! global workspace 147 REAL(wp) :: zidom , zjdom ! local scalars 148 INTEGER, DIMENSION(jpnij) :: ii_nono, ii_noso, ii_noea, ii_nowe ! jmm used for printing 149 !!---------------------------------------------------------------------- 150 151 IF(lwp)WRITE(numout,*) 152 IF(lwp)WRITE(numout,*) 'mpp_init: Message Passing MPI' 153 IF(lwp)WRITE(numout,*) '~~~~~~~~~~' 154 IF(lwp)WRITE(numout,*) ' ' 155 156 IF ( jpni * jpnj == jpnij ) THEN 157 imask(:,:) = 1 ! no land processor elimination 158 ELSEIF ( jpni*jpnj > jpnij ) THEN 159 CALL mpp_init_mask(imask) ! land processor elimination requires imask=0 on land 160 ELSE 161 CALL ctl_stop( ' jpnij > jpni x jpnj. Check namelist setting!' ) 162 ENDIF 163 121 !!---------------------------------------------------------------------- 122 INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices 123 INTEGER :: inum ! local logical unit 124 INTEGER :: idir, ifreq, icont, isurf ! local integers 125 INTEGER :: ii, il1, ili, imil ! - - 126 INTEGER :: ij, il2, ilj, ijm1 ! - - 127 INTEGER :: iino, ijno, iiso, ijso ! - - 128 INTEGER :: iiea, ijea, iiwe, ijwe ! - - 129 INTEGER :: iresti, irestj, iproc ! - - 130 INTEGER, DIMENSION(jpnij) :: iin, ii_nono, ii_noea ! 1D workspace 131 INTEGER, DIMENSION(jpnij) :: ijn, ii_noso, ii_nowe ! - - 132 INTEGER, DIMENSION(jpni,jpnj) :: iimppt, ilci, ibondi, ipproc ! 2D workspace 133 INTEGER, DIMENSION(jpni,jpnj) :: ijmppt, ilcj, ibondj, ipolj ! - - 134 INTEGER, DIMENSION(jpni,jpnj) :: ilei, ildi, iono, ioea ! - - 135 INTEGER, DIMENSION(jpni,jpnj) :: ilej, ildj, ioso, iowe ! - - 136 INTEGER, DIMENSION(jpiglo,jpjglo) :: imask ! 2D golbal domain workspace 137 REAL(wp) :: zidom, zjdom ! local scalars 138 !!---------------------------------------------------------------------- 139 ! 140 IF ( jpni * jpnj == jpnij ) THEN ! regular domain lay out over processors 141 imask(:,:) = 1 142 ELSEIF ( jpni*jpnj > jpnij ) THEN ! remove land-only processor (i.e. where imask(:,:)=0) 143 CALL mpp_init_mask( imask ) 144 ELSE ! error 145 CALL ctl_stop( 'mpp_init: jpnij > jpni x jpnj. Check namelist setting!' ) 146 ENDIF 147 ! 164 148 ! 1. Dimension arrays for subdomains 165 149 ! ----------------------------------- 166 167 150 ! Computation of local domain sizes ilci() ilcj() 168 151 ! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo 169 ! The subdomains are squares leeser than or equal to the global 170 ! dimensions divided by the number of processors minus the overlap 171 ! array. 172 173 nreci=2*jpreci 174 nrecj=2*jprecj 152 ! The subdomains are squares lesser than or equal to the global 153 ! dimensions divided by the number of processors minus the overlap array. 154 ! 155 nreci = 2 * jpreci 156 nrecj = 2 * jprecj 175 157 iresti = 1 + MOD( jpiglo - nreci -1 , jpni ) 176 158 irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 177 159 ! 178 160 #if defined key_nemocice_decomp 179 161 ! Change padding to be consistent with CICE 180 162 ilci(1:jpni-1 ,:) = jpi 181 163 ilci(jpni ,:) = jpiglo - (jpni - 1) * (jpi - nreci) 182 164 ! 183 165 ilcj(:, 1:jpnj-1) = jpj 184 166 ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) … … 190 172 ilcj(:, irestj+1:jpnj) = jpj-1 191 173 #endif 192 174 ! 193 175 nfilcit(:,:) = ilci(:,:) 194 195 IF(lwp) WRITE(numout,*) 196 IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains' 197 IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------' 198 IF(lwp) WRITE(numout,*) 199 IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj 200 IF(lwp) WRITE(numout,*) 201 IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj 202 203 zidom = nreci + sum(ilci(:,1) - nreci ) 204 IF(lwp) WRITE(numout,*) 205 IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo 206 207 zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 208 IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo 209 IF(lwp) WRITE(numout,*) 210 176 ! 177 zidom = nreci + sum(ilci(:,1) - nreci ) 178 zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 179 ! 180 IF(lwp) THEN 181 WRITE(numout,*) 182 WRITE(numout,*) 'mpp_init : MPI Message Passing MPI - domain lay out over processors' 183 WRITE(numout,*) '~~~~~~~~ ' 184 WRITE(numout,*) ' defines mpp subdomains' 185 WRITE(numout,*) ' iresti = ', iresti, ' jpni = ', jpni 186 WRITE(numout,*) ' irestj = ', irestj, ' jpnj = ', jpnj 187 WRITE(numout,*) 188 WRITE(numout,*) ' sum ilci(i,1) = ', zidom, ' jpiglo = ', jpiglo 189 WRITE(numout,*) ' sum ilcj(1,j) = ', zjdom, ' jpjglo = ', jpjglo 190 ENDIF 211 191 212 192 ! 2. Index arrays for subdomains 213 193 ! ------------------------------- 214 215 iimppt(:,:) = 1 216 ijmppt(:,:) = 1 194 iimppt(:,:) = 1 195 ijmppt(:,:) = 1 217 196 ipproc(:,:) = -1 218 219 IF( jpni > 1 ) THEN197 ! 198 IF( jpni > 1 ) THEN 220 199 DO jj = 1, jpnj 221 200 DO ji = 2, jpni … … 225 204 ENDIF 226 205 nfiimpp(:,:) = iimppt(:,:) 227 206 ! 228 207 IF( jpnj > 1 )THEN 229 208 DO jj = 2, jpnj … … 234 213 ENDIF 235 214 236 237 215 ! 3. Subdomain description in the Regular Case 238 216 ! -------------------------------------------- 239 240 217 nperio = 0 241 218 icont = -1 … … 254 231 IF( jpni == 1 ) ibondi(ii,ij) = 2 255 232 256 ! 2.4 Subdomain neighbors 257 233 ! Subdomain neighbors 258 234 iproc = jarea - 1 259 235 ioso(ii,ij) = iproc - jpni … … 261 237 ioea(ii,ij) = iproc + 1 262 238 iono(ii,ij) = iproc + jpni 263 ildi(ii,ij) = 1+ jpreci264 ilei(ii,ij) = ili - jpreci265 266 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1239 ildi(ii,ij) = 1 + jpreci 240 ilei(ii,ij) = ili - jpreci 241 242 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1 267 243 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili 268 244 ildj(ii,ij) = 1 + jprecj 269 245 ilej(ii,ij) = ilj - jprecj 270 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1246 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 271 247 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj 272 248 … … 302 278 IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour 303 279 ENDIF 304 280 ! 305 281 ! Check wet points over the entire domain to preserve the MPI communication stencil 306 282 isurf = 0 … … 310 286 END DO 311 287 END DO 312 313 IF( isurf /= 0) THEN288 ! 289 IF( isurf /= 0 ) THEN 314 290 icont = icont + 1 315 291 ipproc(ii,ij) = icont … … 318 294 ENDIF 319 295 END DO 320 296 ! 321 297 nfipproc(:,:) = ipproc(:,:) 322 298 323 ! C ontrol324 IF( icont+1 /= jpnij) THEN299 ! Check potential error 300 IF( icont+1 /= jpnij ) THEN 325 301 WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj 326 302 WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 327 303 WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 328 CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )304 CALL ctl_stop( 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 329 305 ENDIF 330 306 331 307 ! 4. Subdomain print 332 308 ! ------------------ 333 334 309 IF(lwp) THEN 335 310 ifreq = 4 336 311 il1 = 1 337 DO jn = 1, (jpni-1)/ifreq+1312 DO jn = 1, (jpni-1)/ifreq+1 338 313 il2 = MIN(jpni,il1+ifreq-1) 339 314 WRITE(numout,*) … … 349 324 il1 = il1+ifreq 350 325 END DO 351 9400 FORMAT(' ***',20('*************',a3)) 352 9403 FORMAT(' * ',20(' * ',a3)) 353 9401 FORMAT(' ',20(' ',i3,' ')) 354 9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ')) 355 9404 FORMAT(' * ',20(' ',i3,' * ')) 356 ENDIF 357 326 9400 FORMAT(' ***',20('*************',a3)) 327 9403 FORMAT(' * ',20(' * ',a3)) 328 9401 FORMAT(' ',20(' ',i3,' ')) 329 9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ')) 330 9404 FORMAT(' * ',20(' ',i3,' * ')) 331 ENDIF 358 332 359 333 ! 5. neighbour treatment 360 334 ! ---------------------- 361 362 335 DO jarea = 1, jpni*jpnj 363 336 iproc = jarea-1 364 ii = 1 + MOD(jarea-1,jpni) 365 ij = 1 + (jarea-1)/jpni 366 IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 & 367 .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN 368 iino = 1 + MOD(iono(ii,ij),jpni) 369 ijno = 1 + (iono(ii,ij))/jpni 370 ! Need to reverse the logical direction of communication 371 ! for northern neighbours of northern row processors (north-fold) 372 ! i.e. need to check that the northern neighbour only communicates 373 ! to the SOUTH (or not at all) if this area is land-only (#1057) 337 ii = 1 + MOD( jarea-1 , jpni ) 338 ij = 1 + (jarea-1) / jpni 339 IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN 340 iino = 1 + MOD( iono(ii,ij) , jpni ) 341 ijno = 1 + iono(ii,ij) / jpni 342 ! Need to reverse the logical direction of communication 343 ! for northern neighbours of northern row processors (north-fold) 344 ! i.e. need to check that the northern neighbour only communicates 345 ! to the SOUTH (or not at all) if this area is land-only (#1057) 374 346 idir = 1 375 IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1 376 IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2 377 IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir 378 ENDIF 379 IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 & 380 .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN 381 iiso = 1 + MOD(ioso(ii,ij),jpni) 382 ijso = 1 + (ioso(ii,ij))/jpni 383 IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 384 IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 385 ENDIF 386 IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 & 387 .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN 388 iiea = 1 + MOD(ioea(ii,ij),jpni) 389 ijea = 1 + (ioea(ii,ij))/jpni 390 IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 391 IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 392 ENDIF 393 IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 & 394 .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN 395 iiwe = 1 + MOD(iowe(ii,ij),jpni) 396 ijwe = 1 + (iowe(ii,ij))/jpni 397 IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 398 IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 347 IF( ij == jpnj .AND. ijno == jpnj ) idir = -1 348 IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno) = 2 349 IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir 350 ENDIF 351 IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN 352 iiso = 1 + MOD( ioso(ii,ij) , jpni ) 353 ijso = 1 + ioso(ii,ij) / jpni 354 IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 355 IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 356 ENDIF 357 IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN 358 iiea = 1 + MOD( ioea(ii,ij) , jpni ) 359 ijea = 1 + ioea(ii,ij) / jpni 360 IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 361 IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 362 ENDIF 363 IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN 364 iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 365 ijwe = 1 + iowe(ii,ij) / jpni 366 IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 367 IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 399 368 ENDIF 400 369 END DO 401 370 402 403 ! just to save nono etc for all proc 404 ii_noso(:) = -1 405 ii_nono(:) = -1 406 ii_noea(:) = -1 407 ii_nowe(:) = -1 408 nproc = narea-1 409 DO jarea = 1, jpnij 410 ii = iin(jarea) 411 ij = ijn(jarea) 412 IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 413 iiso = 1 + MOD(ioso(ii,ij),jpni) 414 ijso = 1 + (ioso(ii,ij))/jpni 415 noso = ipproc(iiso,ijso) 416 ii_noso(jarea)= noso 417 ENDIF 418 IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 419 iiwe = 1 + MOD(iowe(ii,ij),jpni) 420 ijwe = 1 + (iowe(ii,ij))/jpni 371 ! just to save nono etc for all proc 372 ii_noso(:) = -1 373 ii_nono(:) = -1 374 ii_noea(:) = -1 375 ii_nowe(:) = -1 376 nproc = narea-1 377 DO jarea = 1, jpnij 378 ii = iin(jarea) 379 ij = ijn(jarea) 380 IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 381 iiso = 1 + MOD( ioso(ii,ij) , jpni ) 382 ijso = 1 + ioso(ii,ij) / jpni 383 noso = ipproc(iiso,ijso) 384 ii_noso(jarea)= noso 385 ENDIF 386 IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 387 iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 388 ijwe = 1 + iowe(ii,ij) / jpni 421 389 nowe = ipproc(iiwe,ijwe) 422 390 ii_nowe(jarea)= nowe 423 ENDIF 424 IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 425 iiea = 1 + MOD(ioea(ii,ij),jpni) 426 ijea = 1 + (ioea(ii,ij))/jpni 427 noea = ipproc(iiea,ijea) 428 ii_noea(jarea)= noea 429 ENDIF 430 IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 431 iino = 1 + MOD(iono(ii,ij),jpni) 432 ijno = 1 + (iono(ii,ij))/jpni 433 nono = ipproc(iino,ijno) 434 ii_nono(jarea)= nono 435 ENDIF 436 END DO 391 ENDIF 392 IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 393 iiea = 1 + MOD( ioea(ii,ij) , jpni ) 394 ijea = 1 + ioea(ii,ij) / jpni 395 noea = ipproc(iiea,ijea) 396 ii_noea(jarea)= noea 397 ENDIF 398 IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 399 iino = 1 + MOD( iono(ii,ij) , jpni ) 400 ijno = 1 + iono(ii,ij) / jpni 401 nono = ipproc(iino,ijno) 402 ii_nono(jarea)= nono 403 ENDIF 404 END DO 405 437 406 ! 6. Change processor name 438 407 ! ------------------------ 439 440 408 nproc = narea-1 441 409 ii = iin(narea) 442 410 ij = ijn(narea) 443 411 ! 444 412 ! set default neighbours 445 413 noso = ii_noso(narea) … … 477 445 WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 478 446 479 DO jproc = 1, jpnij 480 ii = iin(jproc) 481 ij = ijn(jproc) 482 483 WRITE(inum,'(15i5)') jproc-1, nlcit(jproc), nlcjt(jproc), & 484 nldit(jproc), nldjt(jproc), & 485 nleit(jproc), nlejt(jproc), & 486 nimppt(jproc), njmppt(jproc), & 487 ii_nono(jproc), ii_noso(jproc), & 488 ii_nowe(jproc), ii_noea(jproc), & 489 ibondi(ii,ij), ibondj(ii,ij) 447 DO jproc = 1, jpnij 448 ii = iin(jproc) 449 ij = ijn(jproc) 450 WRITE(inum,'(15i5)') jproc-1, nlcit (jproc), nlcjt (jproc), & 451 & nldit (jproc), nldjt (jproc), & 452 & nleit (jproc), nlejt (jproc), & 453 & nimppt (jproc), njmppt (jproc), & 454 & ii_nono(jproc), ii_noso(jproc), & 455 & ii_nowe(jproc), ii_noea(jproc), & 456 & ibondi (ii,ij), ibondj (ii,ij) 490 457 END DO 491 458 CLOSE(inum) 492 459 END IF 493 460 461 ! ! north fold parameter 494 462 ! Defined npolj, either 0, 3 , 4 , 5 , 6 495 463 ! In this case the important thing is that npolj /= 0 496 464 ! Because if we go through these line it is because jpni >1 and thus 497 465 ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0 498 499 466 npolj = 0 500 467 ij = ijn(narea) 501 502 468 IF( jperio == 3 .OR. jperio == 4 ) THEN 503 IF( ij == jpnj ) npolj = 3 504 ENDIF 505 469 IF( ij == jpnj ) npolj = 3 470 ENDIF 506 471 IF( jperio == 5 .OR. jperio == 6 ) THEN 507 IF( ij == jpnj ) npolj = 5 508 ENDIF 509 510 ! Periodicity : no corner if nbondi = 2 and nperio != 1 511 472 IF( ij == jpnj ) npolj = 5 473 ENDIF 474 ! 512 475 IF(lwp) THEN 476 WRITE(numout,*) 513 477 WRITE(numout,*) ' nproc = ', nproc 514 478 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea … … 526 490 WRITE(numout,*) ' jpreci = ', jpreci 527 491 WRITE(numout,*) ' jprecj = ', jprecj 528 WRITE(numout,*) 529 ENDIF 530 531 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 532 533 ! Prepare mpp north fold 534 492 ENDIF 493 494 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' ) 495 496 ! ! Prepare mpp north fold 535 497 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 536 498 CALL mpp_ini_north 537 499 IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1' 538 500 ENDIF 539 540 ! Prepare NetCDF output file (if necessary) 541 CALL mpp_init_ioipsl 542 543 501 ! 502 CALL mpp_init_ioipsl ! Prepare NetCDF output file (if necessary) 503 ! 544 504 END SUBROUTINE mpp_init 545 505 546 SUBROUTINE mpp_init_mask(kmask) 506 507 SUBROUTINE mpp_init_mask( kmask ) 547 508 !!---------------------------------------------------------------------- 548 509 !! *** ROUTINE mpp_init_mask *** … … 555 516 !! in order to choose the correct bathymetric information 556 517 !! (file and variables) 557 !! 558 !! History : 559 !! 4.0 ! 17-06 (J.M. Molines) from mpp_init_2 to unified mppini 560 !!---------------------------------------------------------------------- 561 USE bdy_oce 562 !! 563 INTEGER, DIMENSION(jpiglo,jpjglo), INTENT(out) :: kmask 518 !!---------------------------------------------------------------------- 519 INTEGER, DIMENSION(jpiglo,jpjglo), INTENT(out) :: kmask ! global domain 564 520 565 521 INTEGER :: inum !: logical unit for configuration file … … 586 542 ! 587 543 ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise) 588 WHERE( zbot(:,:) > 0 ) 589 ELSEWHERE 544 WHERE( zbot(:,:) > 0 ) ; kmask(:,:) = 1 545 ELSEWHERE ; kmask(:,:) = 0 590 546 END WHERE 591 547 592 ! Adjust kmask with bdy_msk if exists548 ! Adjust kmask with bdy_msk if it exists 593 549 594 550 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist : BDY … … 602 558 IF( ln_bdy .AND. ln_mask_file ) THEN 603 559 CALL iom_open( cn_mask_file, inum ) 604 CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy )560 CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy ) 605 561 CALL iom_close( inum ) 606 562 WHERE ( zbdy(:,:) <= 0. ) kmask = 0 607 563 ENDIF 608 564 ! 609 565 END SUBROUTINE mpp_init_mask 566 610 567 611 568 SUBROUTINE mpp_init_ioipsl
Note: See TracChangeset
for help on using the changeset viewer.
