- Timestamp:
- 2020-04-23T15:14:45+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/prtctl.F90
r12377 r12807 18 18 19 19 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: numid 20 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: n lditl , nldjtl! first, last indoor index for each i-domain21 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: n leitl , nlejtl! first, last indoor index for each j-domain22 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nimpptl,njmpptl ! i-, j-indexes for each processor23 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nlcitl , nlcjtl! dimensions of every subdomain24 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: ibonitl,ibonjtl !20 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nis0allp, njs0allp ! first, last indoor index for each i-domain 21 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nie0allp, nje0allp ! first, last indoor index for each j-domain 22 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nimpptl, njmpptl ! i-, j-indexes for each processor 23 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: jpiallp, jpjallp ! dimensions of every subdomain 24 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: ibonitl, ibonjtl ! 25 25 26 26 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: t_ctll , s_ctll ! previous tracer trend values … … 134 134 IF( .NOT. lsp_area ) THEN 135 135 IF (lk_mpp .AND. jpnij > 1) THEN 136 nictls = MAX( 1, n lditl(jn) )137 nictle = MIN(jpi, n leitl(jn) )138 njctls = MAX( 1, n ldjtl(jn) )139 njctle = MIN(jpj, n lejtl(jn) )136 nictls = MAX( 1, nis0allp(jn) ) 137 nictle = MIN(jpi, nie0allp(jn) ) 138 njctls = MAX( 1, njs0allp(jn) ) 139 njctle = MIN(jpj, nje0allp(jn) ) 140 140 ! Do not take into account the bound of the domain 141 141 IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 142 142 IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 143 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, n leitl(jn) - 1)144 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, n lejtl(jn) - 1)143 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nie0allp(jn) - 1) 144 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nje0allp(jn) - 1) 145 145 ELSE 146 nictls = MAX( 1, nimpptl(jn) - 1 + n lditl(jn) )147 nictle = MIN(jpi, nimpptl(jn) - 1 + n leitl(jn) )148 njctls = MAX( 1, njmpptl(jn) - 1 + n ldjtl(jn) )149 njctle = MIN(jpj, njmpptl(jn) - 1 + n lejtl(jn) )146 nictls = MAX( 1, nimpptl(jn) - 1 + nis0allp(jn) ) 147 nictle = MIN(jpi, nimpptl(jn) - 1 + nie0allp(jn) ) 148 njctls = MAX( 1, njmpptl(jn) - 1 + njs0allp(jn) ) 149 njctle = MIN(jpj, njmpptl(jn) - 1 + nje0allp(jn) ) 150 150 ! Do not take into account the bound of the domain 151 151 IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 152 152 IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 153 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + n leitl(jn) - 2)154 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + n lejtl(jn) - 2)153 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nie0allp(jn) - 2) 154 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nje0allp(jn) - 2) 155 155 ENDIF 156 156 ENDIF … … 277 277 278 278 ! Allocate arrays 279 ALLOCATE( n lditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) , &280 & n ldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) , &281 & nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll(ijsplt) , &282 & nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll(ijsplt) )279 ALLOCATE( nis0allp(ijsplt) , nie0allp(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) , & 280 & njs0allp(ijsplt) , nje0allp(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) , & 281 & jpiallp(ijsplt) , t_ctll(ijsplt) , u_ctll(ijsplt) , & 282 & jpjallp(ijsplt) , s_ctll(ijsplt) , v_ctll(ijsplt) ) 283 283 284 284 ! Initialization … … 295 295 cl_run = 'MULTI processor run' 296 296 ! use indices for each area computed by mpp_init subroutine 297 n lditl(1:jpnij) = nldit(:)298 n leitl(1:jpnij) = nleit(:)299 n ldjtl(1:jpnij) = nldjt(:)300 n lejtl(1:jpnij) = nlejt(:)297 nis0allp(1:jpnij) = nis0all(:) 298 nie0allp(1:jpnij) = nie0all(:) 299 njs0allp(1:jpnij) = njs0all(:) 300 nje0allp(1:jpnij) = nje0all(:) 301 301 ! 302 302 nimpptl(1:jpnij) = nimppt(:) 303 303 njmpptl(1:jpnij) = njmppt(:) 304 304 ! 305 nlcitl(1:jpnij) = nlcit(:)306 nlcjtl(1:jpnij) = nlcjt(:)305 jpiallp(1:jpnij) = jpiall(:) 306 jpjallp(1:jpnij) = jpjall(:) 307 307 ! 308 308 ibonitl(1:jpnij) = ibonit(:) … … 335 335 ! Print the SUM control indices 336 336 IF( .NOT. lsp_area ) THEN 337 nictls = nimpptl(jn) + n lditl(jn) - 1338 nictle = nimpptl(jn) + n leitl(jn) - 1339 njctls = njmpptl(jn) + n ldjtl(jn) - 1340 njctle = njmpptl(jn) + n lejtl(jn) - 1337 nictls = nimpptl(jn) + nis0allp(jn) - 1 338 nictle = nimpptl(jn) + nie0allp(jn) - 1 339 njctls = njmpptl(jn) + njs0allp(jn) - 1 340 njctle = njmpptl(jn) + nje0allp(jn) - 1 341 341 ENDIF 342 342 WRITE(j_id,*) … … 344 344 WRITE(j_id,*) '~~~~~~~' 345 345 WRITE(j_id,*) 346 WRITE(j_id,9000)' nlej = ', nlejtl(jn), ' '346 WRITE(j_id,9000)' Nje0 = ', nje0allp(jn), ' ' 347 347 WRITE(j_id,9000)' ------------- njctle = ', njctle, ' -------------' 348 348 WRITE(j_id,9001)' | |' … … 350 350 WRITE(j_id,9001)' | |' 351 351 WRITE(j_id,9002)' nictls = ', nictls, ' nictle = ', nictle 352 WRITE(j_id,9002)' nldi = ', nlditl(jn), ' nlei = ', nleitl(jn)352 WRITE(j_id,9002)' Nis0 = ', nis0allp(jn), ' Nie0 = ', nie0allp(jn) 353 353 WRITE(j_id,9001)' | |' 354 354 WRITE(j_id,9001)' | |' 355 355 WRITE(j_id,9001)' | |' 356 356 WRITE(j_id,9004)' njmpp = ',njmpptl(jn),' ------------- njctls = ', njctls, ' -------------' 357 WRITE(j_id,9003)' nimpp = ', nimpptl(jn), ' nldj = ', nldjtl(jn), ' '357 WRITE(j_id,9003)' nimpp = ', nimpptl(jn), ' Njs0 = ', njs0allp(jn), ' ' 358 358 WRITE(j_id,*) 359 359 WRITE(j_id,*) … … 392 392 !! njmpp : latitudinal index 393 393 !! narea : number for local area 394 !! nlcil : first dimension395 !! nlcjl : second dimension394 !! ipil : first dimension 395 !! ipjl : second dimension 396 396 !! nbondil : mark for "east-west local boundary" 397 397 !! nbondjl : mark for "north-south local boundary" … … 408 408 ii, ij, & ! temporary integers 409 409 irestil, irestjl, & ! " " 410 ijpi , ijpj, nlcil,& ! temporary logical unit411 nlcjl , nbondil, nbondjl,&412 nrecil, nrecjl, nldil, nleil, nldjl, nlejl413 414 INTEGER, DIMENSION(jpi,jpj) :: iimpptl, ijmpptl, i lcitl, ilcjtl ! workspace410 ijpi , ijpj, ipil, & ! temporary logical unit 411 ipjl , nbondil, nbondjl, & 412 nrecil, nrecjl, Nis0l, Nie0l, Njs0l, Nje0l 413 414 INTEGER, DIMENSION(jpi,jpj) :: iimpptl, ijmpptl, ijpitl, ijpjtl ! workspace 415 415 REAL(wp) :: zidom, zjdom ! temporary scalars 416 416 INTEGER :: inum ! local logical unit … … 421 421 ! 1. Dimension arrays for subdomains 422 422 ! ----------------------------------- 423 ! Computation of local domain sizes i lcitl() ilcjtl()423 ! Computation of local domain sizes ijpitl() ijpjtl() 424 424 ! These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 425 425 ! The subdomains are squares leeser than or equal to the global … … 448 448 DO jj = 1, jsplt 449 449 DO ji=1, isplt-1 450 i lcitl(ji,jj) = ijpi450 ijpitl(ji,jj) = ijpi 451 451 END DO 452 i lcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil)452 ijpitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 453 453 END DO 454 454 … … 457 457 DO jj = 1, jsplt 458 458 DO ji = 1, irestil 459 i lcitl(ji,jj) = ijpi459 ijpitl(ji,jj) = ijpi 460 460 END DO 461 461 DO ji = irestil+1, isplt 462 i lcitl(ji,jj) = ijpi -1462 ijpitl(ji,jj) = ijpi -1 463 463 END DO 464 464 END DO … … 472 472 DO ji = 1, isplt 473 473 DO jj=1, jsplt-1 474 i lcjtl(ji,jj) = ijpj474 ijpjtl(ji,jj) = ijpj 475 475 END DO 476 i lcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl)476 ijpjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 477 477 END DO 478 478 … … 481 481 DO ji = 1, isplt 482 482 DO jj = 1, irestjl 483 i lcjtl(ji,jj) = ijpj483 ijpjtl(ji,jj) = ijpj 484 484 END DO 485 485 DO jj = irestjl+1, jsplt 486 i lcjtl(ji,jj) = ijpj -1486 ijpjtl(ji,jj) = ijpj -1 487 487 END DO 488 488 END DO … … 491 491 zidom = nrecil 492 492 DO ji = 1, isplt 493 zidom = zidom + i lcitl(ji,1) - nrecil493 zidom = zidom + ijpitl(ji,1) - nrecil 494 494 END DO 495 495 IF(lwp) WRITE(numout,*) 496 IF(lwp) WRITE(numout,*)' sum i lcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo496 IF(lwp) WRITE(numout,*)' sum ijpitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 497 497 498 498 zjdom = nrecjl 499 499 DO jj = 1, jsplt 500 zjdom = zjdom + i lcjtl(1,jj) - nrecjl501 END DO 502 IF(lwp) WRITE(numout,*)' sum i lcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo500 zjdom = zjdom + ijpjtl(1,jj) - nrecjl 501 END DO 502 IF(lwp) WRITE(numout,*)' sum ijpitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo 503 503 IF(lwp) WRITE(numout,*) 504 504 … … 513 513 DO jj = 1, jsplt 514 514 DO ji = 2, isplt 515 iimpptl(ji,jj) = iimpptl(ji-1,jj) + i lcitl(ji-1,jj) - nrecil515 iimpptl(ji,jj) = iimpptl(ji-1,jj) + ijpitl(ji-1,jj) - nrecil 516 516 END DO 517 517 END DO … … 521 521 DO jj = 2, jsplt 522 522 DO ji = 1, isplt 523 ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+i lcjtl(ji,jj-1)-nrecjl523 ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ijpjtl(ji,jj-1)-nrecjl 524 524 END DO 525 525 END DO … … 534 534 nimpptl(jn) = iimpptl(ii,ij) 535 535 njmpptl(jn) = ijmpptl(ii,ij) 536 nlcitl (jn) = ilcitl (ii,ij)537 nlcil = nlcitl(jn)538 nlcjtl (jn) = ilcjtl (ii,ij)539 nlcjl = nlcjtl(jn)536 jpiallp(jn) = ijpitl (ii,ij) 537 ipil = jpiallp(jn) 538 jpjallp(jn) = ijpjtl (ii,ij) 539 ipjl = jpjallp(jn) 540 540 nbondjl = -1 ! general case 541 541 IF( jn > isplt ) nbondjl = 0 ! first row of processor … … 550 550 ibonitl(jn) = nbondil 551 551 552 nldil = 1 + nn_hls553 nleil = nlcil - nn_hls554 IF( nbondil == -1 .OR. nbondil == 2 ) nldil = 1555 IF( nbondil == 1 .OR. nbondil == 2 ) nleil = nlcil556 nldjl = 1 + nn_hls557 nlejl = nlcjl - nn_hls558 IF( nbondjl == -1 .OR. nbondjl == 2 ) nldjl = 1559 IF( nbondjl == 1 .OR. nbondjl == 2 ) nlejl = nlcjl560 n lditl(jn) = nldil561 n leitl(jn) = nleil562 n ldjtl(jn) = nldjl563 n lejtl(jn) = nlejl552 Nis0l = 1 + nn_hls 553 Nie0l = ipil - nn_hls 554 IF( nbondil == -1 .OR. nbondil == 2 ) Nis0l = 1 555 IF( nbondil == 1 .OR. nbondil == 2 ) Nie0l = ipil 556 Njs0l = 1 + nn_hls 557 Nje0l = ipjl - nn_hls 558 IF( nbondjl == -1 .OR. nbondjl == 2 ) Njs0l = 1 559 IF( nbondjl == 1 .OR. nbondjl == 2 ) Nje0l = ipjl 560 nis0allp(jn) = Nis0l 561 nie0allp(jn) = Nie0l 562 njs0allp(jn) = Njs0l 563 nje0allp(jn) = Nje0l 564 564 END DO 565 565 ! … … 567 567 IF(lwp) THEN 568 568 CALL ctl_opn( inum, 'layout_prtctl.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 569 WRITE(inum,'(a)') 'nproc nlcil nlcjl nldil nldjl nleil nlejl nimpptl njmpptl ibonitl ibonjtl'569 WRITE(inum,'(a)') 'nproc ipil ipjl Nis0l Njs0l Nie0l Nje0l nimpptl njmpptl ibonitl ibonjtl' 570 570 ! 571 571 DO jn = 1, ijsplt 572 WRITE(inum,'(i5,6i6,4i8)') jn-1, nlcitl(jn), nlcjtl(jn), &573 & n lditl(jn), nldjtl(jn), &574 & n leitl(jn), nlejtl(jn), &575 & nimpptl(jn),njmpptl(jn), &576 & ibonitl(jn),ibonjtl(jn)572 WRITE(inum,'(i5,6i6,4i8)') jn-1, jpiallp(jn), jpjallp(jn), & 573 & nis0allp(jn), njs0allp(jn), & 574 & nie0allp(jn), nje0allp(jn), & 575 & nimpptl(jn), njmpptl(jn), & 576 & ibonitl(jn), ibonjtl(jn) 577 577 END DO 578 578 CLOSE(inum)
Note: See TracChangeset
for help on using the changeset viewer.
