Changeset 10727 for utils/tools_AGRIF_CMEMS_2020/DOMAINcfg/src/prtctl.F90
- Timestamp:
- 2019-02-27T17:02:02+01:00 (5 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
utils/tools_AGRIF_CMEMS_2020/DOMAINcfg/src/prtctl.F90
r10725 r10727 8 8 !!---------------------------------------------------------------------- 9 9 USE dom_oce ! ocean space and time domain variables 10 11 12 10 #if defined key_nemocice_decomp 11 USE ice_domain_size, only: nx_global, ny_global 12 #endif 13 13 USE in_out_manager ! I/O manager 14 14 USE lib_mpp ! distributed memory computing 15 USE wrk_nemo ! work arrays16 15 17 16 IMPLICIT NONE … … 37 36 !!---------------------------------------------------------------------- 38 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 39 !! $Id: prtctl.F90 5025 2015-01-12 15:53:50Z timgraham$40 !! Software governed by the CeCILL licen ce (./LICENSE)38 !! $Id: prtctl.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 39 !! Software governed by the CeCILL license (see ./LICENSE) 41 40 !!---------------------------------------------------------------------- 42 41 CONTAINS 43 42 44 43 SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, & 45 & mask2, clinfo2, ovlap,kdim, clinfo3 )44 & mask2, clinfo2, kdim, clinfo3 ) 46 45 !!---------------------------------------------------------------------- 47 46 !! *** ROUTINE prt_ctl *** … … 75 74 !! mask2 : mask (3D) to apply to the tab[23]d_2 array 76 75 !! clinfo2 : information about the tab[23]d_2 array 77 !! ovlap : overlap value78 76 !! kdim : k- direction for 3D arrays 79 77 !! clinfo3 : additional information … … 87 85 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2 88 86 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo2 89 INTEGER , INTENT(in), OPTIONAL :: ovlap90 87 INTEGER , INTENT(in), OPTIONAL :: kdim 91 88 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo3 92 89 ! 93 90 CHARACTER (len=15) :: cl2 94 INTEGER :: overlap,jn, sind, eind, kdir,j_id91 INTEGER :: jn, sind, eind, kdir,j_id 95 92 REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 96 REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d_1, ztab2d_2 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask1, zmask2, ztab3d_1, ztab3d_2 98 !!---------------------------------------------------------------------- 99 100 CALL wrk_alloc( jpi,jpj, ztab2d_1, ztab2d_2 ) 101 CALL wrk_alloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 ) 93 REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2 94 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 95 !!---------------------------------------------------------------------- 102 96 103 97 ! Arrays, scalars initialization 104 overlap = 0105 98 kdir = jpkm1 106 99 cl2 = '' … … 118 111 ! Control of optional arguments 119 112 IF( PRESENT(clinfo2) ) cl2 = clinfo2 120 IF( PRESENT(ovlap) ) overlap = ovlap121 113 IF( PRESENT(kdim) ) kdir = kdim 122 114 IF( PRESENT(tab2d_1) ) ztab2d_1(:,:) = tab2d_1(:,:) … … 142 134 IF( .NOT. lsp_area ) THEN 143 135 IF (lk_mpp .AND. jpnij > 1) THEN 144 nictls = MAX( 1, nlditl(jn) - overlap)145 nictle = nleitl(jn) + overlap * MIN( 1, nlcitl(jn) - nleitl(jn))146 njctls = MAX( 1, nldjtl(jn) - overlap)147 njctle = nlejtl(jn) + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn))136 nictls = MAX( 1, nlditl(jn) ) 137 nictle = MIN(jpi, nleitl(jn) ) 138 njctls = MAX( 1, nldjtl(jn) ) 139 njctle = MIN(jpj, nlejtl(jn) ) 148 140 ! Do not take into account the bound of the domain 149 141 IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) … … 152 144 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(jn) - 1) 153 145 ELSE 154 nictls = MAX( 1, nimpptl(jn) + nlditl(jn) - 1 - overlap)155 nictle = nimpptl(jn) + nleitl(jn) - 1 + overlap * MIN( 1, nlcitl(jn) - nleitl(jn) )156 njctls = MAX( 1, njmpptl(jn) + nldjtl(jn) - 1 - overlap)157 njctle = njmpptl(jn) + nlejtl(jn) - 1 + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn) )146 nictls = MAX( 1, nimpptl(jn) - 1 + nlditl(jn) ) 147 nictle = MIN(jpi, nimpptl(jn) - 1 + nleitl(jn) ) 148 njctls = MAX( 1, njmpptl(jn) - 1 + nldjtl(jn) ) 149 njctle = MIN(jpj, njmpptl(jn) - 1 + nlejtl(jn) ) 158 150 ! Do not take into account the bound of the domain 159 151 IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) … … 207 199 208 200 ENDDO 209 210 CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 )211 CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 )212 201 ! 213 202 END SUBROUTINE prt_ctl … … 398 387 !! periodic 399 388 !! Type : jperio global periodic condition 400 !! nperio local periodic condition401 389 !! 402 390 !! ** Action : - set domain parameters 403 391 !! nimpp : longitudinal index 404 392 !! njmpp : latitudinal index 405 !! nperio : lateral condition type406 393 !! narea : number for local area 407 394 !! nlcil : first dimension … … 425 412 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 426 413 427 INTEGER, POINTER, DIMENSION(:,:) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace414 INTEGER, DIMENSION(jpi,jpj) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace 428 415 REAL(wp) :: zidom, zjdom ! temporary scalars 429 !!----------------------------------------------------------------------430 431 ! 432 CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )416 INTEGER :: inum ! local logical unit 417 !!---------------------------------------------------------------------- 418 419 ! 433 420 ! 434 421 ! 1. Dimension arrays for subdomains … … 440 427 ! array (cf. par_oce.F90). 441 428 442 443 444 445 446 ijpi = ( jpiglo-2* jpreci + (isplt-1) ) / isplt + 2*jpreci447 ijpj = ( jpjglo-2* jprecj + (jsplt-1) ) / jsplt + 2*jprecj448 449 450 451 nrecil = 2 * jpreci452 nrecjl = 2 * jprecj429 #if defined key_nemocice_decomp 430 ijpi = ( nx_global+2-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 431 ijpj = ( ny_global+2-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls 432 #else 433 ijpi = ( jpiglo-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 434 ijpj = ( jpjglo-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls 435 #endif 436 437 438 nrecil = 2 * nn_hls 439 nrecjl = 2 * nn_hls 453 440 irestil = MOD( jpiglo - nrecil , isplt ) 454 441 irestjl = MOD( jpjglo - nrecjl , jsplt ) 455 442 456 443 IF( irestil == 0 ) irestil = isplt 444 #if defined key_nemocice_decomp 445 446 ! In order to match CICE the size of domains in NEMO has to be changed 447 ! The last line of blocks (west) will have fewer points 448 DO jj = 1, jsplt 449 DO ji=1, isplt-1 450 ilcitl(ji,jj) = ijpi 451 END DO 452 ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 453 END DO 454 455 #else 457 456 458 457 DO jj = 1, jsplt … … 465 464 END DO 466 465 466 #endif 467 467 468 468 IF( irestjl == 0 ) irestjl = jsplt 469 #if defined key_nemocice_decomp 470 471 ! Same change to domains in North-South direction as in East-West. 472 DO ji = 1, isplt 473 DO jj=1, jsplt-1 474 ilcjtl(ji,jj) = ijpj 475 END DO 476 ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 477 END DO 478 479 #else 469 480 470 481 DO ji = 1, isplt … … 477 488 END DO 478 489 490 #endif 479 491 zidom = nrecil 480 492 DO ji = 1, isplt … … 538 550 ibonitl(jn) = nbondil 539 551 540 nldil = 1 + jpreci541 nleil = nlcil - jpreci552 nldil = 1 + nn_hls 553 nleil = nlcil - nn_hls 542 554 IF( nbondil == -1 .OR. nbondil == 2 ) nldil = 1 543 555 IF( nbondil == 1 .OR. nbondil == 2 ) nleil = nlcil 544 nldjl = 1 + jprecj545 nlejl = nlcjl - jprecj556 nldjl = 1 + nn_hls 557 nlejl = nlcjl - nn_hls 546 558 IF( nbondjl == -1 .OR. nbondjl == 2 ) nldjl = 1 547 559 IF( nbondjl == 1 .OR. nbondjl == 2 ) nlejl = nlcjl … … 552 564 END DO 553 565 ! 554 ! 555 CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 566 ! Save processor layout in layout_prtctl.dat file 567 IF(lwp) THEN 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' 570 ! 571 DO jn = 1, ijsplt 572 WRITE(inum,'(i5,6i6,4i8)') jn-1,nlcitl(jn), nlcjtl(jn), & 573 & nlditl(jn), nldjtl(jn), & 574 & nleitl(jn), nlejtl(jn), & 575 & nimpptl(jn), njmpptl(jn), & 576 & ibonitl(jn), ibonjtl(jn) 577 END DO 578 CLOSE(inum) 579 END IF 556 580 ! 557 581 !
Note: See TracChangeset
for help on using the changeset viewer.
