Changeset 8375 for branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO
 Timestamp:
 20170726T14:30:01+02:00 (4 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 ! 199411 (M. Guyon) Original code 7 !! OPA 7.0 ! 199504 (J. Escobar, M. Imbard) 8 !! 8.0 ! 199805 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 9 !! NEMO 1.0 ! 200401 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 10 !! 4.0 ! 201606 (G. Madec) use domain configuration file instead of bathymetry file 11 !! 4.0 ! 201706 (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 ! 0401 (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 : ! 199411 (M. Guyon) Original code 119 !! OPA ! 199504 (J. Escobar, M. Imbard) 120 !! ! 199802 (M. Guyon) FETI method 121 !! ! 199805 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 122 !! NEMO 1.0 ! 200401 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 123 !! 4.0 ! 201606 (G. Madec) use domain configuration file instead of bathymetry file 124 !! 4.0 ! 201706 (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 landonly 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:jpni1 ,:) = jpi 181 163 ilci(jpni ,:) = jpiglo  (jpni  1) * (jpi  nreci) 182 164 ! 183 165 ilcj(:, 1:jpnj1) = jpj 184 166 ilcj(:, jpnj) = jpjglo  (jpnj  1) * (jpj  nrecj) … … 190 172 ilcj(:, irestj+1:jpnj) = jpj1 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*jpnjjarea+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, (jpni1)/ifreq+1312 DO jn = 1, (jpni1)/ifreq+1 338 313 il2 = MIN(jpni,il1+ifreq1) 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 = jarea1 364 ii = 1 + MOD(jarea1,jpni) 365 ij = 1 + (jarea1)/jpni 366 IF( ipproc(ii,ij) == 1 .AND. iono(ii,ij) >= 0 & 367 .AND. iono(ii,ij) <= jpni*jpnj1 ) 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 (northfold) 372 ! i.e. need to check that the northern neighbour only communicates 373 ! to the SOUTH (or not at all) if this area is landonly (#1057) 337 ii = 1 + MOD( jarea1 , jpni ) 338 ij = 1 + (jarea1) / jpni 339 IF ( ipproc(ii,ij) == 1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj1 ) 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 (northfold) 344 ! i.e. need to check that the northern neighbour only communicates 345 ! to the SOUTH (or not at all) if this area is landonly (#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*jpnj1 ) 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*jpnj1) 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*jpnj1) 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*jpnj1 ) 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*jpnj1 ) 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*jpnj1) 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 = narea1 409 DO jarea = 1, jpnij 410 ii = iin(jarea) 411 ij = ijn(jarea) 412 IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj1) ) 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*jpnj1) ) 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 = narea1 377 DO jarea = 1, jpnij 378 ii = iin(jarea) 379 ij = ijn(jarea) 380 IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj1) ) 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*jpnj1) ) 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*jpnj1) ) 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*jpnj1) ) 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*jpnj1) ) 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*jpnj1) ) 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 = narea1 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)') jproc1, 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)') jproc1, 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 ! 1706 (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.