Changeset 13881
- Timestamp:
- 2020-11-26T10:40:14+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src
- Files:
-
- 2 added
- 4 edited
-
OCE/TRA/traadv.F90 (modified) (2 diffs)
-
OCE/TRA/traadv_fct.F90 (modified) (13 diffs)
-
OCE/TRA/traadv_fct_lf.F90 (added)
-
OCE/TRA/traadv_mus.F90 (modified) (4 diffs)
-
OCE/TRA/traadv_mus_lf.F90 (added)
-
TOP/TRP/trcadv.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv.F90
r13701 r13881 23 23 USE traadv_cen ! centered scheme (tra_adv_cen routine) 24 24 USE traadv_fct ! FCT scheme (tra_adv_fct routine) 25 USE traadv_fct_lf ! FCT scheme (tra_adv_fct routine - loop fusion version) 25 26 USE traadv_mus ! MUSCL scheme (tra_adv_mus routine) 27 USE traadv_mus_lf ! MUSCL scheme (tra_adv_mus routine - loop fusion version) 26 28 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 27 29 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) … … 146 148 ! 147 149 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 148 IF (nn_hls.EQ.2) CALL lbc_lnk( 'tra adv', pts(:,:,:,:,Kmm), 'T', 1. )150 IF (nn_hls.EQ.2) CALL lbc_lnk( 'tra_adv', pts(:,:,:,:,Kmm), 'T', 1. ) 149 151 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 150 152 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 151 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 152 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) ; END IF 153 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 153 IF (nn_hls.EQ.2) THEN 154 CALL lbc_lnk_multi( 'tra_adv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 155 CALL lbc_lnk_multi( 'tra_adv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 156 CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 157 ELSE 158 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 159 END IF 154 160 CASE ( np_MUS ) ! MUSCL 155 CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 161 IF (nn_hls.EQ.2) THEN 162 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 163 ELSE 164 CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 165 END IF 156 166 CASE ( np_UBS ) ! UBS 157 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'tra adv', pts(:,:,:,:,Kbb), 'T', 1.)167 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'tra_adv', pts(:,:,:,:,Kbb), 'T', 1.) 158 168 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 159 169 CASE ( np_QCK ) ! QUICKEST 160 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'tra adv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)161 CALL lbc_lnk( 'tra adv', pts(:,:,:,:,Kbb), 'T', 1.) ; END IF170 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'tra_adv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 171 CALL lbc_lnk( 'tra_adv', pts(:,:,:,:,Kbb), 'T', 1.) ; END IF 162 172 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 163 173 ! -
NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv_fct.F90
r13660 r13881 34 34 PUBLIC tra_adv_fct ! called by traadv.F90 35 35 PUBLIC interp_4th_cpt ! called by traadv_cen.F90 36 PUBLIC tridia_solver ! called by traadv_fct_lf.F90 37 PUBLIC nonosc ! called by traadv_fct_lf.F90 - key_agrif 36 38 37 39 LOGICAL :: l_trd ! flag to compute trends … … 134 136 IF( ll_zAimp ) THEN 135 137 ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 136 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )138 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 137 139 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) & 138 140 & / e3t(ji,jj,jk,Krhs) … … 146 148 ! !== upstream advection with initial mass fluxes & intermediate update ==! 147 149 ! !* upstream tracer flux in the i and j direction 148 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )150 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 149 151 ! upstream scheme 150 152 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) … … 173 175 ENDIF 174 176 ! 175 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* trend and after field with monotonic scheme177 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme 176 178 ! ! total intermediate advective trends 177 179 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 189 191 ! 190 192 ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 191 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask)193 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 192 194 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 193 195 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 213 215 ! 214 216 CASE( 2 ) !- 2nd order centered 215 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )217 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 216 218 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 217 219 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) … … 233 235 CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 234 236 ! 235 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )237 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 236 238 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 237 239 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 248 250 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 249 251 END_3D 252 ! 253 CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 250 254 ! 251 255 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 259 263 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 260 264 END_3D 261 CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)262 265 ! 263 266 END SELECT … … 266 269 ! 267 270 CASE( 2 ) !- 2nd order centered 268 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )271 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 269 272 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 270 273 & - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) … … 273 276 CASE( 4 ) !- 4th order COMPACT 274 277 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point 275 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )278 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 276 279 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 277 280 END_3D … … 282 285 ENDIF 283 286 ! 284 IF (nn_hls.EQ.1) THEN 285 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 ) 286 ELSE 287 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 288 END IF 287 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 ) 289 288 ! 290 289 IF ( ll_zAimp ) THEN 291 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* trend and after field with monotonic scheme290 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme 292 291 ! ! total intermediate advective trends 293 292 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 299 298 CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 300 299 ! 301 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask)300 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 302 301 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 303 302 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) -
NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv_mus.F90
r13619 r13881 132 132 zwx(:,:,jpk) = 0._wp ! bottom values 133 133 zwy(:,:,jpk) = 0._wp 134 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )134 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 135 135 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 136 136 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 137 137 END_3D 138 138 ! lateral boundary conditions (changed sign) 139 IF ( nn_hls.EQ.1 )CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )139 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 140 140 ! !-- Slopes of tracer 141 141 zslpx(:,:,jpk) = 0._wp ! bottom values 142 142 zslpy(:,:,jpk) = 0._wp 143 DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )143 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 144 144 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 145 145 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 148 148 END_3D 149 149 ! 150 DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) !-- Slopes limitation150 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) !-- Slopes limitation 151 151 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 152 152 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 157 157 END_3D 158 158 ! 159 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes159 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes 160 160 ! MUSCL fluxes 161 161 z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) … … 173 173 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 174 174 END_3D 175 IF ( nn_hls.EQ.1 )CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign)175 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign) 176 176 ! 177 177 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Tracer advective trend -
NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/TOP/TRP/trcadv.F90
r13701 r13881 22 22 USE traadv_cen ! centered scheme (tra_adv_cen routine) 23 23 USE traadv_fct ! FCT scheme (tra_adv_fct routine) 24 USE traadv_fct_lf ! FCT scheme (tra_adv_fct routine - loop fusion version) 24 25 USE traadv_mus ! MUSCL scheme (tra_adv_mus routine) 26 USE traadv_mus_lf ! MUSCL scheme (tra_adv_mus routine - loop fusion version) 25 27 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 26 28 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) … … 124 126 ! 125 127 CASE ( np_CEN ) ! Centered : 2nd / 4th order 126 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trc adv', ptr(:,:,:,:,Kmm), 'T', 1.)128 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trc_adv', ptr(:,:,:,:,Kmm), 'T', 1.) 127 129 CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 128 130 CASE ( np_FCT ) ! FCT : 2nd / 4th order 129 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 130 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) ; END IF 131 CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 131 IF (nn_hls.EQ.2) THEN 132 CALL lbc_lnk_multi( 'trc_adv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 133 CALL lbc_lnk_multi( 'trc_adv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 134 CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 135 ELSE 136 CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 137 END IF 132 138 CASE ( np_MUS ) ! MUSCL 133 CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 139 IF (nn_hls.EQ.2) THEN 140 CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 141 ELSE 142 CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 143 END IF 134 144 CASE ( np_UBS ) ! UBS 135 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trc adv', ptr(:,:,:,:,Kbb), 'T', 1.)145 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trc_adv', ptr(:,:,:,:,Kbb), 'T', 1.) 136 146 CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v ) 137 147 CASE ( np_QCK ) ! QUICKEST 138 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trc adv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)139 CALL lbc_lnk( 'tr aadv', ptr(:,:,:,:,Kbb), 'T', 1.) ; END IF148 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trc_adv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 149 CALL lbc_lnk( 'trc_adv', ptr(:,:,:,:,Kbb), 'T', 1.) ; END IF 140 150 CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs ) 141 151 !
Note: See TracChangeset
for help on using the changeset viewer.
