Changeset 8219
- Timestamp:
- 2017-06-26T16:29:53+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM
- Files:
-
- 1 deleted
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r7761 r8219 66 66 67 67 !!---------------------------------------------------------------------- 68 !! NEMO/O FF 3.3 , NEMO Consortium (2010)68 !! NEMO/OPA 3.7 , NEMO Consortium (2016) 69 69 !! $Id$ 70 70 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 286 286 287 287 ! ! Domain decomposition 288 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 289 ELSE ; CALL mpp_init2 ! eliminate land processors 290 ENDIF 288 CALL mpp_init 291 289 ! 292 290 IF( nn_timing == 1 ) CALL timing_init -
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r7914 r8219 90 90 INTEGER, PUBLIC :: noea, nowe !: index of the local neighboring processors in 91 91 INTEGER, PUBLIC :: noso, nono !: east, west, south and north directions 92 INTEGER, PUBLIC :: npne, npnw !: index of north east and north west processor93 INTEGER, PUBLIC :: npse, npsw !: index of south east and south west processor94 INTEGER, PUBLIC :: nbne, nbnw !: logical of north east & north west processor95 INTEGER, PUBLIC :: nbse, nbsw !: logical of south east & south west processor96 92 INTEGER, PUBLIC :: nidom !: ??? 97 93 -
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r7646 r8219 6 6 7 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 8 !! mpp_init : Lay out the global domain over processors 9 !! with/without land processor elimination 11 10 !! mpp_init_ioispl: IOIPSL initialization in mpp 12 11 !!---------------------------------------------------------------------- … … 15 14 USE lib_mpp ! distribued memory computing library 16 15 USE ioipsl 16 USE iom 17 17 18 18 IMPLICIT NONE … … 20 20 21 21 PUBLIC mpp_init ! called by opa.F90 22 PUBLIC mpp_init2 ! called by opa.F90 23 24 !!---------------------------------------------------------------------- 25 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 22 23 !!---------------------------------------------------------------------- 24 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 26 25 !! $Id$ 27 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 80 79 END SUBROUTINE mpp_init 81 80 82 83 SUBROUTINE mpp_init284 CALL mpp_init ! same routine as mpp_init85 END SUBROUTINE mpp_init286 87 81 #else 88 82 !!---------------------------------------------------------------------- … … 95 89 !! 96 90 !! ** Purpose : Lay out the global domain over processors. 91 !! If land processors are to be eliminated, this program requires the 92 !! presence of the domain configuration file. Land processors elimination 93 !! is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP 94 !! preprocessing tool, hekp for defining the best cutting out. 97 95 !! 98 96 !! ** Method : Global domain is distributed in smaller local domains. … … 103 101 !! nperio local periodic condition 104 102 !! 105 !! ** Action 103 !! ** Action : - set domain parameters 106 104 !! nimpp : longitudinal index 107 105 !! njmpp : latitudinal index … … 118 116 !! nono : number for local neighboring processor 119 117 !! 120 !! History : 121 !! ! 94-11 (M. Guyon) Original code 122 !! ! 95-04 (J. Escobar, M. Imbard) 123 !! ! 98-02 (M. Guyon) FETI method 124 !! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 125 !! 8.5 ! 02-08 (G. Madec) F90 : free form 126 !! 3.4 ! 11-11 (C. Harris) decomposition changes for running with CICE 127 !!---------------------------------------------------------------------- 128 INTEGER :: ji, jj, jn ! dummy loop indices 129 INTEGER :: ii, ij, ifreq, il1, il2 ! local integers 130 INTEGER :: iresti, irestj, ijm1, imil, inum ! - - 131 REAL(wp) :: zidom, zjdom ! local scalars 132 INTEGER, DIMENSION(jpni,jpnj) :: iimppt, ijmppt, ilcit, ilcjt ! local workspace 133 !!---------------------------------------------------------------------- 134 135 IF(lwp) WRITE(numout,*) 136 IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI' 137 IF(lwp) WRITE(numout,*) '~~~~~~~~' 138 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 139 163 140 164 ! 1. Dimension arrays for subdomains 141 165 ! ----------------------------------- 142 ! Computation of local domain sizes ilcit() ilcjt() 166 167 ! Computation of local domain sizes ilci() ilcj() 143 168 ! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo 144 169 ! The subdomains are squares leeser than or equal to the global 145 170 ! dimensions divided by the number of processors minus the overlap 146 ! array (cf. par_oce.F90). 147 148 nreci = 2 * jpreci 149 nrecj = 2 * jprecj 150 iresti = MOD( jpiglo - nreci , jpni ) 151 irestj = MOD( jpjglo - nrecj , jpnj ) 152 153 IF( iresti == 0 ) iresti = jpni 171 ! array. 172 173 nreci=2*jpreci 174 nrecj=2*jprecj 175 iresti = 1 + MOD( jpiglo - nreci -1 , jpni ) 176 irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 154 177 155 178 #if defined key_nemocice_decomp 156 ! In order to match CICE the size of domains in NEMO has to be changed 157 ! The last line of blocks (west) will have fewer points 158 159 DO jj = 1, jpnj 160 DO ji=1, jpni-1 161 ilcit(ji,jj) = jpi 162 END DO 163 ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci) 164 END DO 165 179 ! Change padding to be consistent with CICE 180 ilci(1:jpni-1 ,:) = jpi 181 ilci(jpni ,:) = jpiglo - (jpni - 1) * (jpi - nreci) 182 183 ilcj(:, 1:jpnj-1) = jpj 184 ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 166 185 #else 167 168 DO jj = 1, jpnj 169 DO ji = 1, iresti 170 ilcit(ji,jj) = jpi 171 END DO 172 DO ji = iresti+1, jpni 173 ilcit(ji,jj) = jpi -1 174 END DO 175 END DO 176 186 ilci(1:iresti ,:) = jpi 187 ilci(iresti+1:jpni ,:) = jpi-1 188 189 ilcj(:, 1:irestj) = jpj 190 ilcj(:, irestj+1:jpnj) = jpj-1 177 191 #endif 178 nfilcit(:,:) = ilcit(:,:) 179 IF( irestj == 0 ) irestj = jpnj 180 181 #if defined key_nemocice_decomp 182 ! Same change to domains in North-South direction as in East-West. 183 DO ji=1,jpni 184 DO jj=1,jpnj-1 185 ilcjt(ji,jj) = jpj 186 END DO 187 ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 188 END DO 189 190 #else 191 192 DO ji = 1, jpni 193 DO jj = 1, irestj 194 ilcjt(ji,jj) = jpj 195 END DO 196 DO jj = irestj+1, jpnj 197 ilcjt(ji,jj) = jpj -1 198 END DO 199 END DO 200 201 #endif 192 193 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 202 211 203 212 ! 2. Index arrays for subdomains 204 213 ! ------------------------------- 205 214 206 215 iimppt(:,:) = 1 207 216 ijmppt(:,:) = 1 208 209 IF( jpni > 1 ) THEN 217 ipproc(:,:) = -1 218 219 IF( jpni > 1 )THEN 210 220 DO jj = 1, jpnj 211 221 DO ji = 2, jpni 212 iimppt(ji,jj) = iimppt(ji-1,jj) + ilci t(ji-1,jj) - nreci222 iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci 213 223 END DO 214 224 END DO 215 225 ENDIF 216 nfiimpp(:,:) =iimppt(:,:)217 218 IF( jpnj > 1 ) 226 nfiimpp(:,:) = iimppt(:,:) 227 228 IF( jpnj > 1 )THEN 219 229 DO jj = 2, jpnj 220 230 DO ji = 1, jpni 221 ijmppt(ji,jj) = ijmppt(ji,jj-1) +ilcjt(ji,jj-1)-nrecj231 ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj 222 232 END DO 223 233 END DO 224 234 ENDIF 225 226 ! 3. Subdomain description 227 ! ------------------------ 228 229 DO jn = 1, jpnij 230 ii = 1 + MOD( jn-1, jpni ) 231 ij = 1 + (jn-1) / jpni 232 nfipproc(ii,ij) = jn - 1 233 nimppt(jn) = iimppt(ii,ij) 234 njmppt(jn) = ijmppt(ii,ij) 235 nlcit (jn) = ilcit (ii,ij) 236 nlci = nlcit (jn) 237 nlcjt (jn) = ilcjt (ii,ij) 238 nlcj = nlcjt (jn) 239 nbondj = -1 ! general case 240 IF( jn > jpni ) nbondj = 0 ! first row of processor 241 IF( jn > (jpnj-1)*jpni ) nbondj = 1 ! last row of processor 242 IF( jpnj == 1 ) nbondj = 2 ! one processor only in j-direction 243 ibonjt(jn) = nbondj 244 245 nbondi = 0 ! 246 IF( MOD( jn, jpni ) == 1 ) nbondi = -1 ! 247 IF( MOD( jn, jpni ) == 0 ) nbondi = 1 ! 248 IF( jpni == 1 ) nbondi = 2 ! one processor only in i-direction 249 ibonit(jn) = nbondi 250 251 nldi = 1 + jpreci 252 nlei = nlci - jpreci 253 IF( nbondi == -1 .OR. nbondi == 2 ) nldi = 1 254 IF( nbondi == 1 .OR. nbondi == 2 ) nlei = nlci 255 nldj = 1 + jprecj 256 nlej = nlcj - jprecj 257 IF( nbondj == -1 .OR. nbondj == 2 ) nldj = 1 258 IF( nbondj == 1 .OR. nbondj == 2 ) nlej = nlcj 259 nldit(jn) = nldi 260 nleit(jn) = nlei 261 nldjt(jn) = nldj 262 nlejt(jn) = nlej 235 236 237 ! 3. Subdomain description in the Regular Case 238 ! -------------------------------------------- 239 240 nperio = 0 241 icont = -1 242 DO jarea = 1, jpni*jpnj 243 ii = 1 + MOD(jarea-1,jpni) 244 ij = 1 + (jarea-1)/jpni 245 ili = ilci(ii,ij) 246 ilj = ilcj(ii,ij) 247 ibondj(ii,ij) = -1 248 IF( jarea > jpni ) ibondj(ii,ij) = 0 249 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1 250 IF( jpnj == 1 ) ibondj(ii,ij) = 2 251 ibondi(ii,ij) = 0 252 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 253 IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1 254 IF( jpni == 1 ) ibondi(ii,ij) = 2 255 256 ! 2.4 Subdomain neighbors 257 258 iproc = jarea - 1 259 ioso(ii,ij) = iproc - jpni 260 iowe(ii,ij) = iproc - 1 261 ioea(ii,ij) = iproc + 1 262 iono(ii,ij) = iproc + jpni 263 ildi(ii,ij) = 1 + jpreci 264 ilei(ii,ij) = ili -jpreci 265 266 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1 267 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili 268 ildj(ii,ij) = 1 + jprecj 269 ilej(ii,ij) = ilj - jprecj 270 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 271 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj 272 273 ! warning ii*ij (zone) /= nproc (processors)! 274 275 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 276 IF( jpni == 1 )THEN 277 ibondi(ii,ij) = 2 278 nperio = 1 279 ELSE 280 ibondi(ii,ij) = 0 281 ENDIF 282 IF( MOD(jarea,jpni) == 0 ) THEN 283 ioea(ii,ij) = iproc - (jpni-1) 284 ENDIF 285 IF( MOD(jarea,jpni) == 1 ) THEN 286 iowe(ii,ij) = iproc + jpni - 1 287 ENDIF 288 ENDIF 289 ipolj(ii,ij) = 0 290 IF( jperio == 3 .OR. jperio == 4 ) THEN 291 ijm1 = jpni*(jpnj-1) 292 imil = ijm1+(jpni+1)/2 293 IF( jarea > ijm1 ) ipolj(ii,ij) = 3 294 IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4 295 IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour 296 ENDIF 297 IF( jperio == 5 .OR. jperio == 6 ) THEN 298 ijm1 = jpni*(jpnj-1) 299 imil = ijm1+(jpni+1)/2 300 IF( jarea > ijm1) ipolj(ii,ij) = 5 301 IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6 302 IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour 303 ENDIF 304 305 ! Check wet points over the entire domain to preserve the MPI communication stencil 306 isurf = 0 307 DO jj = 1, ilj 308 DO ji = 1, ili 309 IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 310 END DO 311 END DO 312 313 IF(isurf /= 0) THEN 314 icont = icont + 1 315 ipproc(ii,ij) = icont 316 iin(icont+1) = ii 317 ijn(icont+1) = ij 318 ENDIF 263 319 END DO 320 321 nfipproc(:,:) = ipproc(:,:) 322 323 ! Control 324 IF(icont+1 /= jpnij) THEN 325 WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj 326 WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 327 WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 328 CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 329 ENDIF 264 330 265 331 ! 4. Subdomain print 266 332 ! ------------------ 267 268 IF(lwp) WRITE(numout,*)269 IF(lwp) WRITE(numout,*) ' defines mpp subdomains'270 IF(lwp) WRITE(numout,*) ' jpni=', jpni, ' iresti=', iresti271 IF(lwp) WRITE(numout,*) ' jpnj=', jpnj, ' irestj=', irestj272 zidom = nreci273 DO ji = 1, jpni274 zidom = zidom + ilcit(ji,1) - nreci275 END DO276 IF(lwp) WRITE(numout,*)277 IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo278 279 zjdom = nrecj280 DO jj = 1, jpnj281 zjdom = zjdom + ilcjt(1,jj) - nrecj282 END DO283 IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo284 333 285 334 IF(lwp) THEN 286 335 ifreq = 4 287 il1 288 DO jn = 1, 289 il2 = MIN( jpni, il1+ifreq-1)336 il1 = 1 337 DO jn = 1,(jpni-1)/ifreq+1 338 il2 = MIN(jpni,il1+ifreq-1) 290 339 WRITE(numout,*) 291 WRITE(numout,9 200) ('***',ji =il1,il2-1)340 WRITE(numout,9400) ('***',ji=il1,il2-1) 292 341 DO jj = jpnj, 1, -1 293 WRITE(numout,9 203) (' ',ji =il1,il2-1)294 WRITE(numout,9 202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2)295 WRITE(numout,9 204) (nfipproc(ji,jj),ji=il1,il2)296 WRITE(numout,9 203) (' ',ji =il1,il2-1)297 WRITE(numout,9 200) ('***',ji =il1,il2-1)342 WRITE(numout,9403) (' ',ji=il1,il2-1) 343 WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2) 344 WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2) 345 WRITE(numout,9403) (' ',ji=il1,il2-1) 346 WRITE(numout,9400) ('***',ji=il1,il2-1) 298 347 END DO 299 WRITE(numout,9 201) (ji,ji =il1,il2)348 WRITE(numout,9401) (ji,ji=il1,il2) 300 349 il1 = il1+ifreq 301 350 END DO 302 9200 FORMAT(' ***',20('*************',a3)) 303 9203 FORMAT(' * ',20(' * ',a3)) 304 9201 FORMAT(' ',20(' ',i3,' ')) 305 9202 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ')) 306 9204 FORMAT(' * ',20(' ',i3,' * ')) 307 ENDIF 308 309 ! 5. From global to local 310 ! ----------------------- 311 312 nperio = 0 313 IF( jperio == 2 .AND. nbondj == -1 ) nperio = 2 314 315 316 ! 6. Subdomain neighbours 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 358 359 ! 5. neighbour treatment 317 360 ! ---------------------- 318 361 319 nproc = narea - 1 320 noso = nproc - jpni 321 nowe = nproc - 1 322 noea = nproc + 1 323 nono = nproc + jpni 324 ! great neighbours 325 npnw = nono - 1 326 npne = nono + 1 327 npsw = noso - 1 328 npse = noso + 1 329 nbsw = 1 330 nbnw = 1 331 IF( MOD( nproc, jpni ) == 0 ) THEN 332 nbsw = 0 333 nbnw = 0 334 ENDIF 335 nbse = 1 336 nbne = 1 337 IF( MOD( nproc, jpni ) == jpni-1 ) THEN 338 nbse = 0 339 nbne = 0 340 ENDIF 341 IF(nproc < jpni) THEN 342 nbsw = 0 343 nbse = 0 344 ENDIF 345 IF( nproc >= (jpnj-1)*jpni ) THEN 346 nbnw = 0 347 nbne = 0 348 ENDIF 349 nlcj = nlcjt(narea) 350 nlci = nlcit(narea) 351 nldi = nldit(narea) 352 nlei = nleit(narea) 353 nldj = nldjt(narea) 354 nlej = nlejt(narea) 355 nbondi = ibonit(narea) 356 nbondj = ibonjt(narea) 357 nimpp = nimppt(narea) 358 njmpp = njmppt(narea) 359 360 ! Save processor layout in layout.dat file 361 IF(lwp) THEN 362 DO jarea = 1, jpni*jpnj 363 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) 374 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 399 ENDIF 400 END DO 401 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 421 nowe = ipproc(iiwe,ijwe) 422 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 437 ! 6. Change processor name 438 ! ------------------------ 439 440 nproc = narea-1 441 ii = iin(narea) 442 ij = ijn(narea) 443 444 ! set default neighbours 445 noso = ii_noso(narea) 446 nowe = ii_nowe(narea) 447 noea = ii_noea(narea) 448 nono = ii_nono(narea) 449 nlcj = ilcj(ii,ij) 450 nlci = ilci(ii,ij) 451 nldi = ildi(ii,ij) 452 nlei = ilei(ii,ij) 453 nldj = ildj(ii,ij) 454 nlej = ilej(ii,ij) 455 nbondi = ibondi(ii,ij) 456 nbondj = ibondj(ii,ij) 457 nimpp = iimppt(ii,ij) 458 njmpp = ijmppt(ii,ij) 459 DO jproc = 1, jpnij 460 ii = iin(jproc) 461 ij = ijn(jproc) 462 nimppt(jproc) = iimppt(ii,ij) 463 njmppt(jproc) = ijmppt(ii,ij) 464 nlcjt(jproc) = ilcj(ii,ij) 465 nlcit(jproc) = ilci(ii,ij) 466 nldit(jproc) = ildi(ii,ij) 467 nleit(jproc) = ilei(ii,ij) 468 nldjt(jproc) = ildj(ii,ij) 469 nlejt(jproc) = ilej(ii,ij) 470 END DO 471 472 ! Save processor layout in ascii file 473 IF (lwp) THEN 362 474 CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 363 475 WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo' 364 476 WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 365 WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 366 ! 367 DO jn = 1, jpnij 368 WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), & 369 & nldit(jn), nldjt(jn), & 370 & nleit(jn), nlejt(jn), & 371 & nimppt(jn), njmppt(jn) 477 WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 478 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) 372 490 END DO 373 491 CLOSE(inum) 374 492 END IF 375 493 376 ! w a r n i n g narea (zone) /= nproc (processors)! 377 378 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 379 IF( jpni == 1 )THEN 380 nbondi = 2 381 nperio = 1 382 ELSE 383 nbondi = 0 384 ENDIF 385 IF( MOD( narea, jpni ) == 0 ) THEN 386 noea = nproc-(jpni-1) 387 npne = npne-jpni 388 npse = npse-jpni 389 ENDIF 390 IF( MOD( narea, jpni ) == 1 ) THEN 391 nowe = nproc+(jpni-1) 392 npnw = npnw+jpni 393 npsw = npsw+jpni 394 ENDIF 395 nbsw = 1 396 nbnw = 1 397 nbse = 1 398 nbne = 1 399 IF( nproc < jpni ) THEN 400 nbsw = 0 401 nbse = 0 402 ENDIF 403 IF( nproc >= (jpnj-1)*jpni ) THEN 404 nbnw = 0 405 nbne = 0 406 ENDIF 407 ENDIF 494 ! Defined npolj, either 0, 3 , 4 , 5 , 6 495 ! In this case the important thing is that npolj /= 0 496 ! Because if we go through these line it is because jpni >1 and thus 497 ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0 498 408 499 npolj = 0 500 ij = ijn(narea) 501 409 502 IF( jperio == 3 .OR. jperio == 4 ) THEN 410 ijm1 = jpni*(jpnj-1) 411 imil = ijm1+(jpni+1)/2 412 IF( narea > ijm1 ) npolj = 3 413 IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4 414 IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1 415 ENDIF 503 IF( ij == jpnj ) npolj = 3 504 ENDIF 505 416 506 IF( jperio == 5 .OR. jperio == 6 ) THEN 417 ijm1 = jpni*(jpnj-1) 418 imil = ijm1+(jpni+1)/2 419 IF( narea > ijm1) npolj = 5 420 IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6 421 IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1 507 IF( ij == jpnj ) npolj = 5 422 508 ENDIF 423 509 … … 425 511 426 512 IF(lwp) THEN 427 WRITE(numout,*) ' nproc = ', nproc 428 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 429 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 430 WRITE(numout,*) ' nbondi = ', nbondi, ' nbondj = ', nbondj 431 WRITE(numout,*) ' npolj = ', npolj 432 WRITE(numout,*) ' nperio = ', nperio 433 WRITE(numout,*) ' nlci = ', nlci , ' nlcj = ', nlcj 434 WRITE(numout,*) ' nimpp = ', nimpp , ' njmpp = ', njmpp 435 WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse 436 WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw 437 WRITE(numout,*) ' jpreci = ', jpreci, ' npne = ', npne 438 WRITE(numout,*) ' jprecj = ', jprecj, ' npnw = ', npnw 513 WRITE(numout,*) ' nproc = ', nproc 514 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 515 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 516 WRITE(numout,*) ' nbondi = ', nbondi 517 WRITE(numout,*) ' nbondj = ', nbondj 518 WRITE(numout,*) ' npolj = ', npolj 519 WRITE(numout,*) ' nperio = ', nperio 520 WRITE(numout,*) ' nlci = ', nlci 521 WRITE(numout,*) ' nlcj = ', nlcj 522 WRITE(numout,*) ' nimpp = ', nimpp 523 WRITE(numout,*) ' njmpp = ', njmpp 524 WRITE(numout,*) ' nreci = ', nreci 525 WRITE(numout,*) ' nrecj = ', nrecj 526 WRITE(numout,*) ' jpreci = ', jpreci 527 WRITE(numout,*) ' jprecj = ', jprecj 439 528 WRITE(numout,*) 440 529 ENDIF 441 530 442 IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) &443 & CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' )444 531 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 445 532 … … 454 541 CALL mpp_init_ioipsl 455 542 456 END SUBROUTINE mpp_init 457 458 # include "mppini_2.h90" 543 544 END SUBROUTINE mpp_init 545 546 SUBROUTINE mpp_init_mask(kmask) 547 !!---------------------------------------------------------------------- 548 !! *** ROUTINE mpp_init_mask *** 549 !! 550 !! ** Purpose : Read relevant bathymetric information in a global array 551 !! in order to provide a land/sea mask used for the elimination 552 !! of land domains, in an mpp computation. 553 !! 554 !! ** Method : Read the namelist ln_zco and ln_isfcav in namelist namzgr 555 !! in order to choose the correct bathymetric information 556 !! (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 564 565 INTEGER :: inum !: logical unit for configuration file 566 INTEGER :: ios !: iostat error flag 567 INTEGER :: ijstartrow ! temporary integers 568 REAL(wp), DIMENSION(jpiglo,jpjglo) :: zbot, zbdy ! global workspace 569 REAL(wp) :: zidom , zjdom ! local scalars 570 NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, & 571 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & 572 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 573 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 574 & cn_ice_lim, nn_ice_lim_dta, & 575 & rn_ice_tem, rn_ice_sal, rn_ice_age, & 576 & ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 577 !!---------------------------------------------------------------------- 578 ! 0. initialisation 579 ! ----------------- 580 CALL iom_open( cn_domcfg, inum ) 581 ! 582 ! ocean bottom level 583 CALL iom_get( inum, jpdom_unknown, 'bottom_level' , zbot , lrowattr=ln_use_jattr ) ! nb of ocean T-points 584 ! 585 CALL iom_close( inum ) 586 ! 587 ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise) 588 WHERE( zbot(:,:) > 0 ) ; kmask(:,:) = 1 589 ELSEWHERE ; kmask(:,:) = 0 590 END WHERE 591 592 ! Adjust kmask with bdy_msk if exists 593 594 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist : BDY 595 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 596 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp ) 597 598 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist : BDY 599 READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 600 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp ) 601 602 IF( ln_bdy .AND. ln_mask_file ) THEN 603 CALL iom_open( cn_mask_file, inum ) 604 CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy) 605 CALL iom_close( inum ) 606 WHERE ( zbdy(:,:) <= 0. ) kmask = 0 607 ENDIF 608 609 END SUBROUTINE mpp_init_mask 459 610 460 611 SUBROUTINE mpp_init_ioipsl -
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r7761 r8219 413 413 414 414 ! ! Domain decomposition 415 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 416 ELSE ; CALL mpp_init2 ! eliminate land processors 417 ENDIF 415 CALL mpp_init 418 416 ! 419 417 IF( nn_timing == 1 ) CALL timing_init -
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90
r7646 r8219 262 262 263 263 ! ! Domain decomposition 264 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 265 ELSE ; CALL mpp_init2 ! eliminate land processors 266 ENDIF 264 CALL mpp_init 267 265 ! 268 266 IF( nn_timing == 1 ) CALL timing_init -
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r7761 r8219 349 349 350 350 ! ! Domain decomposition 351 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 352 ELSE ; CALL mpp_init2 ! eliminate land processors 353 ENDIF 351 CALL mpp_init 354 352 ! 355 353 IF( nn_timing == 1 ) CALL timing_init -
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/SETTE/sette.sh
r7756 r8219 661 661 export TEST_NAME="LONG" 662 662 cd ${CONFIG_DIR0} 663 . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_tide"del_key ${DEL_KEYS}663 . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 del_key ${DEL_KEYS} 664 664 cd ${SETTE_DIR} 665 665 . ./param.cfg
Note: See TracChangeset
for help on using the changeset viewer.