Changeset 10359
- Timestamp:
- 2018-11-25T22:33:50+01:00 (5 years ago)
- Location:
- NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src
- Files:
-
- 4 edited
-
ICE/icedyn_adv_umx.F90 (modified) (2 diffs)
-
ICE/icerst.F90 (modified) (4 diffs)
-
OCE/IOM/restart.F90 (modified) (3 diffs)
-
OCE/LBC/lib_mpp.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icedyn_adv_umx.F90
r10345 r10359 73 73 INTEGER :: ipl ! third dimention of tracer array 74 74 75 REAL(wp) :: zcfl 75 REAL(wp) :: zcfl(2), zusnit, zdt ! - - 76 76 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zudy, zvdx, zcu_box, zcv_box 77 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zpato … … 86 86 ! When needed, the advection split is applied at the next time-step in order to avoid blocking global comm. 87 87 ! ...this should not affect too much the stability... Was ok on the tests we did... 88 zcfl = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 89 zcfl = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 90 IF( zcfl > 0.5 ) THEN ; l_split_advumx(1) = .TRUE. ! split advection time-step if CFL violated 91 ELSE ; l_split_advumx(1) = .FALSE. 92 ENDIF 88 zcfl(1) = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 89 zcfl(1) = MAX( zcfl(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 93 90 94 ! non-blocking global communication send l_split_advumx(1) and receive l_split_advumx(2)95 IF( lk_mpp ) CALL mpp_ ilor( l_split_advumx, ldlast =kt == nitend - nn_fsbc + 1 )96 97 IF( l_split_advumx(2) ) THEN ; initad = 2 ; zusnit = 0.5_wp ! split defined atthe previous time-step98 ELSE 91 ! non-blocking global communication send zcfl(1) and receive zcfl(2) 92 IF( lk_mpp ) CALL mpp_delay_max( 'icedyn_adv_umx', 'advumx_delay', zcfl, kt == nitend - nn_fsbc + 1 ) 93 94 IF( zcfl(2) > .5 ) THEN ; initad = 2 ; zusnit = 0.5_wp ! zcfl(2) corresponding to zcfl(1) of the previous time-step 95 ELSE ; initad = 1 ; zusnit = 1.0_wp 99 96 ENDIF 100 97 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icerst.F90
r10292 r10359 98 98 INTEGER, INTENT(in) :: kt ! number of iteration 99 99 !! 100 INTEGER :: j k ,jl ! dummy loop indices100 INTEGER :: ji, jk ,jl ! dummy loop indices 101 101 INTEGER :: iter 102 102 CHARACTER(len=25) :: znam … … 118 118 CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) ) ! time-step 119 119 CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp ) ) ! date 120 DO ji = 1, nbdelay 121 CALL iom_rstput( iter, nitrst, numriw, c_delaylist(ji), todelay(ji) ) 122 END DO 120 123 121 124 ! Prognostic variables … … 169 172 !! ** purpose : read restart file 170 173 !!---------------------------------------------------------------------- 171 INTEGER :: j k, jl174 INTEGER :: ji, jk, jl 172 175 LOGICAL :: llok 173 176 INTEGER :: id1 ! local integer … … 240 243 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 241 244 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 242 ! define split from previous run, so we ca used mpp_ilor 243 IF( zcfl > 0.5 ) THEN ; l_split_advumx(1) = .TRUE. 244 ELSE ; l_split_advumx(1) = .FALSE. 245 ENDIF 246 IF( lk_mpp ) CALL mpp_ilor( l_split_advumx ) ! non-blocking global communication send l_split_advumx(1) 245 246 DO ji = 1, nbdelay 247 IF( iom_varid( numrir, c_delaylist(ji), ldstop = .FALSE. ) > 0 ) THEN 248 CALL iom_get( numrir, c_delaylist(ji), todelay(ji) ) 249 ndelayid(ji) = 0 ! set to 0 to speficy that the value was read in the restart 250 ENDIF 251 END DO 247 252 248 253 ! fields needed for Met Office (Jules) coupling -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/IOM/restart.F90
r10068 r10359 143 143 !!---------------------------------------------------------------------- 144 144 INTEGER, INTENT(in) :: kt ! ocean time-step 145 INTEGER :: ji 145 146 !!---------------------------------------------------------------------- 146 147 IF(lwxios) CALL iom_swap( cwxios_context ) 147 148 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt , ldxios = lwxios) ! dynamics time step 149 DO ji = 1, nbdelay 150 CALL iom_rstput( kt, nitrst, numrow, c_delaylist(ji), todelay(ji), ldxios = lwxios) 151 END DO 148 152 149 153 IF ( .NOT. ln_diurnal_only ) THEN … … 251 255 !!---------------------------------------------------------------------- 252 256 REAL(wp) :: zrdt 253 INTEGER :: j k257 INTEGER :: ji, jk 254 258 REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 255 259 !!---------------------------------------------------------------------- … … 263 267 ENDIF 264 268 269 DO ji = 1, nbdelay 270 IF( iom_varid( numror, c_delaylist(ji), ldstop = .FALSE. ) > 0 ) THEN 271 CALL iom_get( numror, c_delaylist(ji), todelay(ji), ldxios = lrxios ) 272 ndelayid(ji) = 0 ! set to 0 to speficy that the value was read in the restart 273 ENDIF 274 END DO 275 265 276 ! Diurnal DSST 266 277 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios ) -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90
r10358 r10359 83 83 PUBLIC mpp_lbc_north_icb 84 84 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 85 PUBLIC mpp_ ilor85 PUBLIC mpp_delay_max 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 = .FALSE. !: logical for a full (2lines) update of bc at North fold report 166 INTEGER, PARAMETER, PUBLIC :: nbdelay = 1 !: number of delayed operations 167 CHARACTER(len=32), DIMENSION(nbdelay), PUBLIC :: c_delaylist !: name (used as id) of allreduce-delayed operations 168 DATA c_delaylist(1) / 'advumx_delay' / 169 REAL(wp), DIMENSION(nbdelay), PUBLIC :: todelay !: current value of the delayed operations 170 INTEGER, DIMENSION(nbdelay), PUBLIC :: ndelayid = -1 !: mpi request id of the delayed operations 166 171 167 172 ! timing summary report … … 566 571 END SUBROUTINE mppscatter 567 572 568 !! 569 SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 570 ! WARNING: must be used only once (by ice_dyn_adv_umx) because ll_switch and ireq are SAVE 571 !!---------------------------------------------------------------------- 572 LOGICAL, INTENT(inout), DIMENSION(2) :: ld_switch 573 LOGICAL, INTENT(in ), OPTIONAL :: ldlast 574 INTEGER, INTENT(in ), OPTIONAL :: kcom 575 INTEGER :: ierror, ilocalcomm 576 LOGICAL, SAVE :: ll_switch , lllast 577 INTEGER, SAVE :: ireq = -1 573 574 SUBROUTINE mpp_delay_max( cdname, cdelay, pinout, ldlast, kcom ) 575 !!---------------------------------------------------------------------- 576 !! *** routine mpp_delay_max *** 577 !! 578 !! ** Purpose : performed delayed mpp_max, the result is received on next call 579 !! 580 !!---------------------------------------------------------------------- 581 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 582 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 583 REAL(wp), INTENT(inout), DIMENSION(2) :: pinout ! pinout(1): in data, pinout(2): out data 584 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 585 INTEGER, INTENT(in ), OPTIONAL :: kcom 586 !! 587 INTEGER :: ji 588 INTEGER :: idvar 589 INTEGER :: ierror, ilocalcomm 578 590 !!---------------------------------------------------------------------- 579 591 ilocalcomm = mpi_comm_oce 580 IF( PRESENT( kcom) ) ilocalcomm = kcom 581 lllast = .FALSE. 582 IF( PRESENT(ldlast) ) lllast = ldlast 583 584 IF ( ireq /= -1 ) THEN ! get ld_switch(2) from ll_switch (from previous call) 585 IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 586 CALL mpi_wait(ireq, MPI_STATUS_IGNORE, ierror ) 587 ld_switch(2) = ll_switch 592 IF( PRESENT(kcom) ) ilocalcomm = kcom 593 594 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 595 596 idvar = -1 597 DO ji = 1, nbdelay 598 IF( TRIM(cdelay) == trim(c_delaylist(ji)) ) idvar = ji 599 END DO 600 IF ( idvar == -1 ) CALL ctl_stop( 'STOP',' mpp_delay_max : please add a new delayed exchange for '//TRIM(cdname) ) 601 602 IF( ndelayid(idvar) == -1 ) THEN ! first call without restart: get pinout(2) from pinout(1) with a blocking allreduce 603 CALL mpi_allreduce( pinout(1), pinout(2), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierror ) 604 ELSE IF ( ndelayid(idvar) == 0 ) THEN ! first call with restart: get pinout(2) from todelay with a blocking allreduce 605 CALL mpi_allreduce( todelay(idvar), pinout(2), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierror ) 606 ELSE ! from the second call, get value from previous time step 607 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 608 CALL mpi_wait(ndelayid(idvar), MPI_STATUS_IGNORE, ierror ) ! make sure todelay(idvar) is received 588 609 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 589 ENDIF 590 IF( .NOT. lllast ) & ! send ll_switch to be received on next call 591 CALL mpi_iallreduce( ld_switch(1), ll_switch, 1, MPI_LOGICAL, mpi_lor, ilocalcomm, ireq, ierror ) 592 593 END SUBROUTINE mpp_ilor 610 pinout(2) = todelay(idvar) ! send back pinout(2) from todelay(idvar) defined at previous call 611 ENDIF 612 613 IF( ldlast ) THEN ! last call: put pinout(1) in todelay that will be stored in the restart files 614 todelay(idvar) = pinout(1) 615 ELSE ! send pinout(1) to todelay(idvar), to be received at next call 616 CALL mpi_iallreduce( pinout(1), todelay(idvar), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierror ) 617 ENDIF 618 619 END SUBROUTINE mpp_delay_max 594 620 595 621 !!---------------------------------------------------------------------- … … 1473 1499 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 1474 1500 INTEGER, PUBLIC :: mpi_comm_oce ! opa local communicator 1501 1502 INTEGER, PARAMETER, PUBLIC :: nbdelay = 0 ! make sure we don't enter loops: DO ji = 1, nbdelay 1503 CHARACTER(len=32), DIMENSION(1), PUBLIC :: c_delaylist = 'empty' 1504 REAL(wp), PUBLIC, DIMENSION(1) :: todelay 1505 INTEGER, PUBLIC, DIMENSION(1) :: ndelayid = -1 1475 1506 !!---------------------------------------------------------------------- 1476 1507 CONTAINS … … 1640 1671 # undef OPERATION_MAXLOC 1641 1672 1642 SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 1643 LOGICAL, INTENT(in ), DIMENSION(2) :: ld_switch 1644 LOGICAL, INTENT(in ), OPTIONAL :: ldlast 1645 INTEGER, INTENT(in ), OPTIONAL :: kcom ! ??? 1646 WRITE(*,*) 'mpp_ilor: You should not have seen this print! error?', ld_switch 1647 END SUBROUTINE mpp_ilor 1673 SUBROUTINE mpp_delay_max( cdname, cdelay, pinout, ldlast, kcom ) 1674 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 1675 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 1676 REAL(wp), INTENT(inout), DIMENSION(2) :: pinout ! pinout(1): in data, pinout(2): out data 1677 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 1678 INTEGER, INTENT(in ), OPTIONAL :: kcom 1679 WRITE(*,*) 'mpp_delay_max: You should not have seen this print! error?', cdname 1680 END SUBROUTINE mpp_delay_max 1648 1681 1649 1682 SUBROUTINE mppstop( ldfinal, ld_force_abort )
Note: See TracChangeset
for help on using the changeset viewer.
