Changeset 10292
- Timestamp:
- 2018-11-09T16:35:08+01:00 (5 years ago)
- Location:
- NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/ice.F90
r10068 r10292 198 198 REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number 199 199 200 ! !!** some other parameters for advection using the ULTIMATE-MACHO scheme 201 LOGICAL, PUBLIC, DIMENSION(2) :: l_split_advumx = .FALSE. ! force one iteration at the first time-step 200 202 201 203 ! !!** define arrays -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icedyn_adv_umx.F90
r10180 r10292 83 83 ALLOCATE( zpato(jpi,jpj,1) ) 84 84 ! 85 ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- ! 86 zcfl = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 87 zcfl = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 88 IF( lk_mpp ) CALL mpp_max( zcfl ) 89 90 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 91 ELSE ; initad = 1 ; zusnit = 1.0_wp 85 ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- ! 86 ! When needed, the advection split is applied at the next time-step in order to avoid blocking global comm. 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 93 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 at the previous time-step 98 ELSE ; initad = 1 ; zusnit = 1.0_wp 92 99 ENDIF 93 100 … … 120 127 DO jt = 1, initad 121 128 CALL adv_umx( k_order, kt, 1, zdt, zudy, zvdx, zcu_box, zcv_box, zpato(:,:,1) ) ! Open water area 129 CALL lbc_lnk( 'icedyn_adv_umx', zpato, 'T', 1. ) 122 130 CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pa_i(:,:,:) ) ! Ice area 123 131 CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pv_i(:,:,:) ) ! Ice volume … … 127 135 CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pe_i(:,:,jk,:) ) ! Ice heat content 128 136 END DO 137 CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1. ) 138 129 139 CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pv_s(:,:,:) ) ! Snow volume 130 140 DO jk = 1, nlay_s 131 141 CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pe_s(:,:,jk,:) ) ! Snow heat content 132 142 END DO 143 CALL lbc_lnk( 'icedyn_adv_umx', pe_s, 'T', 1. ) 144 133 145 IF ( ln_pnd_H12 ) THEN 134 146 CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pa_ip(:,:,:) ) ! Melt pond fraction 135 147 CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pv_ip(:,:,:) ) ! Melt pond volume 148 CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i, 'T', 1., pv_i, 'T', 1., psv_i, 'T', 1., & 149 & poa_i, 'T', 1., pv_s, 'T', 1., pa_ip, 'T', 1., & 150 & pv_ip, 'T', 1. ) 151 ELSE 152 CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i, 'T', 1., pv_i, 'T', 1., psv_i, 'T', 1., & 153 & poa_i, 'T', 1., pv_s, 'T', 1. ) 136 154 ENDIF 137 155 END DO … … 249 267 END DO 250 268 END DO 251 CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T', 1. )252 269 ! 253 270 END SUBROUTINE adv_umx -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/iceistate.F90
r10069 r10292 406 406 u_ice (:,:) = 0._wp 407 407 v_ice (:,:) = 0._wp 408 ! fields needed for ice_dyn_adv_umx 409 l_split_advumx(1) = .FALSE. 408 410 ! 409 411 !---------------------------------------------- -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icerst.F90
r10069 r10292 175 175 CHARACTER(len=25) :: znam 176 176 CHARACTER(len=2) :: zchar, zchar1 177 REAL(wp) :: zfice, ziter 177 REAL(wp) :: zfice, ziter, zcfl 178 178 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z3d ! 3D workspace 179 179 !!---------------------------------------------------------------------- … … 236 236 CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 237 237 CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 238 239 ! fields needed for ice_dyn_adv_umx 240 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 241 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) 247 238 248 ! fields needed for Met Office (Jules) coupling 239 249 IF( ln_cpl ) THEN -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90
r10180 r10292 83 83 PUBLIC mpp_lbc_north_icb 84 84 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 85 PUBLIC mpp_ilor 85 86 PUBLIC mpp_max_multiple 86 87 PUBLIC mppscatter, mppgather … … 633 634 ptab = zwork 634 635 END SUBROUTINE mppmax_real 636 !! 637 SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 638 ! WARNING: must be used only once (by ice_dyn_adv_umx) because ll_switch and ireq are SAVE 639 !!---------------------------------------------------------------------- 640 LOGICAL, INTENT(inout), DIMENSION(2) :: ld_switch 641 LOGICAL, INTENT(in ), OPTIONAL :: ldlast 642 INTEGER, INTENT(in ), OPTIONAL :: kcom 643 INTEGER :: ierror, ilocalcomm 644 LOGICAL, SAVE :: ll_switch 645 INTEGER, SAVE :: ireq = -1 646 !!---------------------------------------------------------------------- 647 ilocalcomm = mpi_comm_oce 648 IF( PRESENT(kcom) ) ilocalcomm = kcom 649 650 IF ( ireq /= -1 ) THEN ! get ld_switch(2) from ll_switch (from previous call) 651 CALL mpi_wait(ireq, MPI_STATUS_IGNORE, ierror ) 652 ld_switch(2) = ll_switch 653 ENDIF 654 IF( .NOT. ldlast ) & ! send ll_switch to be received on next call 655 CALL mpi_iallreduce( ld_switch(1), ll_switch, 1, MPI_LOGICAL, mpi_lor, ilocalcomm, ireq, ierror ) 656 657 END SUBROUTINE mpp_ilor 635 658 636 659 … … 1720 1743 END SUBROUTINE mpp_maxloc3d 1721 1744 1745 SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 1746 LOGICAL, INTENT(in ), DIMENSION(2) :: ld_switch 1747 LOGICAL, INTENT(in ), OPTIONAL :: ldlast 1748 INTEGER, INTENT(in ), OPTIONAL :: kcom ! ??? 1749 WRITE(*,*) 'mpp_ilor: You should not have seen this print! error?', ld_switch 1750 END SUBROUTINE mpp_ilor 1751 1722 1752 SUBROUTINE mppstop 1723 1753 STOP ! non MPP case, just stop the run
Note: See TracChangeset
for help on using the changeset viewer.