- Timestamp:
- 2012-07-11T13:22:58+02:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3211 r3432 65 65 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 66 66 PUBLIC mppobc, mpp_ini_ice, mpp_ini_znl 67 PUBLIC mppsize 67 PUBLIC mppsize, MAX_FACTORS, nxfactors, xfactors, nyfactors, yfactors 68 68 PUBLIC lib_mpp_alloc ! Called in nemogcm.F90 69 69 … … 146 146 LOGICAL :: l_isend = .FALSE. ! isend use indicator (T if cn_mpi_send='I') 147 147 INTEGER :: nn_buffer = 0 ! size of the buffer in case of mpi_bsend 148 148 CHARACTER(len=256) :: nn_xfactors = '' ! String holding factors to use for PE grid in x direction 149 CHARACTER(len=256) :: nn_yfactors = '' ! String holding factors to use for PE grid in y direction 150 INTEGER, PARAMETER :: MAX_FACTORS = 20 ! Maximum no. of factors factor() can return 151 ! Arrays to hold specific factorisation of the processor grid specified 152 ! in the namelist. Set to -1 if no specific factorisation requested. 153 INTEGER, SAVE, DIMENSION(MAX_FACTORS) :: xfactors, yfactors 154 INTEGER, SAVE :: nxfactors, nyfactors 155 LOGICAL, PUBLIC :: nn_pttrim = .FALSE. ! Whether to trim dry 156 ! land from PE domains 157 INTEGER, SAVE, PUBLIC :: nn_cpnode = 4 ! Number of cores per 158 ! compute node on current computer 159 149 160 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend 150 161 … … 203 214 !!---------------------------------------------------------------------- 204 215 ! 205 ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) , & 216 ALLOCATE( & 217 #if !defined key_mpp_rkpart 218 t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) , & 206 219 & t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) , & 207 220 & t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) , & … … 212 225 & t2ew(jpj,jpreci ,2) , t2we(jpj,jpreci ,2) , & 213 226 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , & 227 #endif 214 228 ! 215 229 & tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) , & … … 248 262 LOGICAL :: mpi_was_called 249 263 ! 250 NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij 264 NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, & 265 nn_xfactors, nn_yfactors, nn_pttrim, nn_cpnode 251 266 !!---------------------------------------------------------------------- 252 267 ! … … 263 278 WRITE(ldtxt(ii),*) ' mpi send type cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 264 279 WRITE(ldtxt(ii),*) ' size in bytes of exported buffer nn_buffer = ', nn_buffer ; ii = ii + 1 265 280 WRITE(ldtxt(ii),*) ' whether to trim dry points nn_pttrim = ', nn_pttrim ; ii = ii + 1 281 WRITE(ldtxt(ii),*) ' number of cores per compute node nn_cpn = ', nn_cpnode ; ii = ii + 1 266 282 #if defined key_agrif 267 283 IF( .NOT. Agrif_Root() ) THEN … … 284 300 WRITE(ldtxt(ii),*) ' processor grid extent in j jpnj = ',jpnj; ii = ii + 1 285 301 WRITE(ldtxt(ii),*) ' number of local domains jpnij = ',jpnij; ii = ii +1 302 END IF 303 304 ! Check to see whether a specific factorisation of the number of 305 ! processors has been specified in the namelist file 306 nxfactors = 0; xfactors(:) = -1 307 nyfactors = 0; yfactors(:) = -1 308 IF((LEN_TRIM(nn_xfactors) > 0) .OR. (LEN_TRIM(nn_yfactors) > 0))THEN 309 310 IF( (VERIFY(TRIM(nn_xfactors),'0123456789,') > 0) .OR. & 311 (VERIFY(TRIM(nn_yfactors),'0123456789,') > 0) )THEN 312 WRITE(ldtxt(ii),*)'Invalid character in nn_xfactors/nn_yfactors namelist string. '; ii = ii + 1 313 WRITE(ldtxt(ii),*)'Will ignore requested factorisation.' ; ii = ii + 1 314 ELSE 315 READ(nn_xfactors, *,end=80,err=100) xfactors 316 80 CONTINUE 317 READ(nn_yfactors, *,end=90,err=100) yfactors 318 90 CONTINUE 319 320 trim_xarray: DO ji=MAX_FACTORS,1,-1 321 IF (xfactors(ji) .GE. 0) THEN 322 nxfactors = ji 323 EXIT trim_xarray 324 ENDIF 325 ENDDO trim_xarray 326 trim_yarray: DO ji=MAX_FACTORS,1,-1 327 IF (yfactors(ji) .GE. 0) THEN 328 nyfactors = ji 329 EXIT trim_yarray 330 ENDIF 331 ENDDO trim_yarray 332 333 100 CONTINUE 334 WRITE (*,*) 'ARPDBG: n{x,y}factors = ',nxfactors,nyfactors 335 IF(nxfactors < 1 .AND. nyfactors < 1)THEN 336 WRITE(ldtxt(ii),*)'Failed to parse factorisation string' ; ii = ii + 1 337 WRITE(ldtxt(ii),*)' - will ignore requested factorisation.' ; ii = ii + 1 338 ELSE 339 WRITE(ldtxt(ii),*)' automatic factorisation overridden' ; ii = ii + 1 340 WRITE(ldtxt(ii),*)' factors:', xfactors(1:nxfactors), & 341 '-',yfactors(1:nyfactors) 342 ii = ii + 1 343 END IF 344 ENDIF 345 286 346 END IF 287 347 … … 356 416 mynode = mpprank 357 417 ! 418 IF( (jpni < 1) .OR. (jpnj < 1) )THEN 419 IF(mynode == 0)WRITE(ldtxt(ii),*) ' Running on ',mppsize,' MPI processes'; ii = ii + 1 420 END IF 421 358 422 #if defined key_mpp_rep 359 423 CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) … … 363 427 364 428 365 SUBROUTINE mpp_lnk_3d( ptab3d, cd_type, psgn, cd_mpp, pval )429 SUBROUTINE mpp_lnk_3d( ptab3d, cd_type, psgn, cd_mpp, pval, lzero ) 366 430 !!---------------------------------------------------------------------- 367 431 !! *** routine mpp_lnk_3d *** … … 394 458 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 395 459 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 460 LOGICAL , OPTIONAL , INTENT(in ) :: lzero ! Whether to zero field at closed boundaries 396 461 !! 397 462 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 400 465 REAL(wp) :: zland 401 466 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 402 !!---------------------------------------------------------------------- 467 LOGICAL :: lzeroarg 468 !!---------------------------------------------------------------------- 469 470 #if defined key_mpp_rkpart 471 CALL ctl_stop('mpp_lnk_3d: should not have been called when key_mpp_rkpart defined!') 472 RETURN 473 #endif 474 ! Deal with optional routine arguments 475 lzeroarg = .TRUE. 476 IF( PRESENT(lzero) ) lzeroarg = lzero 403 477 404 478 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value … … 443 517 ptab3d(jpi,:,:) = ptab3d( 2 ,:,:) 444 518 ELSE !* closed 445 IF( .NOT. cd_type == 'F' ) ptab3d( 1 :jpreci,:,:) = zland ! south except F-point 446 ptab3d(nlci-jpreci+1:jpi ,:,:) = zland ! north 519 IF( lzeroarg )THEN 520 IF( .NOT. cd_type == 'F' ) ptab3d( 1 :jpreci,:,:) = zland ! south except F-point 521 ptab3d(nlci-jpreci+1:jpi ,:,:) = zland ! north 522 END IF 447 523 ENDIF 448 524 ! ! North-South boundaries (always closed) 449 IF( .NOT. cd_type == 'F' ) ptab3d(:, 1 :jprecj,:) = zland ! south except F-point 450 ptab3d(:,nlcj-jprecj+1:jpj ,:) = zland ! north 525 IF( lzeroarg )THEN 526 IF( .NOT. cd_type == 'F' ) ptab3d(:, 1 :jprecj,:) = zland ! south except F-point 527 ptab3d(:,nlcj-jprecj+1:jpj ,:) = zland ! north 528 END IF 451 529 ! 452 530 ENDIF … … 574 652 575 653 576 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )654 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval, lzero ) 577 655 !!---------------------------------------------------------------------- 578 656 !! *** routine mpp_lnk_2d *** … … 600 678 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 601 679 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 680 LOGICAL , OPTIONAL , INTENT(in ) :: lzero ! Whether to zero field at closed boundaries 602 681 !! 603 682 INTEGER :: ji, jj, jl ! dummy loop indices … … 606 685 REAL(wp) :: zland 607 686 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 608 !!---------------------------------------------------------------------- 687 LOGICAL :: lzeroarg 688 !!---------------------------------------------------------------------- 689 690 #if defined key_mpp_rkpart 691 CALL ctl_stop('mpp_lnk_3d: should not have been called when key_mpp_rkpart defined!') 692 RETURN 693 #endif 694 695 ! Deal with optional routine arguments 696 lzeroarg = .TRUE. 697 IF( PRESENT(lzero) ) lzeroarg = lzero 609 698 610 699 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value … … 637 726 pt2d(jpi,:) = pt2d( 2 ,:) ! east 638 727 ELSE ! closed 639 IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point 640 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 728 IF( lzeroarg )THEN 729 IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point 730 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 731 END IF 641 732 ENDIF 642 733 ! ! North-South boundaries (always closed) 643 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point 644 pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north 734 IF( lzeroarg )THEN 735 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point 736 pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north 737 END IF 645 738 ! 646 739 ENDIF … … 1782 1875 CALL mppsync 1783 1876 CALL mpi_finalize( info ) 1877 STOP 1784 1878 ! 1785 1879 END SUBROUTINE mppstop
Note: See TracChangeset
for help on using the changeset viewer.
