- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/lib_fortran.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/lib_fortran.F90
r12377 r13540 143 143 !!---------------------------------------------------------------------- 144 144 REAL(wp), INTENT(in ) :: ptab(:,:) ! array on which operation is applied 145 COMPLEX( wp) :: local_sum_2d146 ! 147 !!----------------------------------------------------------------------- 148 ! 149 COMPLEX( wp):: ctmp145 COMPLEX(dp) :: local_sum_2d 146 ! 147 !!----------------------------------------------------------------------- 148 ! 149 COMPLEX(dp):: ctmp 150 150 REAL(wp) :: ztmp 151 151 INTEGER :: ji, jj ! dummy loop indices … … 161 161 DO ji = 1, ipi 162 162 ztmp = ptab(ji,jj) * tmask_i(ji,jj) 163 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )163 CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp ) 164 164 END DO 165 165 END DO … … 172 172 !!---------------------------------------------------------------------- 173 173 REAL(wp), INTENT(in ) :: ptab(:,:,:) ! array on which operation is applied 174 COMPLEX( wp) :: local_sum_3d175 ! 176 !!----------------------------------------------------------------------- 177 ! 178 COMPLEX( wp):: ctmp174 COMPLEX(dp) :: local_sum_3d 175 ! 176 !!----------------------------------------------------------------------- 177 ! 178 COMPLEX(dp):: ctmp 179 179 REAL(wp) :: ztmp 180 180 INTEGER :: ji, jj, jk ! dummy loop indices … … 192 192 DO ji = 1, ipi 193 193 ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj) 194 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )194 CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp ) 195 195 END DO 196 196 END DO … … 217 217 IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 218 218 ! 219 DO_2D_11_11 220 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 219 ! work over the whole domain (guarantees all internal cells are set when nn_hls=2) 220 ! 221 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 222 IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & 223 & MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box 221 224 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box 222 225 jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box … … 226 229 ENDIF 227 230 END_2D 228 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 229 IF( nbondi /= -1 ) THEN 230 IF( MOD(mig( 1), 3) == 1 ) p2d( 1,:) = p2d( 2,:) 231 IF( MOD(mig( 1), 3) == 2 ) p2d( 2,:) = p2d( 1,:) 231 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 232 ! no need for 2nd exchange when nn_hls = 2 233 IF( nn_hls /= 2 ) THEN 234 IF( nbondi /= -1 ) THEN 235 IF( MOD(mig( 1), 3) == 1 ) p2d( 1,:) = p2d( 2,:) 236 IF( MOD(mig( 1), 3) == 2 ) p2d( 2,:) = p2d( 1,:) 237 ENDIF 238 IF( nbondi /= 1 ) THEN 239 IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:) 240 IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:) 241 ENDIF 242 IF( nbondj /= -1 ) THEN 243 IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2) 244 IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1) 245 ENDIF 246 IF( nbondj /= 1 ) THEN 247 IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1) 248 IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj) 249 ENDIF 250 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 232 251 ENDIF 233 IF( nbondi /= 1 ) THEN234 IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:)235 IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:)236 ENDIF237 IF( nbondj /= -1 ) THEN238 IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2)239 IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1)240 ENDIF241 IF( nbondj /= 1 ) THEN242 IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1)243 IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj)244 ENDIF245 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )246 252 247 253 END SUBROUTINE sum3x3_2d … … 264 270 ! 265 271 DO jn = 1, ipn 266 DO_2D_11_11 267 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 272 ! 273 ! work over the whole domain (guarantees all internal cells are set when nn_hls=2) 274 ! 275 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 276 IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & 277 & MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box 268 278 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box 269 279 jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box … … 274 284 END_2D 275 285 END DO 276 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. ) 277 IF( nbondi /= -1 ) THEN 278 IF( MOD(mig( 1), 3) == 1 ) p3d( 1,:,:) = p3d( 2,:,:) 279 IF( MOD(mig( 1), 3) == 2 ) p3d( 2,:,:) = p3d( 1,:,:) 286 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 287 ! no need for 2nd exchange when nn_hls = 2 288 IF( nn_hls /= 2 ) THEN 289 IF( nbondi /= -1 ) THEN 290 IF( MOD(mig( 1), 3) == 1 ) p3d( 1,:,:) = p3d( 2,:,:) 291 IF( MOD(mig( 1), 3) == 2 ) p3d( 2,:,:) = p3d( 1,:,:) 292 ENDIF 293 IF( nbondi /= 1 ) THEN 294 IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:) 295 IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:) 296 ENDIF 297 IF( nbondj /= -1 ) THEN 298 IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:) 299 IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:) 300 ENDIF 301 IF( nbondj /= 1 ) THEN 302 IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:) 303 IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:) 304 ENDIF 305 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 280 306 ENDIF 281 IF( nbondi /= 1 ) THEN282 IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:)283 IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:)284 ENDIF285 IF( nbondj /= -1 ) THEN286 IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:)287 IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:)288 ENDIF289 IF( nbondj /= 1 ) THEN290 IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:)291 IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:)292 ENDIF293 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )294 307 295 308 END SUBROUTINE sum3x3_3d … … 313 326 !! Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001 314 327 !!---------------------------------------------------------------------- 315 COMPLEX( wp), INTENT(in ) :: ydda316 COMPLEX( wp), INTENT(inout) :: yddb317 ! 318 REAL( wp) :: zerr, zt1, zt2 ! local work variables328 COMPLEX(dp), INTENT(in ) :: ydda 329 COMPLEX(dp), INTENT(inout) :: yddb 330 ! 331 REAL(dp) :: zerr, zt1, zt2 ! local work variables 319 332 !!----------------------------------------------------------------------- 320 333 !
Note: See TracChangeset
for help on using the changeset viewer.
