Changeset 13516 for NEMO/branches
- Timestamp:
- 2020-09-24T20:38:10+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv.F90
r13237 r13516 18 18 USE oce ! ocean dynamics and active tracers 19 19 USE dom_oce ! ocean space and time domain 20 ! TEMP: This change not necessary after trd_tra is tiled and extended haloes development 21 USE domain, ONLY : dom_tile 20 22 USE domvvl ! variable vertical scale factors 21 23 USE sbcwave ! wave module … … 65 67 INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme 66 68 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme 67 69 70 !! * Substitutions 71 # include "do_loop_substitute.h90" 68 72 # include "domzgr_substitute.h90" 69 73 !!---------------------------------------------------------------------- … … 86 90 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 87 91 ! 88 INTEGER :: jk ! dummy loop index 89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! 3D workspace 90 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 92 ! TEMP: This change not necessary after trd_tra is tiled 93 INTEGER :: itile 94 INTEGER :: ji, jj, jk ! dummy loop index 95 ! TEMP: This change not necessary and can be ST_2D(nn_hls) if using XIOS (subdomain support) 96 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww ! 3D workspace 97 ! TEMP: This change not necessary after trd_tra is tiled 98 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ztrdt, ztrds 99 ! TEMP: This change not necessary after extra haloes development 100 LOGICAL :: lskip 91 101 !!---------------------------------------------------------------------- 92 102 ! 93 103 IF( ln_timing ) CALL timing_start('tra_adv') 94 104 ! 95 ! !== effective transport ==! 96 zuu(:,:,jpk) = 0._wp 97 zvv(:,:,jpk) = 0._wp 98 zww(:,:,jpk) = 0._wp 99 IF( ln_wave .AND. ln_sdw ) THEN 100 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 101 zuu(:,:,jk) = & 102 & e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 103 zvv(:,:,jk) = & 104 & e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 105 zww(:,:,jk) = & 106 & e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) ) 107 END DO 108 ELSE 109 DO jk = 1, jpkm1 110 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm) ! eulerian transport only 111 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 112 zww(:,:,jk) = e1e2t(:,:) * ww(:,:,jk) 113 END DO 114 ENDIF 115 ! 116 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 117 zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 118 zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 119 ENDIF 120 ! 121 zuu(:,:,jpk) = 0._wp ! no transport trough the bottom 122 zvv(:,:,jpk) = 0._wp 123 zww(:,:,jpk) = 0._wp 124 ! 125 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 126 & CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary) 127 ! 128 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm ) ! add the mle transport (if necessary) 129 ! 130 CALL iom_put( "uocetr_eff", zuu ) ! output effective transport 131 CALL iom_put( "vocetr_eff", zvv ) 132 CALL iom_put( "wocetr_eff", zww ) 133 ! 134 !!gm ??? 135 CALL dia_ptr( kt, Kmm, zvv ) ! diagnose the effective MSF 136 !!gm ??? 137 ! 138 139 IF( l_trdtra ) THEN !* Save ta and sa trends 140 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 141 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 142 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 143 ENDIF 144 ! 145 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 146 ! 147 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 148 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 149 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 150 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 151 CASE ( np_MUS ) ! MUSCL 152 CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 153 CASE ( np_UBS ) ! UBS 154 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 155 CASE ( np_QCK ) ! QUICKEST 156 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 157 ! 158 END SELECT 159 ! 160 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 161 DO jk = 1, jpkm1 162 ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk) 163 ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk) 164 END DO 165 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt ) 166 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds ) 167 DEALLOCATE( ztrdt, ztrds ) 105 lskip = .FALSE. 106 107 ! TEMP: These changes not necessary if using XIOS (subdomain support) 108 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 109 ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 110 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 111 IF( l_trdtra ) ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 112 ENDIF 113 114 ! TEMP: These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*, ldf_eiv_dia) 115 IF( nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4) .OR. ln_ldfeiv_dia ) THEN 116 IF( ln_tile ) THEN 117 IF( ntile == 1 ) THEN 118 CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 119 ELSE 120 lskip = .TRUE. 121 ENDIF 122 ENDIF 123 ENDIF 124 IF( .NOT. lskip ) THEN 125 126 ! TEMP: This change not necessary after trd_tra is tiled 127 itile = ntile 128 ! !== effective transport ==! 129 ! TODO: NOT TESTED- requires waves 130 IF( ln_wave .AND. ln_sdw ) THEN 131 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 132 zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) ) 133 zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) ) 134 zww(ji,jj,jk) = e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) ) 135 END_3D 136 ELSE 137 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 138 zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) ! eulerian transport only 139 zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 140 zww(ji,jj,jk) = e1e2t(ji,jj) * ww(ji,jj,jk) 141 END_3D 142 ENDIF 143 ! 144 ! TODO: NOT TESTED- requires ztilde 145 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 146 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 147 zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk) 148 zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk) 149 END_3D 150 ENDIF 151 ! 152 DO_2D( 1, 1, 1, 1 ) 153 zuu(ji,jj,jpk) = 0._wp ! no transport trough the bottom 154 zvv(ji,jj,jpk) = 0._wp 155 zww(ji,jj,jpk) = 0._wp 156 END_2D 157 ! 158 ! TEMP: These changes not necessary if using XIOS (subdomain support) 159 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 160 & CALL ldf_eiv_trp( kt, nit000, zuu(ST_2D(nn_hls),:), zvv(ST_2D(nn_hls),:), zww(ST_2D(nn_hls),:), & 161 & 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary) 162 ! 163 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu(ST_2D(nn_hls),:), zvv(ST_2D(nn_hls),:), zww(ST_2D(nn_hls),:), & 164 & 'TRA', Kmm ) ! add the mle transport (if necessary) 165 ! 166 ! TEMP: This change not necessary if using XIOS (subdomain support) 167 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 168 CALL iom_put( "uocetr_eff", zuu ) ! output effective transport 169 CALL iom_put( "vocetr_eff", zvv ) 170 CALL iom_put( "wocetr_eff", zww ) 171 ENDIF 172 ! 173 !!gm ??? 174 ! TEMP: This change not necessary if using XIOS (subdomain support) 175 CALL dia_ptr( kt, Kmm, zvv(ST_2D(nn_hls),:) ) ! diagnose the effective MSF 176 !!gm ??? 177 ! 178 179 IF( l_trdtra ) THEN !* Save ta and sa trends 180 DO_3D( 0, 0, 0, 0, 1, jpk ) 181 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 182 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 183 END_3D 184 ENDIF 185 ! 186 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 187 ! 188 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 189 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 190 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 191 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 192 CASE ( np_MUS ) ! MUSCL 193 CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 194 CASE ( np_UBS ) ! UBS 195 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 196 CASE ( np_QCK ) ! QUICKEST 197 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 198 ! 199 END SELECT 200 ! 201 ! TEMP: These changes not necessary after trd_tra is tiled 202 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 203 DO_3D( 0, 0, 0, 0, 1, jpk ) 204 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 205 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 206 END_3D 207 208 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 209 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 210 211 ! TODO: TO BE TILED- trd_tra 212 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt ) 213 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds ) 214 DEALLOCATE( ztrdt, ztrds ) 215 216 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 217 ENDIF 218 ENDIF 219 220 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*, ldf_eiv_dia) 221 IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 222 168 223 ENDIF 169 224 ! ! print mean trends (used for debugging) 170 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv - Ta: ', mask1=tmask, & 171 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 225 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv - Ta: ', mask1=tmask, & 226 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, & 227 & clinfo3='tra' ) 228 229 ! TEMP: This change not necessary if using XIOS (subdomain support) 230 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 231 DEALLOCATE( zuu, zvv, zww ) 232 ENDIF 172 233 ! 173 234 IF( ln_timing ) CALL timing_stop( 'tra_adv' ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90
r13295 r13516 12 12 !!---------------------------------------------------------------------- 13 13 USE dom_oce ! ocean space and time domain 14 ! TEMP: This change not necessary after trd_tra is tiled 15 USE domain, ONLY : dom_tile 14 16 USE eosbn2 ! equation of state 15 17 USE traadv_fct ! acces to routine interp_4th_cpt … … 71 73 INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme) 72 74 INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme) 75 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 73 76 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 74 77 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 76 79 INTEGER :: ji, jj, jk, jn ! dummy loop indices 77 80 INTEGER :: ierr ! local integer 78 REAL(wp) :: zC2t_u, zC4t_u ! local scalars 79 REAL(wp) :: zC2t_v, zC4t_v ! - - 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zwy, zwz, ztu, ztv, ztw 81 ! TEMP: This change not necessary after trd_tra is tiled 82 INTEGER :: itile 83 REAL(wp) :: zC2t_u, zC2t_v ! local scalars 84 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwx, zwy, zwz, ztu, ztv, ztw, zltu, zltv 85 ! TEMP: This change not necessary after trd_tra is tiled 86 REAL(wp), DIMENSION(:,:,:,:), SAVE, ALLOCATABLE :: ztrdx, ztrdy, ztrdz 81 87 !!---------------------------------------------------------------------- 82 ! 83 IF( kt == kit000 ) THEN 84 IF(lwp) WRITE(numout,*) 85 IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v 86 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 88 ! TEMP: This change not necessary after trd_tra is tiled 89 itile = ntile 90 ! 91 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 92 IF( kt == kit000 ) THEN 93 IF(lwp) WRITE(numout,*) 94 IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v 95 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 96 ENDIF 97 ! ! set local switches 98 l_trd = .FALSE. 99 l_hst = .FALSE. 100 l_ptr = .FALSE. 101 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 102 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 103 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 104 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 105 106 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 107 IF( kt == kit000 .AND. l_trd ) THEN 108 ALLOCATE( ztrdx(jpi,jpj,jpk,jpts), ztrdy(jpi,jpj,jpk,jpts), ztrdz(jpi,jpj,jpk,jpts) ) 109 ENDIF 87 110 ENDIF 88 ! ! set local switches89 l_trd = .FALSE.90 l_hst = .FALSE.91 l_ptr = .FALSE.92 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.93 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.94 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &95 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.96 111 ! 97 112 ! … … 110 125 ! 111 126 CASE( 4 ) !* 4th order centered 112 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 113 ztv(:,:,jpk) = 0._wp 114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 115 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 116 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 117 END_3D 118 CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. 119 ! 120 DO_3D( 0, 0, 1, 0, 1, jpkm1 ) 127 zltu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 128 zltv(:,:,jpk) = 0._wp 129 DO jk = 1, jpkm1 ! Laplacian 130 DO_2D( 1, 0, 1, 0 ) 131 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 132 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 133 END_2D 134 DO_2D( 0, 0, 0, 0 ) 135 zltu(ji,jj,jk) = ztu(ji,jj,jk) + ztu(ji-1,jj,jk) 136 zltv(ji,jj,jk) = ztv(ji,jj,jk) + ztv(ji,jj-1,jk) 137 END_2D 138 END DO 139 CALL lbc_lnk_multi( 'traadv_cen', zltu, 'T', 1. , zltv, 'T', 1. ) ! Lateral boundary cond. (unchanged sgn) 140 ! 141 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 121 142 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! C2 interpolation of T at u- & v-points (x2) 122 143 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 123 ! ! C4 interpolation of T at u- & v-points (x2)124 zC4t_u = zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) )125 zC4t_v = zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) )126 144 ! ! C4 fluxes 127 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * zC4t_u128 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v145 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( zC2t_u + r1_6 * (zltu(ji,jj,jk) - zltu(ji+1,jj,jk)) ) 146 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( zC2t_v + r1_6 * (zltv(ji,jj,jk) - zltv(ji,jj+1,jk)) ) 129 147 END_3D 130 148 ! … … 149 167 ! 150 168 IF( ln_linssh ) THEN !* top value (linear free surf. only as zwz is multiplied by wmask) 169 ! TODO: NOT TESTED- requires isf 151 170 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 152 171 DO_2D( 1, 1, 1, 1 ) … … 154 173 END_2D 155 174 ELSE ! no ice-shelf cavities (only ocean surface) 156 zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 175 DO_2D( 1, 1, 1, 1 ) 176 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 177 END_2D 157 178 ENDIF 158 179 ENDIF … … 166 187 END_3D 167 188 ! ! trend diagnostics 189 ! TEMP: These changes not necessary after trd_tra is tiled 168 190 IF( l_trd ) THEN 169 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 170 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 171 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 172 END IF 173 ! ! "Poleward" heat and salt transports 191 DO_3D( 1, 0, 1, 0, 1, jpk ) 192 ztrdx(ji,jj,jk,jn) = zwx(ji,jj,jk) 193 ztrdy(ji,jj,jk,jn) = zwy(ji,jj,jk) 194 ztrdz(ji,jj,jk,jn) = zwz(ji,jj,jk) 195 END_3D 196 197 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 198 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 199 200 ! TODO: TO BE TILED- trd_tra 201 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx(:,:,:,jn), pU, pt(:,:,:,jn,Kmm) ) 202 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy(:,:,:,jn), pV, pt(:,:,:,jn,Kmm) ) 203 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz(:,:,:,jn), pW, pt(:,:,:,jn,Kmm) ) 204 205 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 206 ENDIF 207 ENDIF 208 ! ! "Poleward" heat and salt transports 174 209 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 175 210 ! ! heat and salt transport -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90
r13295 r13516 15 15 USE oce ! ocean dynamics and active tracers 16 16 USE dom_oce ! ocean space and time domain 17 ! TEMP: This change not necessary after trd_tra is tiled 18 USE domain, ONLY : dom_tile 17 19 USE trc_oce ! share passive tracers/Ocean variables 18 20 USE trd_oce ! trends: ocean variables … … 79 81 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 80 82 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 83 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 81 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 82 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 83 86 ! 84 87 INTEGER :: ji, jj, jk, jn ! dummy loop indices 88 ! TEMP: This change not necessary after trd_tra is tiled 89 INTEGER :: itile 85 90 REAL(wp) :: ztra ! local scalar 86 91 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - - 87 92 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 89 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz, zptry 90 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup 93 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 94 ! TEMP: This change not necessary after trd_tra is tiled 95 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdx, ztrdy, ztrdz 96 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zptry 97 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zwinf, zwdia, zwsup 91 98 LOGICAL :: ll_zAimp ! flag to apply adaptive implicit vertical advection 92 99 !!---------------------------------------------------------------------- 93 ! 94 IF( kt == kit000 ) THEN 95 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype 97 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 98 ENDIF 100 ! TEMP: This change not necessary after trd_tra is tiled 101 itile = ntile 102 ! 103 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 104 IF( kt == kit000 ) THEN 105 IF(lwp) WRITE(numout,*) 106 IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype 107 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 108 ENDIF 99 109 !! -- init to 0 100 110 zwi(:,:,:) = 0._wp … … 107 117 zltv(:,:,:) = 0._wp 108 118 ztw(:,:,:) = 0._wp 109 ! 110 l_trd = .FALSE. ! set local switches 111 l_hst = .FALSE. 112 l_ptr = .FALSE. 113 ll_zAimp = .FALSE. 114 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 115 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 116 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 117 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 118 ! 119 IF( l_trd .OR. l_hst ) THEN 120 ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 121 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 119 ! 120 l_trd = .FALSE. ! set local switches 121 l_hst = .FALSE. 122 l_ptr = .FALSE. 123 ll_zAimp = .FALSE. 124 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 125 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 126 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 127 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 128 ! 129 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 130 IF( kt == kit000 .AND. (l_trd .OR. l_hst) ) THEN 131 ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 132 ENDIF 122 133 ENDIF 123 134 ! 124 135 IF( l_ptr ) THEN 125 ALLOCATE( zptry( jpi,jpj,jpk) )136 ALLOCATE( zptry(ST_2D(nn_hls),jpk) ) 126 137 zptry(:,:,:) = 0._wp 127 138 ENDIF … … 134 145 ! If adaptive vertical advection, check if it is needed on this PE at this time 135 146 IF( ln_zad_Aimp ) THEN 136 IF( MAXVAL( ABS( wi( :,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE.147 IF( MAXVAL( ABS( wi(ST_2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 137 148 END IF 138 149 ! If active adaptive vertical advection, build tridiagonal matrix 139 150 IF( ll_zAimp ) THEN 140 ALLOCATE(zwdia( jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk))151 ALLOCATE(zwdia(ST_2D(nn_hls),jpk), zwinf(ST_2D(nn_hls),jpk), zwsup(ST_2D(nn_hls),jpk)) 141 152 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 142 153 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) & … … 167 178 END_3D 168 179 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 180 ! TODO: NOT TESTED- requires isf 169 181 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 170 182 DO_2D( 1, 1, 1, 1 ) … … 207 219 END IF 208 220 ! 221 ! TEMP: This change not necessary after trd_tra is tiled 209 222 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 210 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 223 DO_3D( 1, 0, 1, 0, 1, jpk ) 224 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) ; ztrdy(ji,jj,jk) = zwy(ji,jj,jk) ; ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 225 END_3D 211 226 END IF 212 227 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 336 351 END IF 337 352 ! 353 ! TEMP: These changes not necessary after trd_tra is tiled 338 354 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics // heat/salt transport 339 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< add anti-diffusive fluxes 340 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! to upstream fluxes 341 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! 342 ! 343 IF( l_trd ) THEN ! trend diagnostics 344 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 345 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 346 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 355 DO_3D( 1, 0, 1, 0, 1, jpk ) 356 ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk) ! <<< add anti-diffusive fluxes 357 ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk) ! to upstream fluxes 358 ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk) ! 359 END_3D 360 ! 361 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 362 IF( l_trd ) THEN ! trend diagnostics 363 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 364 365 ! TODO: TO BE TILED- trd_tra 366 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 367 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 368 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 369 370 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 371 ENDIF 347 372 ENDIF 348 373 ! ! heat/salt transport 349 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx( :,:,:), ztrdy(:,:,:) )374 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(ST_2D(nn_hls),:), ztrdy(ST_2D(nn_hls),:) ) 350 375 ! 351 376 ENDIF … … 360 385 DEALLOCATE( zwdia, zwinf, zwsup ) 361 386 ENDIF 362 IF( l_trd .OR. l_hst ) THEN 363 DEALLOCATE( ztrdx, ztrdy, ztrdz ) 364 ENDIF 387 ! TEMP: These changes not necessary after trd_tra is tiled 388 ! IF( l_trd .OR. l_hst ) THEN 389 ! DEALLOCATE( ztrdx, ztrdy, ztrdz ) 390 ! ENDIF 365 391 IF( l_ptr ) THEN 366 392 DEALLOCATE( zptry ) … … 383 409 !! in-space based differencing for fluid 384 410 !!---------------------------------------------------------------------- 385 INTEGER , INTENT(in ) :: Kmm ! time level index 386 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 387 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field 388 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 411 INTEGER , INTENT(in ) :: Kmm ! time level index 412 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 413 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pbef ! before field 414 REAL(wp), DIMENSION(ST_2D(nn_hls) ,jpk), INTENT(in ) :: paft ! after field 415 REAL(wp), DIMENSION(ST_2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 389 416 ! 390 417 INTEGER :: ji, jj, jk ! dummy loop indices … … 392 419 REAL(dp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 393 420 REAL(dp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 394 REAL(dp), DIMENSION( jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo421 REAL(dp), DIMENSION(ST_2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo 395 422 !!---------------------------------------------------------------------- 396 423 ! … … 402 429 ! -------------------- 403 430 ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 404 zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ), & 405 & paft * tmask - zbig * ( 1._wp - tmask ) ) 406 zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ), & 407 & paft * tmask + zbig * ( 1._wp - tmask ) ) 431 DO_3D( 1, 1, 1, 1, 1, jpk ) 432 zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ), & 433 & paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ) ) 434 zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ), & 435 & paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ) ) 436 END_3D 408 437 409 438 DO jk = 1, jpkm1 … … 537 566 !!---------------------------------------------------------------------- 538 567 REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt_in ! field at t-point 539 REAL(wp),DIMENSION( jpi,jpj,jpk), INTENT( out) :: pt_out ! field interpolated at w-point568 REAL(wp),DIMENSION(ST_2D(nn_hls) ,jpk), INTENT( out) :: pt_out ! field interpolated at w-point 540 569 ! 541 570 INTEGER :: ji, jj, jk ! dummy loop integers 542 571 INTEGER :: ikt, ikb ! local integers 543 REAL(wp),DIMENSION( jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt572 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt 544 573 !!---------------------------------------------------------------------- 545 574 ! … … 561 590 !!gm 562 591 ! 592 ! TODO: NOT TESTED- requires isf 563 593 IF ( ln_isfcav ) THEN ! set level two values which may not be set in ISF case 564 594 zwd(:,:,2) = 1._wp ; zwi(:,:,2) = 0._wp ; zws(:,:,2) = 0._wp ; zwrm(:,:,2) = 0._wp … … 626 656 !! The 3d array zwt is used as a work space array. 627 657 !!---------------------------------------------------------------------- 628 REAL(wp),DIMENSION( :,:,:), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix629 REAL(wp),DIMENSION( :,:,:), INTENT(in ) :: pRHS ! Right-Hand-Side630 REAL(wp),DIMENSION( :,:,:), INTENT( out) :: pt_out !!gm field at level=F(klev)631 INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level632 ! ! =0 pt at t-level658 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix 659 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT(in ) :: pRHS ! Right-Hand-Side 660 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT( out) :: pt_out !!gm field at level=F(klev) 661 INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level 662 ! ! =0 pt at t-level 633 663 INTEGER :: ji, jj, jk ! dummy loop integers 634 664 INTEGER :: kstart ! local indices 635 REAL(wp),DIMENSION( jpi,jpj,jpk) :: zwt ! 3D work array665 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk) :: zwt ! 3D work array 636 666 !!---------------------------------------------------------------------- 637 667 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90
r13295 r13516 19 19 USE trc_oce ! share passive tracers/Ocean variables 20 20 USE dom_oce ! ocean space and time domain 21 ! TEMP: This change not necessary after trd_tra is tiled 22 USE domain, ONLY : dom_tile 21 23 USE trd_oce ! trends: ocean variables 22 24 USE trdtra ! tracers trends manager … … 81 83 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 82 84 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 85 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 83 86 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 84 87 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 85 88 ! 89 ! TEMP: This change not necessary after trd_tra is tiled 90 INTEGER :: itile 86 91 INTEGER :: ji, jj, jk, jn ! dummy loop indices 87 92 INTEGER :: ierr ! local integer 88 93 REAL(wp) :: zu, z0u, zzwx, zw , zalpha ! local scalars 89 94 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zslpx ! 3D workspace 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwy, zslpy ! - - 95 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwx, zslpx ! 3D workspace 96 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwy, zslpy ! - - 97 ! TEMP: This change not necessary after trd_tra is tiled 98 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdx, ztrdy, ztrdz 92 99 !!---------------------------------------------------------------------- 93 ! 94 IF( kt == kit000 ) THEN 95 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 97 IF(lwp) WRITE(numout,*) ' : mixed up-stream ', ld_msc_ups 98 IF(lwp) WRITE(numout,*) '~~~~~~~' 99 IF(lwp) WRITE(numout,*) 100 ! 101 ! Upstream / MUSCL scheme indicator 102 ! 103 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 104 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 105 ! 106 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 107 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 108 upsmsk(:,:) = 0._wp ! not upstream by default 109 ! 110 DO jk = 1, jpkm1 111 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 112 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 113 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 114 END DO 115 ENDIF 116 ! 117 ENDIF 118 ! 119 l_trd = .FALSE. 120 l_hst = .FALSE. 121 l_ptr = .FALSE. 122 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 123 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 124 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 125 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 100 ! TEMP: This change not necessary after trd_tra is tiled 101 itile = ntile 102 ! 103 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 104 IF( kt == kit000 ) THEN 105 IF(lwp) WRITE(numout,*) 106 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 107 IF(lwp) WRITE(numout,*) ' : mixed up-stream ', ld_msc_ups 108 IF(lwp) WRITE(numout,*) '~~~~~~~' 109 IF(lwp) WRITE(numout,*) 110 ! 111 ! Upstream / MUSCL scheme indicator 112 ! 113 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 114 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 115 ! 116 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 117 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 118 upsmsk(:,:) = 0._wp ! not upstream by default 119 ! 120 DO jk = 1, jpkm1 121 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 122 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 123 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 124 END DO 125 ENDIF 126 ! 127 ENDIF 128 ! 129 l_trd = .FALSE. 130 l_hst = .FALSE. 131 l_ptr = .FALSE. 132 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 133 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 134 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 135 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 136 137 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 138 IF( kt == kit000 .AND. l_trd ) THEN 139 ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 140 ENDIF 141 ENDIF 126 142 ! 127 143 DO jn = 1, kjpt !== loop over the tracers ==! … … 181 197 END_3D 182 198 ! ! trend diagnostics 199 ! TEMP: These changes not necessary after trd_tra is tiled 183 200 IF( l_trd ) THEN 184 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kbb) ) 185 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) ) 201 DO_3D( 1, 0, 1, 0, 1, jpk ) 202 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 203 ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 204 END_3D 205 206 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 207 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 208 209 ! TODO: TO BE TILED- trd_tra 210 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kbb) ) 211 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kbb) ) 212 213 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 214 ENDIF 186 215 END IF 187 216 ! ! "Poleward" heat and salt transports … … 195 224 zwx(:,:, 1 ) = 0._wp ! surface & bottom boundary conditions 196 225 zwx(:,:,jpk) = 0._wp 197 DO jk = 2, jpkm1! interior values198 zwx( :,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn,Kbb) - pt(:,:,jk,jn,Kbb) )199 END DO226 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! interior values 227 zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 228 END_3D 200 229 ! !-- Slopes of tracer 201 230 zslpx(:,:,1) = 0._wp ! surface values … … 218 247 END_3D 219 248 IF( ln_linssh ) THEN ! top values, linear free surface only 249 ! TODO: NOT TESTED- requires isf 220 250 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 221 251 DO_2D( 1, 1, 1, 1 ) … … 223 253 END_2D 224 254 ELSE ! no cavities: only at the ocean surface 225 zwx(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 255 DO_2D( 1, 1, 1, 1 ) 256 zwx(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 257 END_2D 226 258 ENDIF 227 259 ENDIF … … 232 264 END_3D 233 265 ! ! send trends for diagnostic 234 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwx, pW, pt(:,:,:,jn,Kbb) ) 266 ! TEMP: These changes not necessary after trd_tra is tiled 267 IF( l_trd ) THEN 268 DO_3D( 0, 0, 0, 0, 1, jpk ) 269 ztrdz(ji,jj,jk) = zwx(ji,jj,jk) 270 END_3D 271 272 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 273 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 274 275 ! TODO: TO BE TILED- trd_tra 276 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kbb) ) 277 278 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 279 ENDIF 280 ENDIF 235 281 ! 236 282 END DO ! end of tracer loop -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_qck.F90
r13295 r13516 17 17 USE oce ! ocean dynamics and active tracers 18 18 USE dom_oce ! ocean space and time domain 19 ! TEMP: This change not necessary after trd_tra is tiled 20 USE domain, ONLY : dom_tile 19 21 USE trc_oce ! share passive tracers/Ocean variables 20 22 USE trd_oce ! trends: ocean variables … … 91 93 INTEGER , INTENT(in ) :: kjpt ! number of tracers 92 94 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 95 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 93 96 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 94 97 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 95 98 !!---------------------------------------------------------------------- 96 99 ! 97 IF( kt == kit000 ) THEN 98 IF(lwp) WRITE(numout,*) 99 IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype 100 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 101 IF(lwp) WRITE(numout,*) 100 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 101 IF( kt == kit000 ) THEN 102 IF(lwp) WRITE(numout,*) 103 IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype 104 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 105 IF(lwp) WRITE(numout,*) 106 ENDIF 107 ! 108 l_trd = .FALSE. 109 l_ptr = .FALSE. 110 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 111 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 102 112 ENDIF 103 !104 l_trd = .FALSE.105 l_ptr = .FALSE.106 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.107 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.108 113 ! 109 114 ! … … 127 132 INTEGER , INTENT(in ) :: kjpt ! number of tracers 128 133 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 134 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 129 135 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU ! i-velocity components 130 136 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 131 137 !! 138 ! TEMP: This change not necessary after trd_tra is tiled 139 INTEGER :: itile 132 140 INTEGER :: ji, jj, jk, jn ! dummy loop indices 133 141 REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars 134 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zfu, zfc, zfd 142 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwx, zfu, zfc, zfd 143 ! TEMP: This change not necessary after trd_tra is tiled 144 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdx 135 145 !---------------------------------------------------------------------- 136 ! 146 ! TEMP: This change not necessary after trd_tra is tiled 147 itile = ntile 148 ! 149 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 150 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 151 IF( kt == nit000 .AND. l_trd ) THEN 152 ALLOCATE( ztrdx(jpi,jpj,jpk) ) 153 ENDIF 154 ENDIF 137 155 ! ! =========== 138 156 DO jn = 1, kjpt ! tracer loop … … 200 218 END_3D 201 219 ! ! trend diagnostics 202 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 220 ! TEMP: These changes not necessary after trd_tra is tiled 221 IF( l_trd ) THEN 222 DO_3D( 1, 0, 1, 0, 1, jpk ) 223 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 224 END_3D 225 226 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 227 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 228 229 ! TODO: TO BE TILED- trd_tra 230 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 231 232 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 233 ENDIF 234 ENDIF 203 235 ! 204 236 END DO … … 216 248 INTEGER , INTENT(in ) :: kjpt ! number of tracers 217 249 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 250 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 218 251 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pV ! j-velocity components 219 252 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 220 253 !! 254 ! TEMP: This change not necessary after trd_tra is tiled 255 INTEGER :: itile 221 256 INTEGER :: ji, jj, jk, jn ! dummy loop indices 222 257 REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars 223 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwy, zfu, zfc, zfd ! 3D workspace 258 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwy, zfu, zfc, zfd ! 3D workspace 259 ! TEMP: This change not necessary after trd_tra is tiled 260 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdy 224 261 !---------------------------------------------------------------------- 225 ! 262 ! TEMP: This change not necessary after trd_tra is tiled 263 itile = ntile 264 ! 265 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 266 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 267 IF( kt == nit000 .AND. l_trd ) THEN 268 ALLOCATE( ztrdy(jpi,jpj,jpk) ) 269 ENDIF 270 ENDIF 226 271 ! ! =========== 227 272 DO jn = 1, kjpt ! tracer loop … … 296 341 END_3D 297 342 ! ! trend diagnostics 298 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 343 ! TEMP: These changes not necessary after trd_tra is tiled 344 IF( l_trd ) THEN 345 DO_3D( 1, 0, 1, 0, 1, jpk ) 346 ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 347 END_3D 348 349 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 350 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 351 352 ! TODO: TO BE TILED- trd_tra 353 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 354 355 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 356 ENDIF 357 ENDIF 299 358 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 300 359 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) … … 313 372 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 314 373 INTEGER , INTENT(in ) :: kjpt ! number of tracers 315 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pW ! vertical velocity 374 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 375 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pW ! vertical velocity 316 376 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 317 377 ! 378 ! TEMP: This change not necessary after trd_tra is tiled 379 INTEGER :: itile 318 380 INTEGER :: ji, jj, jk, jn ! dummy loop indices 319 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz ! 3D workspace 320 !!---------------------------------------------------------------------- 321 ! 381 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwz ! 3D workspace 382 ! TEMP: This change not necessary after trd_tra is tiled 383 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdz 384 !!---------------------------------------------------------------------- 385 ! TEMP: This change not necessary after trd_tra is tiled 386 itile = ntile 387 ! 388 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 389 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 390 IF( kt == nit000 .AND. l_trd ) THEN 391 ALLOCATE( ztrdz(jpi,jpj,jpk) ) 392 ENDIF 393 ENDIF 394 322 395 zwz(:,:, 1 ) = 0._wp ! surface & bottom values set to zero for all tracers 323 396 zwz(:,:,jpk) = 0._wp … … 331 404 END_3D 332 405 IF( ln_linssh ) THEN !* top value (only in linear free surf. as zwz is multiplied by wmask) 406 ! TODO: NOT TESTED- requires isf 333 407 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 334 408 DO_2D( 1, 1, 1, 1 ) … … 336 410 END_2D 337 411 ELSE ! no ocean cavities (only ocean surface) 338 zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 412 DO_2D( 1, 1, 1, 1 ) 413 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 414 END_2D 339 415 ENDIF 340 416 ENDIF … … 345 421 END_3D 346 422 ! ! Send trends for diagnostic 347 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 423 ! TEMP: These changes not necessary after trd_tra is tiled 424 IF( l_trd ) THEN 425 DO_3D( 0, 0, 0, 0, 1, jpk ) 426 ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 427 END_3D 428 429 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 430 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 431 432 ! TODO: TO BE TILED- trd_tra 433 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 434 435 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 436 ENDIF 437 ENDIF 348 438 ! 349 439 END DO … … 359 449 !! ** Method : 360 450 !!---------------------------------------------------------------------- 361 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pfu ! second upwind point362 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pfd ! first douwning point363 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pfc ! the central point (or the first upwind point)364 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: puc ! input as Courant number ; output as flux451 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in ) :: pfu ! second upwind point 452 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in ) :: pfd ! first douwning point 453 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in ) :: pfc ! the central point (or the first upwind point) 454 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: puc ! input as Courant number ; output as flux 365 455 !! 366 456 INTEGER :: ji, jj, jk ! dummy loop indices -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_ubs.F90
r13295 r13516 14 14 USE oce ! ocean dynamics and active tracers 15 15 USE dom_oce ! ocean space and time domain 16 ! TEMP: This change not necessary after trd_tra is tiled 17 USE domain, ONLY : dom_tile 16 18 USE trc_oce ! share passive tracers/Ocean variables 17 19 USE trd_oce ! trends: ocean variables … … 92 94 INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers 93 95 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 96 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 94 97 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 95 98 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 96 99 ! 100 ! TEMP: This change not necessary after trd_tra is tiled 101 INTEGER :: itile 97 102 INTEGER :: ji, jj, jk, jn ! dummy loop indices 98 103 REAL(wp) :: ztra, zbtr, zcoef ! local scalars 99 104 REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - - 100 105 REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - - 101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv, zti, ztw ! 3D workspace 102 !!---------------------------------------------------------------------- 103 ! 104 IF( kt == kit000 ) THEN 105 IF(lwp) WRITE(numout,*) 106 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype 107 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 106 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: ztu, ztv, zltu, zltv, zti, ztw ! 3D workspace 107 ! TEMP: This change not necessary after trd_tra is tiled 108 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdx, ztrdy, ztrdz 109 !!---------------------------------------------------------------------- 110 ! TEMP: This change not necessary after trd_tra is tiled 111 itile = ntile 112 ! 113 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 114 IF( kt == kit000 ) THEN 115 IF(lwp) WRITE(numout,*) 116 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype 117 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 118 ENDIF 119 ! 120 l_trd = .FALSE. 121 l_hst = .FALSE. 122 l_ptr = .FALSE. 123 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 124 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 125 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 126 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 127 128 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 129 IF( kt == kit000 .AND. l_trd ) THEN 130 ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 131 ENDIF 108 132 ENDIF 109 !110 l_trd = .FALSE.111 l_hst = .FALSE.112 l_ptr = .FALSE.113 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.114 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.115 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &116 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.117 133 ! 118 134 ztw (:,:, 1 ) = 0._wp ! surface & bottom value : set to zero for all tracers … … 153 169 END_3D 154 170 ! 155 zltu(:,:,:) = pt(:,:,:,jn,Krhs) ! store the initial trends before its update 171 DO_3D( 1, 1, 1, 1, 1, jpk ) 172 zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) ! store the initial trends before its update 173 END_3D 156 174 ! 157 175 DO jk = 1, jpkm1 !== add the horizontal advective trend ==! … … 165 183 END DO 166 184 ! 167 zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case 168 ! ! and/or in trend diagnostic (l_trd=T) 169 ! 185 DO_3D( 1, 1, 1, 1, 1, jpk ) 186 zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk) ! Horizontal advective trend used in vertical 2nd order FCT case 187 END_3D ! and/or in trend diagnostic (l_trd=T) 188 ! 189 ! TEMP: These changes not necessary after trd_tra is tiled 170 190 IF( l_trd ) THEN ! trend diagnostics 171 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) ) 172 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) ) 191 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 192 ztrdx(ji,jj,jk) = ztu(ji,jj,jk) 193 ztrdy(ji,jj,jk) = ztv(ji,jj,jk) 194 END_3D 195 196 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 197 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 198 199 ! TODO: TO BE TILED- trd_tra 200 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 201 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 202 203 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 204 ENDIF 173 205 END IF 174 206 ! … … 185 217 CASE( 2 ) ! 2nd order FCT 186 218 ! 187 IF( l_trd ) zltv(:,:,:) = pt(:,:,:,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 219 IF( l_trd ) THEN 220 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 221 zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 222 END_3D 223 ENDIF 188 224 ! 189 225 ! !* upstream advection with initial mass fluxes & intermediate update ==! … … 194 230 END_3D 195 231 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked) 232 ! TODO: NOT TESTED- requires isf 196 233 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 197 234 DO_2D( 1, 1, 1, 1 ) … … 199 236 END_2D 200 237 ELSE ! no cavities: only at the ocean surface 201 ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 238 DO_2D( 1, 1, 1, 1 ) 239 ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 240 END_2D 202 241 ENDIF 203 242 ENDIF … … 226 265 ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 227 266 END_3D 228 IF( ln_linssh ) ztw(:,:, 1 ) = pW(:,:,1) * pt(:,:,1,jn,Kmm) !!gm ISF & 4th COMPACT doesn't work 267 IF( ln_linssh ) THEN 268 DO_2D( 1, 1, 1, 1 ) 269 ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) !!gm ISF & 4th COMPACT doesn't work 270 END_2D 271 ENDIF 229 272 ! 230 273 END SELECT … … 235 278 END_3D 236 279 ! 280 ! TEMP: These changes not necessary after trd_tra is tiled 237 281 IF( l_trd ) THEN ! vertical advective trend diagnostics 238 282 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 239 z ltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) &283 ztrdz(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) & 240 284 & + pt(ji,jj,jk,jn,Kmm) * ( pW(ji,jj,jk) - pW(ji,jj,jk+1) ) & 241 285 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 242 286 END_3D 243 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zltv ) 287 288 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 289 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 290 291 ! TODO: TO BE TILED- trd_tra 292 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz ) 293 294 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 295 ENDIF 244 296 ENDIF 245 297 ! … … 262 314 !! in-space based differencing for fluid 263 315 !!---------------------------------------------------------------------- 264 INTEGER , INTENT(in ) 265 REAL(wp), INTENT(in ) 266 REAL(wp), DIMENSION 267 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: paft ! after field268 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: pcc ! monotonic flux in the k direction316 INTEGER , INTENT(in ) :: Kmm ! time level index 317 REAL(wp), INTENT(in ) :: p2dt ! tracer time-step 318 REAL(wp), DIMENSION(jpi,jpj,jpk) :: pbef ! before field 319 REAL(wp), INTENT(inout), DIMENSION(ST_2D(nn_hls) ,jpk) :: paft ! after field 320 REAL(wp), INTENT(inout), DIMENSION(ST_2D(nn_hls) ,jpk) :: pcc ! monotonic flux in the k direction 269 321 ! 270 322 INTEGER :: ji, jj, jk ! dummy loop indices 271 323 INTEGER :: ikm1 ! local integer 272 324 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 273 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zbetup, zbetdo! 3D workspace325 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zbetup, zbetdo ! 3D workspace 274 326 !!---------------------------------------------------------------------- 275 327 ! … … 281 333 ! -------------------- 282 334 ! ! large negative value (-zbig) inside land 283 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 284 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 335 DO_3D( 0, 0, 0, 0, 1, jpk ) 336 pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) ) 337 paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) ) 338 END_3D 285 339 ! 286 340 DO jk = 1, jpkm1 ! search maximum in neighbourhood … … 293 347 END DO 294 348 ! ! large positive value (+zbig) inside land 295 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 296 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 349 DO_3D( 0, 0, 0, 0, 1, jpk ) 350 pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) ) 351 paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) ) 352 END_3D 297 353 ! 298 354 DO jk = 1, jpkm1 ! search minimum in neighbourhood … … 305 361 END DO 306 362 ! ! restore masked values to zero 307 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) 308 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) 363 DO_3D( 0, 0, 0, 0, 1, jpk ) 364 pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) 365 paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) 366 END_3D 309 367 ! 310 368 ! Positive and negative part of fluxes and beta terms -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90
r13295 r13516 79 79 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 80 80 !!---------------------------------------------------------------------- 81 INTEGER 82 INTEGER 83 INTEGER 84 CHARACTER(len=3) 85 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pu ! in : 3 ocean transport components86 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pv ! out: same 3 transport components87 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pw ! increased by the MLE induced transport81 INTEGER , INTENT(in ) :: kt ! ocean time-step index 82 INTEGER , INTENT(in ) :: kit000 ! first time step index 83 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 84 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 85 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components 86 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: pv ! out: same 3 transport components 87 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the MLE induced transport 88 88 ! 89 89 INTEGER :: ji, jj, jk ! dummy loop indices … … 91 91 REAL(wp) :: zcuw, zmuw, zc ! local scalar 92 92 REAL(wp) :: zcvw, zmvw ! - - 93 INTEGER , DIMENSION(jpi,jpj) :: inml_mle 94 REAL(wp), DIMENSION(jpi,jpj) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 93 INTEGER , DIMENSION(ST_2D(nn_hls)) :: inml_mle 94 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_MH 95 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw 96 ! TEMP: These changes not necessary if using XIOS (subdomain support) 97 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: zLf_NH 98 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zpsiu_mle, zpsiv_mle 96 99 !!---------------------------------------------------------------------- 97 100 ! 98 101 ! !== MLD used for MLE ==! 99 102 ! ! compute from the 10m density to deal with the diurnal cycle 100 inml_mle(:,:) = mbkt(:,:) + 1 ! init. to number of ocean w-level (T-level + 1) 103 DO_2D( 1, 1, 1, 1 ) 104 inml_mle(ji,jj) = mbkt(ji,jj) + 1 ! init. to number of ocean w-level (T-level + 1) 105 END_2D 101 106 IF ( nla10 > 0 ) THEN ! avoid case where first level is thicker than 10m 102 107 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) … … 135 140 END SELECT 136 141 ! ! convert density into buoyancy 137 zbm(:,:) = + grav * zbm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 142 DO_2D( 1, 1, 1, 1 ) 143 zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 144 END_2D 138 145 ! 139 146 ! … … 206 213 END DO 207 214 215 ! TEMP: These changes not necessary if using XIOS (subdomain support) 208 216 IF( cdtype == 'TRA') THEN !== outputs ==! 209 ! 210 zLf_NH(:,:) = SQRT( rb_c * zmld(:,:) ) * r1_ft(:,:) ! Lf = N H / f 211 CALL iom_put( "Lf_NHpf" , zLf_NH ) ! Lf = N H / f 217 IF( kt == nit000 .AND. (ntile == 0 .OR. ntile == 1) ) THEN ! Do only on the first tile and timestep 218 ALLOCATE( zLf_NH(jpi,jpj), zpsiu_mle(jpi,jpj,jpk), zpsiv_mle(jpi,jpj,jpk) ) 219 ENDIF 220 ! 221 DO_2D( 1, 1, 1, 1 ) 222 zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 223 END_2D 212 224 ! 213 225 ! divide by cross distance to give streamfunction with dimensions m^2/s 214 DO jk = 1, ikmax+1 215 zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:) 216 zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:) 217 END DO 218 CALL iom_put( "psiu_mle", zpsi_uw ) ! i-mle streamfunction 219 CALL iom_put( "psiv_mle", zpsi_vw ) ! j-mle streamfunction 226 DO_3D( 1, 1, 1, 1, 1, ikmax+1 ) 227 zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 228 zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj) 229 END_3D 230 231 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 232 CALL iom_put( "Lf_NHpf" , zLf_NH ) ! Lf = N H / f 233 CALL iom_put( "psiu_mle", zpsiu_mle ) ! i-mle streamfunction 234 CALL iom_put( "psiv_mle", zpsiv_mle ) ! j-mle streamfunction 235 ENDIF 220 236 ENDIF 221 237 !
Note: See TracChangeset
for help on using the changeset viewer.