Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/mpp_lnk_icb_generic.h90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/mpp_lnk_icb_generic.h90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/mpp_lnk_icb_generic.h90
r13286 r14644 24 24 !! jpi : first dimension of the local subdomain 25 25 !! jpj : second dimension of the local subdomain 26 !! mpinei : number of neighboring domains (starting at 0, -1 if no neighbourg) 26 27 !! kexti : number of columns for extra outer halo 27 28 !! kextj : number of rows for extra outer halo 28 !! nbondi : mark for "east-west local boundary"29 !! nbondj : mark for "north-south local boundary"30 !! noea : number for local neighboring processors31 !! nowe : number for local neighboring processors32 !! noso : number for local neighboring processors33 !! nono : number for local neighboring processors34 29 !!---------------------------------------------------------------------- 35 30 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 36 31 REAL(PRECISION), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) :: pt2d ! 2D array with extra halo 37 32 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 38 REAL( wp), INTENT(in ) :: psgn ! sign used across the north fold33 REAL(PRECISION) , INTENT(in ) :: psgn ! sign used across the north fold 39 34 INTEGER , INTENT(in ) :: kexti ! extra i-halo width 40 35 INTEGER , INTENT(in ) :: kextj ! extra j-halo width … … 90 85 ! north fold treatment 91 86 ! ----------------------- 92 IF( npolj /= 0) THEN87 IF( l_IdoNFold ) THEN 93 88 ! 94 89 SELECT CASE ( jpni ) … … 103 98 ! we play with the neigbours AND the row number because of the periodicity 104 99 ! 105 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 106 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 100 IF( mpinei(jpwe) >= 0 .OR. mpinei(jpea) >= 0 ) THEN ! Read Dirichlet lateral conditions: all exept 2 (i.e. close case) 107 101 iihom = jpi - (2 * nn_hls) -kexti 108 102 DO jl = 1, ipreci … … 110 104 r2dwe(:,jl,1) = pt2d(iihom +jl,:) 111 105 END DO 112 END SELECT106 ENDIF 113 107 ! 114 108 ! ! Migrations … … 120 114 IF( ln_timing ) CALL tic_tac(.TRUE.) 121 115 ! 122 SELECT CASE ( nbondi ) 123 CASE ( -1 ) 124 CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 ) 125 CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, noea ) 126 CALL mpi_wait(ml_req1,ml_stat,ml_err) 127 CASE ( 0 ) 128 CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 129 CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 ) 130 CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, noea ) 131 CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 132 CALL mpi_wait(ml_req1,ml_stat,ml_err) 133 CALL mpi_wait(ml_req2,ml_stat,ml_err) 134 CASE ( 1 ) 135 CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 136 CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 137 CALL mpi_wait(ml_req1,ml_stat,ml_err) 138 END SELECT 116 IF( mpinei(jpwe) >= 0 ) CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, mpinei(jpwe), ml_req1 ) 117 IF( mpinei(jpea) >= 0 ) CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, mpinei(jpea), ml_req2 ) 118 IF( mpinei(jpwe) >= 0 ) CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, mpinei(jpwe) ) 119 IF( mpinei(jpea) >= 0 ) CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, mpinei(jpea) ) 120 IF( mpinei(jpwe) >= 0 ) CALL mpi_wait(ml_req1,ml_stat,ml_err) 121 IF( mpinei(jpea) >= 0 ) CALL mpi_wait(ml_req2,ml_stat,ml_err) 139 122 ! 140 123 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 142 125 ! ! Write Dirichlet lateral conditions 143 126 iihom = jpi - nn_hls 144 ! 145 SELECT CASE ( nbondi ) 146 CASE ( -1 ) 127 IF( mpinei(jpwe) >= 0 ) THEN 128 DO jl = 1, ipreci 129 pt2d(jl-kexti,:) = r2dwe(:,jl,2) 130 END DO 131 ENDIF 132 IF( mpinei(jpea) >= 0 ) THEN 147 133 DO jl = 1, ipreci 148 134 pt2d(iihom+jl,:) = r2dew(:,jl,2) 149 135 END DO 150 CASE ( 0 ) 151 DO jl = 1, ipreci 152 pt2d(jl-kexti,:) = r2dwe(:,jl,2) 153 pt2d(iihom+jl,:) = r2dew(:,jl,2) 154 END DO 155 CASE ( 1 ) 156 DO jl = 1, ipreci 157 pt2d(jl-kexti,:) = r2dwe(:,jl,2) 158 END DO 159 END SELECT 160 136 ENDIF 161 137 162 138 ! 3. North and south directions … … 164 140 ! always closed : we play only with the neigbours 165 141 ! 166 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions142 IF( mpinei(jpso) >= 0 .OR. mpinei(jpno) >= 0 ) THEN ! Read Dirichlet lateral conditions: all exept 2 (i.e. close case) 167 143 ijhom = jpj - (2 * nn_hls) - kextj 168 144 DO jl = 1, iprecj … … 177 153 IF( ln_timing ) CALL tic_tac(.TRUE.) 178 154 ! 179 SELECT CASE ( nbondj ) 180 CASE ( -1 ) 181 CALL SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 ) 182 CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, nono ) 183 CALL mpi_wait(ml_req1,ml_stat,ml_err) 184 CASE ( 0 ) 185 CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 186 CALL SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 ) 187 CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, nono ) 188 CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, noso ) 189 CALL mpi_wait(ml_req1,ml_stat,ml_err) 190 CALL mpi_wait(ml_req2,ml_stat,ml_err) 191 CASE ( 1 ) 192 CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 193 CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, noso ) 194 CALL mpi_wait(ml_req1,ml_stat,ml_err) 195 END SELECT 155 IF( mpinei(jpso) >= 0 ) CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, mpinei(jpso), ml_req1 ) 156 IF( mpinei(jpno) >= 0 ) CALL SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, mpinei(jpno), ml_req2 ) 157 IF( mpinei(jpso) >= 0 ) CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, mpinei(jpso) ) 158 IF( mpinei(jpno) >= 0 ) CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, mpinei(jpno) ) 159 IF( mpinei(jpso) >= 0 ) CALL mpi_wait(ml_req1,ml_stat,ml_err) 160 IF( mpinei(jpno) >= 0 ) CALL mpi_wait(ml_req2,ml_stat,ml_err) 196 161 ! 197 162 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 200 165 ijhom = jpj - nn_hls 201 166 ! 202 SELECT CASE ( nbondj ) 203 CASE ( -1 ) 204 DO jl = 1, iprecj 205 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 206 END DO 207 CASE ( 0 ) 208 DO jl = 1, iprecj 209 pt2d(:,jl-kextj) = r2dsn(:,jl,2) 210 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 211 END DO 212 CASE ( 1 ) 167 IF( mpinei(jpso) >= 0 ) THEN 213 168 DO jl = 1, iprecj 214 169 pt2d(:,jl-kextj) = r2dsn(:,jl,2) 215 170 END DO 216 END SELECT 171 ENDIF 172 IF( mpinei(jpno) >= 0 ) THEN 173 DO jl = 1, iprecj 174 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 175 END DO 176 ENDIF 217 177 ! 218 178 END SUBROUTINE ROUTINE_LNK
Note: See TracChangeset
for help on using the changeset viewer.
