Changeset 14219 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_fct.F90
- Timestamp:
- 2020-12-18T18:52:57+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traadv_fct.F90
r14200 r14219 49 49 # include "do_loop_substitute.h90" 50 50 # include "domzgr_substitute.h90" 51 # include "single_precision_substitute.h90" 51 52 !!---------------------------------------------------------------------- 52 53 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 83 84 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 84 85 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 85 REAL( wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation86 REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 86 87 ! 87 88 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 89 90 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - - 90 91 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 91 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 92 REAL(dp), DIMENSION(jpi,jpj,jpk) :: zwx, zwy, zwz 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, ztu, ztv, zltu, zltv, ztw 92 94 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz, zptry 93 95 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup … … 258 260 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 259 261 ! 260 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)261 !262 262 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes 263 263 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points (x2) … … 283 283 ! 284 284 CASE( 4 ) !- 4th order COMPACT 285 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point285 CALL interp_4th_cpt( CASTWP(pt(:,:,:,jn,Kmm)) , ztw ) ! zwt = COMPACT interpolation of T at w-point 286 286 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 287 287 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) … … 294 294 ! 295 295 IF (nn_hls.EQ.1) THEN 296 #if defined key_single 297 CALL lbc_lnk ( 'traadv_fct', zwi, 'T', 1.0_wp ) 298 CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 299 #else 296 300 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 301 #endif 297 302 ELSE 298 303 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) … … 300 305 ! 301 306 IF (nn_hls.EQ.1) THEN 307 #if defined key_single 308 CALL lbc_lnk ( 'traadv_fct', zwi, 'T', 1.0_wp ) 309 CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 310 #else 302 311 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 312 #endif 303 313 ELSE 304 314 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) … … 325 335 ! !== monotonicity algorithm ==! 326 336 ! 327 CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt )337 CALL nonosc( Kmm, CASTWP(pt(:,:,:,jn,Kbb)), zwx, zwy, zwz, zwi, p2dt ) 328 338 ! 329 339 ! !== final trend with corrected fluxes ==! … … 357 367 ! 358 368 IF( l_trd ) THEN ! trend diagnostics 359 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) )360 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) )361 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) )369 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, CASTWP(pt(:,:,:,jn,Kmm)) ) 370 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, CASTWP(pt(:,:,:,jn,Kmm)) ) 371 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, CASTWP(pt(:,:,:,jn,Kmm)) ) 362 372 ENDIF 363 373 ! ! heat/salt transport … … 402 412 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pbef ! before field 403 413 REAL(wp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(in ) :: paft ! after field 404 REAL( wp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions414 REAL(dp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 405 415 ! 406 416 INTEGER :: ji, jj, jk ! dummy loop indices
Note: See TracChangeset
for help on using the changeset viewer.