- Timestamp:
- 2018-12-14T17:27:24+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90
r10386 r10397 83 83 PUBLIC mpp_lbc_north_icb 84 84 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 85 PUBLIC mpp_delay_max 85 PUBLIC mpp_delay_max, mpp_delay_sum, mpp_delay_rcv 86 86 PUBLIC mppscatter, mppgather 87 87 PUBLIC mpp_ini_znl … … 164 164 INTEGER, PUBLIC :: numcom = -1 !: logical unit for communicaton report 165 165 LOGICAL, PUBLIC :: l_full_nf_update = .TRUE. !: logical for a full (2lines) update of bc at North fold report 166 INTEGER, PARAMETER, PUBLIC :: nbdelay = 1 !: number of delayed operations 167 !$AGRIF_DO_NOT_TREAT 168 CHARACTER(len=32), DIMENSION(nbdelay), PUBLIC :: c_delaylist !: name (used as id) of allreduce-delayed operations 169 DATA c_delaylist(1) / 'advumx_delay' / 170 !$AGRIF_END_DO_NOT_TREAT 171 REAL(wp), DIMENSION(nbdelay), PUBLIC :: todelay !: current value of the delayed operations 172 INTEGER, DIMENSION(nbdelay), PUBLIC :: ndelayid = -1 !: mpi request id of the delayed operations 166 INTEGER, PARAMETER, PUBLIC :: nbdelay = 2 !: number of delayed operations 167 !: name (used as id) of allreduce-delayed operations 168 CHARACTER(len=32), DIMENSION(nbdelay), PUBLIC :: c_delaylist = (/ 'cflice', 'fwb' /) 169 !: component name where the allreduce-delayed operation is performed 170 CHARACTER(len=3), DIMENSION(nbdelay), PUBLIC :: c_delaycpnt = (/ 'ICE' , 'OCE' /) 171 TYPE, PUBLIC :: DELAYARR 172 REAL( wp), POINTER, DIMENSION(:) :: z1d => NULL() 173 COMPLEX(wp), POINTER, DIMENSION(:) :: y1d => NULL() 174 END TYPE DELAYARR 175 TYPE( DELAYARR ), DIMENSION(nbdelay), PUBLIC :: todelay 176 INTEGER, DIMENSION(nbdelay), PUBLIC :: ndelayid = -1 !: mpi request id of the delayed operations 173 177 174 178 ! timing summary report … … 573 577 END SUBROUTINE mppscatter 574 578 575 576 SUBROUTINE mpp_delay_ max( cdname, cdelay, pinout, ldlast, kcom )577 578 !! *** routine mpp_delay_ max***579 !! 580 !! ** Purpose : performed delayed mpp_ max, the result is received on next call579 580 SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom ) 581 !!---------------------------------------------------------------------- 582 !! *** routine mpp_delay_sum *** 583 !! 584 !! ** Purpose : performed delayed mpp_sum, the result is received on next call 581 585 !! 582 586 !!---------------------------------------------------------------------- 583 587 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 584 588 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 585 REAL(wp), INTENT(inout), DIMENSION(2) :: pinout ! pinout(1): in data, pinout(2): out data 589 COMPLEX(wp), INTENT(in ), DIMENSION(:) :: y_in 590 REAL(wp), INTENT( out), DIMENSION(:) :: pout 586 591 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 587 592 INTEGER, INTENT(in ), OPTIONAL :: kcom 588 593 !! 589 INTEGER :: ji 594 INTEGER :: ji, isz 590 595 INTEGER :: idvar 591 INTEGER :: ierror, ilocalcomm 596 INTEGER :: ierr, ilocalcomm 597 COMPLEX(wp), ALLOCATABLE, DIMENSION(:) :: ytmp 592 598 !!---------------------------------------------------------------------- 593 599 ilocalcomm = mpi_comm_oce 594 600 IF( PRESENT(kcom) ) ilocalcomm = kcom 595 601 602 isz = SIZE(y_in) 603 596 604 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 597 605 598 606 idvar = -1 599 607 DO ji = 1, nbdelay 600 IF( TRIM(cdelay) == trim(c_delaylist(ji)) ) idvar = ji 608 IF( TRIM(cdelay) == TRIM(c_delaylist(ji)) ) idvar = ji 609 END DO 610 IF ( idvar == -1 ) CALL ctl_stop( 'STOP',' mpp_delay_sum : please add a new delayed exchange for '//TRIM(cdname) ) 611 612 IF ( ndelayid(idvar) == 0 ) THEN ! first call with restart: %z1d defined in iom_delay_rst 613 ! -------------------------- 614 IF ( SIZE(todelay(idvar)%z1d) /= isz ) THEN ! Check dimension coherence 615 IF(lwp) WRITE(numout,*) ' WARNING: the nb of delayed variables in restart file is not the model one' 616 DEALLOCATE(todelay(idvar)%z1d) 617 ndelayid(idvar) = -1 ! do as if we had no restart 618 ELSE 619 ALLOCATE(todelay(idvar)%y1d(isz)) 620 todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp) ! create %y1d, complex variable needed by mpi_sumdd 621 END IF 622 ENDIF 623 624 IF( ndelayid(idvar) == -1 ) THEN ! first call without restart: define %y1d and %z1d from y_in with blocking allreduce 625 ! -------------------------- 626 ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz)) ! allocate also %z1d as used for the restart 627 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) ! get %y1d 628 todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp) ! define %z1d from %y1d 629 ENDIF 630 631 IF( ndelayid(idvar) > 0 ) CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 632 633 ! send back pout from todelay(idvar)%z1d defined at previous call 634 pout(:) = todelay(idvar)%z1d(:) 635 636 ! send y_in into todelay(idvar)%y1d with a non-blocking communication 637 CALL mpi_iallreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr ) 638 639 END SUBROUTINE mpp_delay_sum 640 641 642 SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom ) 643 !!---------------------------------------------------------------------- 644 !! *** routine mpp_delay_max *** 645 !! 646 !! ** Purpose : performed delayed mpp_max, the result is received on next call 647 !! 648 !!---------------------------------------------------------------------- 649 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 650 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 651 REAL(wp), INTENT(in ), DIMENSION(:) :: p_in ! 652 REAL(wp), INTENT( out), DIMENSION(:) :: pout ! 653 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 654 INTEGER, INTENT(in ), OPTIONAL :: kcom 655 !! 656 INTEGER :: ji, isz 657 INTEGER :: idvar 658 INTEGER :: ierr, ilocalcomm 659 !!---------------------------------------------------------------------- 660 ilocalcomm = mpi_comm_oce 661 IF( PRESENT(kcom) ) ilocalcomm = kcom 662 663 isz = SIZE(p_in) 664 665 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 666 667 idvar = -1 668 DO ji = 1, nbdelay 669 IF( TRIM(cdelay) == TRIM(c_delaylist(ji)) ) idvar = ji 601 670 END DO 602 671 IF ( idvar == -1 ) CALL ctl_stop( 'STOP',' mpp_delay_max : please add a new delayed exchange for '//TRIM(cdname) ) 603 672 604 IF( ndelayid(idvar) == -1 ) THEN ! first call without restart: get pinout(2) from pinout(1) with a blocking allreduce 605 CALL mpi_allreduce( pinout(1), pinout(2), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierror ) 606 ELSE IF ( ndelayid(idvar) == 0 ) THEN ! first call with restart: get pinout(2) from todelay with a blocking allreduce 607 CALL mpi_allreduce( todelay(idvar), pinout(2), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierror ) 608 ELSE ! from the second call, get value from previous time step 673 IF ( ndelayid(idvar) == 0 ) THEN ! first call with restart: %z1d defined in iom_delay_rst 674 ! -------------------------- 675 IF ( SIZE(todelay(idvar)%z1d) /= isz ) THEN ! Check dimension coherence 676 IF(lwp) WRITE(numout,*) ' WARNING: the nb of delayed variables in restart file is not the model one' 677 DEALLOCATE(todelay(idvar)%z1d) 678 ndelayid(idvar) = -1 ! do as if we had no restart 679 END IF 680 ENDIF 681 682 IF( ndelayid(idvar) == -1 ) THEN ! first call without restart: define %z1d from p_in with a blocking allreduce 683 ! -------------------------- 684 ALLOCATE(todelay(idvar)%z1d(isz)) 685 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) ! get %z1d 686 ENDIF 687 688 IF( ndelayid(idvar) > 0 ) CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 689 690 ! send back pout from todelay(idvar)%z1d defined at previous call 691 pout(:) = todelay(idvar)%z1d(:) 692 693 ! send p_in into todelay(idvar)%z1d with a non-blocking communication 694 CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr ) 695 696 END SUBROUTINE mpp_delay_max 697 698 699 SUBROUTINE mpp_delay_rcv( kid ) 700 !!---------------------------------------------------------------------- 701 !! *** routine mpp_delay_rcv *** 702 !! 703 !! ** Purpose : force barrier for delayed mpp (needed for restart) 704 !! 705 !!---------------------------------------------------------------------- 706 INTEGER,INTENT(in ) :: kid 707 INTEGER :: ierr 708 !!---------------------------------------------------------------------- 709 IF( ndelayid(kid) /= -2 ) THEN 609 710 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 610 CALL mpi_wait( ndelayid(idvar), MPI_STATUS_IGNORE, ierror ) ! make sure todelay(idvar) is received711 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! make sure todelay(kid) is received 611 712 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 612 pinout(2) = todelay(idvar) ! send back pinout(2) from todelay(idvar) defined at previous call 613 ENDIF 614 615 IF( ldlast ) THEN ! last call: put pinout(1) in todelay that will be stored in the restart files 616 todelay(idvar) = pinout(1) 617 ELSE ! send pinout(1) to todelay(idvar), to be received at next call 618 CALL mpi_iallreduce( pinout(1), todelay(idvar), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierror ) 619 ENDIF 620 621 END SUBROUTINE mpp_delay_max 713 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 714 ndelayid(kid) = -2 ! add flag to know that mpi_wait was already called on kid 715 ENDIF 716 END SUBROUTINE mpp_delay_rcv 717 622 718 623 719 !!---------------------------------------------------------------------- … … 1376 1472 ! 1377 1473 ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency 1378 ncom_freq = ncom_fsbc * ncom_dttrc1379 IF( MOD( MAX(ncom_fsbc,ncom_dttrc), MIN(ncom_fsbc,ncom_dttrc) ) == 0 ) ncom_freq = MAX(ncom_fsbc,ncom_dttrc)1474 IF( ncom_dttrc /= 1 ) CALL ctl_stop( 'STOP', 'mpp_report, ncom_dttrc /= 1 not coded...' ) 1475 ncom_freq = ncom_fsbc 1380 1476 ! 1381 1477 IF ( ncom_stp == nit000+ncom_freq ) THEN ! avoid to count extra communications in potential initializations at nit000 … … 1384 1480 IF( .NOT. ALLOCATED( crname_lbc) ) ALLOCATE( crname_lbc(ncom_rec_max ) ) 1385 1481 n_sequence_lbc = n_sequence_lbc + 1 1386 IF( n_sequence_lbc > ncom_rec_max ) CALL ctl_stop( 'STOP', 'l nk_generic, increase ncom_rec_max' ) ! deadlock1482 IF( n_sequence_lbc > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' ) ! deadlock 1387 1483 crname_lbc(n_sequence_lbc) = cdname ! keep the name of the calling routine 1388 1484 ncomm_sequence(n_sequence_lbc,1) = kpk*kpl ! size of 3rd and 4th dimensions … … 1392 1488 IF( .NOT. ALLOCATED(crname_glb) ) ALLOCATE( crname_glb(ncom_rec_max) ) 1393 1489 n_sequence_glb = n_sequence_glb + 1 1394 IF( n_sequence_glb > ncom_rec_max ) CALL ctl_stop( 'STOP', 'l nk_generic, increase ncom_rec_max' ) ! deadlock1490 IF( n_sequence_glb > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' ) ! deadlock 1395 1491 crname_glb(n_sequence_glb) = cdname ! keep the name of the calling routine 1396 1492 ENDIF … … 1504 1600 INTEGER, PARAMETER, PUBLIC :: nbdelay = 0 ! make sure we don't enter loops: DO ji = 1, nbdelay 1505 1601 CHARACTER(len=32), DIMENSION(1), PUBLIC :: c_delaylist = 'empty' 1506 REAL(wp), PUBLIC, DIMENSION(1) :: todelay 1602 CHARACTER(len=32), DIMENSION(1), PUBLIC :: c_delaycpnt = 'empty' 1603 TYPE :: DELAYARR 1604 REAL( wp), POINTER, DIMENSION(:) :: z1d => NULL() 1605 COMPLEX(wp), POINTER, DIMENSION(:) :: y1d => NULL() 1606 END TYPE DELAYARR 1607 TYPE( DELAYARR ), DIMENSION(1), PUBLIC :: todelay 1507 1608 INTEGER, PUBLIC, DIMENSION(1) :: ndelayid = -1 1508 1609 !!---------------------------------------------------------------------- … … 1673 1774 # undef OPERATION_MAXLOC 1674 1775 1675 SUBROUTINE mpp_delay_ max( cdname, cdelay, pinout, ldlast, kcom )1776 SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom ) 1676 1777 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 1677 1778 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 1678 REAL(wp), INTENT(inout), DIMENSION(2) :: pinout ! pinout(1): in data, pinout(2): out data 1779 COMPLEX(wp), INTENT(in ), DIMENSION(:) :: y_in 1780 REAL(wp), INTENT( out), DIMENSION(:) :: pout 1679 1781 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 1680 1782 INTEGER, INTENT(in ), OPTIONAL :: kcom 1681 WRITE(*,*) 'mpp_delay_max: You should not have seen this print! error?', cdname 1783 ! 1784 pout(:) = REAL(y_in(:), wp) 1785 END SUBROUTINE mpp_delay_sum 1786 1787 SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom ) 1788 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 1789 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 1790 REAL(wp), INTENT(in ), DIMENSION(:) :: p_in 1791 REAL(wp), INTENT( out), DIMENSION(:) :: pout 1792 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 1793 INTEGER, INTENT(in ), OPTIONAL :: kcom 1794 ! 1795 pout(:) = p_in(:) 1682 1796 END SUBROUTINE mpp_delay_max 1683 1797 1798 SUBROUTINE mpp_delay_rcv( kid ) 1799 INTEGER,INTENT(in ) :: kid 1800 WRITE(*,*) 'mpp_delay_rcv: You should not have seen this print! error?', kid 1801 END SUBROUTINE mpp_delay_rcv 1802 1684 1803 SUBROUTINE mppstop( ldfinal, ld_force_abort ) 1685 1804 LOGICAL, OPTIONAL, INTENT(in) :: ldfinal ! source process number
Note: See TracChangeset
for help on using the changeset viewer.
