Changeset 14680
- Timestamp:
- 2021-04-07T19:16:18+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domqco.F90
r14574 r14680 154 154 #if ! defined key_qcoTest_FluxForm 155 155 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 156 DO_2D( 0, 0, 0, 0 ) 156 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 157 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 157 158 pr3u(ji,jj) = 0.5_wp * ( e1e2t(ji ,jj) * pssh(ji ,jj) & 158 159 & + e1e2t(ji+1,jj) * pssh(ji+1,jj) ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) … … 162 163 !!st ELSE !- Flux Form (simple averaging) 163 164 #else 164 DO_2D( 0, 0, 0, 0 ) 165 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 166 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 165 167 pr3u(ji,jj) = 0.5_wp * ( pssh(ji,jj) + pssh(ji+1,jj ) ) * r1_hu_0(ji,jj) 166 168 pr3v(ji,jj) = 0.5_wp * ( pssh(ji,jj) + pssh(ji ,jj+1) ) * r1_hv_0(ji,jj) … … 170 172 ! 171 173 IF( .NOT.PRESENT( pr3f ) ) THEN !- lbc on ratio at u-, v-points only 172 CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp )174 IF (nn_hls.eq.1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 173 175 ! 174 176 ! … … 179 181 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 180 182 181 DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 182 pr3f(ji,jj) = 0.25_wp * ( e1e2t(ji ,jj ) * pssh(ji ,jj ) & 183 & + e1e2t(ji+1,jj ) * pssh(ji+1,jj ) & 184 & + e1e2t(ji ,jj+1) * pssh(ji ,jj+1) & 185 & + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 183 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 184 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 185 ! round brackets added to fix the order of floating point operations 186 ! needed to ensure halo 1 - halo 2 compatibility 187 pr3f(ji,jj) = 0.25_wp * ( ( e1e2t(ji ,jj ) * pssh(ji ,jj ) & 188 & + e1e2t(ji+1,jj ) * pssh(ji+1,jj ) & 189 & ) & ! bracket for halo 1 - halo 2 compatibility 190 & + ( e1e2t(ji ,jj+1) * pssh(ji ,jj+1) & 191 & + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1) & 192 & ) & ! bracket for halo 1 - halo 2 compatibility 193 & ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 186 194 END_2D 187 195 !!st ELSE !- Flux Form (simple averaging) 188 196 #else 189 DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 190 pr3f(ji,jj) = 0.25_wp * ( pssh(ji,jj ) + pssh(ji+1,jj ) & 191 & + pssh(ji,jj+1) + pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) 197 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 198 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 199 ! round brackets added to fix the order of floating point operations 200 ! needed to ensure halo 1 - halo 2 compatibility 201 pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj ) + pssh(ji+1,jj ) ) & 202 & + ( pssh(ji,jj+1) + pssh(ji+1,jj+1) & 203 & ) & ! bracket for halo 1 - halo 2 compatibility 204 & ) * r1_hf_0(ji,jj) 192 205 END_2D 193 206 !!st ENDIF 194 207 #endif 195 208 ! ! lbc on ratio at u-,v-,f-points 196 CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp )209 IF (nn_hls.eq.1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 197 210 ! 198 211 ENDIF -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/divhor.F90
r13558 r14680 64 64 ! 65 65 INTEGER :: ji, jj, jk ! dummy loop indices 66 REAL(wp) :: zraur, zdep ! local scalars67 REAL(wp), DIMENSION(jpi,jpj) :: ztmp68 66 !!---------------------------------------------------------------------- 69 67 ! … … 77 75 ENDIF 78 76 ! 79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Horizontal divergence ==! 80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) & 81 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) & 82 & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) & 83 & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm) ) & 84 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 77 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Horizontal divergence ==! 78 DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 ) !== Horizontal divergence ==! 79 ! round brackets added to fix the order of floating point operations 80 ! needed to ensure halo 1 - halo 2 compatibility 81 hdiv(ji,jj,jk) = ( ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) & 82 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) & 83 & ) & ! bracket for halo 1 - halo 2 compatibility 84 & + ( e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) & 85 & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm) & 86 & ) & ! bracket for halo 1 - halo 2 compatibility 87 & ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 85 88 END_3D 86 89 ! … … 91 94 ! 92 95 #endif 93 ! 96 ! WED025 + isomip true 94 97 IF( ln_isf ) CALL isf_hdiv( kt, Kmm, hdiv ) !== ice shelf ==! (update hdiv field) 95 98 ! 96 CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp ) ! (no sign change)99 IF (nn_hls.eq.1) CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp ) ! (no sign change) 97 100 ! 98 101 IF( ln_timing ) CALL timing_stop('div_hor') -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv.F90
r14053 r14680 76 76 CALL dyn_zad ( kt, Kmm, puu, pvv, Krhs ) ! vector form : vertical advection 77 77 CASE( np_FLX_c2 ) 78 ! [comm_cleanup: dyn_adv_cen2 NOT TESTED] 78 79 CALL dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs ) ! 2nd order centered scheme 79 80 CASE( np_FLX_ubs ) 81 ! [comm_cleanup: dyn_adv_ubs NOT TESTED] 80 82 CALL dyn_adv_ubs ( kt, Kbb, Kmm, puu, pvv, Krhs ) ! 3rd order UBS scheme (UP3) 81 83 END SELECT -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv_cen2.F90
r13497 r14680 72 72 zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 73 73 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 74 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes (at T- and F-point) 74 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes (at T- and F-point) 75 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! horizontal momentum fluxes (at T- and F-point) 75 76 zfu_t(ji+1,jj ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 76 77 zfv_f(ji ,jj ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) … … 78 79 zfv_t(ji ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) 79 80 END_2D 80 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 81 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 82 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! divergence of horizontal momentum fluxes 81 83 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 82 84 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 98 100 ! !== Vertical advection ==! 99 101 ! 100 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 102 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 103 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! surface/bottom advective fluxes set to zero 101 104 zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp 102 105 zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp 103 106 END_2D 104 107 IF( ln_linssh ) THEN ! linear free surface: advection through the surface 105 DO_2D( 0, 0, 0, 0 ) 108 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 109 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 106 110 zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 107 111 zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) … … 109 113 ENDIF 110 114 DO jk = 2, jpkm1 ! interior advective fluxes 111 DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport 115 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport 116 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! 1/4 * Vertical transport 112 117 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 113 118 END_2D 114 DO_2D( 0, 0, 0, 0 ) 119 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 120 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 115 121 zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 116 122 zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 117 123 END_2D 118 124 END DO 119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 125 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 126 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 120 127 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 121 128 & / e3u(ji,jj,jk,Kmm) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv_ubs.F90
r14574 r14680 108 108 zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 109 109 ! 110 DO_2D( 0, 0, 0, 0 ) ! laplacian 110 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! laplacian 111 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! laplacian 111 112 zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj ,jk,Kbb) ) * umask(ji,jj,jk) 112 113 zlv_vv(ji,jj,jk,1) = ( pvv (ji ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) … … 124 125 END_2D 125 126 END DO 126 CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp, &127 & zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp, &128 & zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp, &129 & zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp )127 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp, & 128 & zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp, & 129 & zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp, & 130 & zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp ) 130 131 ! 131 132 ! ! ====================== ! … … 136 137 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 137 138 ! 138 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes at T- and F-point 139 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes at T- and F-point 140 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! horizontal momentum fluxes at T- and F-point 139 141 zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 140 142 zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) … … 168 170 & * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) - gamma1 * zl_v ) 169 171 END_2D 170 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 172 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 173 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! divergence of horizontal momentum fluxes 171 174 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 172 175 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 187 190 ! ! Vertical advection ! 188 191 ! ! ==================== ! 189 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 192 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 193 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! surface/bottom advective fluxes set to zero 190 194 zfu_uw(ji,jj,jpk) = 0._wp 191 195 zfv_vw(ji,jj,jpk) = 0._wp … … 194 198 END_2D 195 199 IF( ln_linssh ) THEN ! constant volume : advection through the surface 196 DO_2D( 0, 0, 0, 0 ) 200 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 201 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 197 202 zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 198 203 zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) … … 200 205 ENDIF 201 206 DO jk = 2, jpkm1 ! interior fluxes 202 DO_2D( 0, 1, 0, 1 ) 207 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) 208 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 203 209 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 204 210 END_2D 205 DO_2D( 0, 0, 0, 0 ) 211 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 212 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 206 213 zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 207 214 zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 208 215 END_2D 209 216 END DO 210 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 217 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 218 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 211 219 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 212 220 & / e3u(ji,jj,jk,Kmm) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynkeg.F90
r13497 r14680 101 101 ! 102 102 CASE ( nkeg_C2 ) !-- Standard scheme --! 103 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 103 ! [comm_cleanup] ! DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 104 DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 ) 104 105 zu = puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 105 106 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) … … 109 110 END_3D 110 111 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 111 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 112 ! [comm_cleanup: Hollingsworth scheme NOT TESTED] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 113 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 112 114 zu = 8._wp * ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 113 115 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) & … … 121 123 zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 122 124 END_3D 123 CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp )125 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp ) 124 126 ! 125 127 END SELECT 126 128 ! 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== grad( KE ) added to the general momentum trends ==! 129 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== grad( KE ) added to the general momentum trends ==! 130 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !== grad( KE ) added to the general momentum trends ==! 128 131 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 129 132 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynzad.F90
r14072 r14680 79 79 80 80 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 81 DO_2D( 0, 1, 0, 1 ) ! vertical fluxes 81 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) ! vertical fluxes 82 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! vertical fluxes 82 83 IF( ln_vortex_force ) THEN 83 84 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) ) … … 86 87 ENDIF 87 88 END_2D 88 DO_2D( 0, 0, 0, 0 ) ! vertical momentum advection at w-point 89 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! vertical momentum advection at w-point 90 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! vertical momentum advection at w-point 89 91 zwuw(ji,jj,jk) = ( zww(ji+1,jj ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) 90 92 zwvw(ji,jj,jk) = ( zww(ji ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) ) … … 93 95 ! 94 96 ! Surface and bottom advective fluxes set to zero 95 DO_2D( 0, 0, 0, 0 ) 97 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 98 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 96 99 zwuw(ji,jj, 1 ) = 0._wp 97 100 zwvw(ji,jj, 1 ) = 0._wp … … 100 103 END_2D 101 104 ! 102 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points 105 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points 106 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points 103 107 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 104 108 & / e3u(ji,jj,jk,Kmm) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/sshwzv.F90
r14205 r14680 78 78 REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! sea-surface height 79 79 ! 80 INTEGER :: j k ! dummy loop index80 INTEGER :: ji, jj, jk ! dummy loop index 81 81 REAL(wp) :: zcoef ! local scalar 82 82 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv ! 2D workspace … … 103 103 ! 104 104 zhdiv(:,:) = 0._wp 105 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 106 zhdiv(:,:) = zhdiv(:,:) + e3t(:,:,jk,Kmm) * hdiv(:,:,jk) 107 END DO 105 ! [comm_cleanup] ! DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 106 DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 ) ! Horizontal divergence of barotropic transports 107 zhdiv(ji,jj) = zhdiv(ji,jj) + e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk) 108 END_3D 108 109 ! ! Sea surface elevation time stepping 109 110 ! In time-split case we need a first guess of the ssh after (using the baroclinic timestep) in order to 110 111 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 111 112 ! 112 pssh(:,:,Kaa) = ( pssh(:,:,Kbb) - rDt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 113 ! [comm_cleanup] 114 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 115 pssh(ji,jj,Kaa) = ( pssh(ji,jj,Kbb) - rDt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) ) ) * ssmask(ji,jj) 116 END_2D 113 117 ! 114 118 #if defined key_agrif … … 119 123 IF ( .NOT.ln_dynspg_ts ) THEN 120 124 IF( ln_bdy ) THEN 121 CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp ) ! Not sure that's necessary 125 ! [comm_cleanup] 126 IF (nn_hls.eq.1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp ) ! Not sure that's necessary 122 127 CALL bdy_ssh( pssh(:,:,Kaa) ) ! Duplicate sea level across open boundaries 123 128 ENDIF … … 178 183 ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 179 184 ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way) 180 DO_2D( 0, 0, 0, 0 ) 185 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 186 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 181 187 zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 182 188 END_2D 183 189 END DO 184 CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp) ! - ML - Perhaps not necessary: not used for horizontal "connexions"190 IF (nn_hls.eq.1) CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp) ! - ML - Perhaps not necessary: not used for horizontal "connexions" 185 191 ! ! Is it problematic to have a wrong vertical velocity in boundary cells? 186 192 ! ! Same question holds for hdiv. Perhaps just for security … … 357 363 zdt = 2._wp * rn_Dt ! 2*rn_Dt and not rDt (for restartability) 358 364 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 359 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 365 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 366 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 360 367 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 361 368 Cu_adv(ji,jj,jk) = zdt * & … … 374 381 END_3D 375 382 ELSE 376 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 383 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 384 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 377 385 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 378 386 Cu_adv(ji,jj,jk) = zdt * & … … 387 395 END_3D 388 396 ENDIF 389 CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp )397 IF (nn_hls.eq.1) CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 390 398 ! 391 399 CALL iom_put("Courant",Cu_adv) 392 400 ! 393 401 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 394 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary 402 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary 403 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary 395 404 ! 396 405 zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) ) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ISF/isfhdiv.F90
r13295 r14680 100 100 ! 101 101 ! update divergence at each level affected by ice shelf top boundary layer 102 DO_2D( 1, 1, 1, 1 ) 102 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 103 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 103 104 ikt = ktop(ji,jj) 104 105 ikb = kbot(ji,jj) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LDF/ldfc1d_c2d.F90
r14574 r14680 135 135 ! 136 136 CASE( 'DYN' ) ! T- and F-points 137 DO_2D( 1, 1, 1, 1)137 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 138 138 pah1(ji,jj,1) = pUfac * MAX( e1t(ji,jj) , e2t(ji,jj) )**knn 139 139 pah2(ji,jj,1) = pUfac * MAX( e1f(ji,jj) , e2f(ji,jj) )**knn -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90
r14631 r14680 633 633 INTEGER , INTENT(in ) :: kt ! ocean time-step index 634 634 INTEGER , INTENT(in ) :: Kmm ! ocean time level indices 635 REAL(wp) , INTENT(in out) :: paei0 ! max value [m2/s]635 REAL(wp) , INTENT(in ) :: paei0 ! max value [m2/s] 636 636 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: paeiu, paeiv ! eiv coefficient [m2/s] 637 637 ! 638 638 INTEGER :: ji, jj, jk ! dummy loop indices 639 REAL(wp) :: zfw, ze3w, zn2, z1_f20, z aht, zaht_min, zzaei ! local scalars639 REAL(wp) :: zfw, ze3w, zn2, z1_f20, zzaei ! local scalars 640 640 REAL(wp), DIMENSION(jpi,jpj) :: zn, zah, zhw, zRo, zaeiw ! 2D workspace 641 641 !!---------------------------------------------------------------------- -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/SBC/sbcrnf.F90
r14072 r14680 206 206 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 207 207 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 208 DO_2D( 1, 1, 1, 1 ) 208 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 209 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 209 210 DO jk = 1, nk_rnf(ji,jj) 210 211 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) … … 212 213 END_2D 213 214 ELSE !* variable volume case 214 DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 215 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 216 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! update the depth over which runoffs are distributed 215 217 h_rnf(ji,jj) = 0._wp 216 218 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres … … 358 360 ! 359 361 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 360 DO_2D( 1, 1, 1, 1 ) 362 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 363 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 361 364 IF( h_rnf(ji,jj) > 0._wp ) THEN 362 365 jk = 2 … … 371 374 ENDIF 372 375 END_2D 373 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 376 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! set the associated depth 377 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth 374 378 h_rnf(ji,jj) = 0._wp 375 379 DO jk = 1, nk_rnf(ji,jj) … … 401 405 WHERE( zrnfcl(:,:,1) > 0._wp ) h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs 402 406 ! 403 DO_2D( 1, 1, 1, 1 ) ! take in account min depth of ocean rn_hmin 407 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! take in account min depth of ocean rn_hmin 408 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! take in account min depth of ocean rn_hmin 404 409 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 405 410 jk = mbkt(ji,jj) … … 409 414 ! 410 415 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 411 DO_2D( 1, 1, 1, 1 ) 416 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 417 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 412 418 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 413 419 jk = 2 … … 420 426 END_2D 421 427 ! 422 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 428 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! set the associated depth 429 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth 423 430 h_rnf(ji,jj) = 0._wp 424 431 DO jk = 1, nk_rnf(ji,jj) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90
r14631 r14680 92 92 CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 93 93 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 94 ! [comm_cleanup]95 ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.)96 94 CALL tra_ldf_blp ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, nldf_tra ) 97 95 END SELECT -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_iso.F90
r14632 r14680 185 185 zmskv = wmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 186 186 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 187 ! 188 ! NOTE: [halo1-halo2] 189 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 190 zahu_w = ( (pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk)) & 191 & + (pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk)) ) * zmsku 192 zahv_w = ( (pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk)) & 193 & + (pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk)) ) * zmskv 187 ! round brackets added to fix the order of floating point operations 188 ! needed to ensure halo 1 - halo 2 compatibility 189 zahu_w = ( ( pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk) & 190 & ) & ! bracket for halo 1 - halo 2 compatibility 191 & + ( pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk) & 192 & ) ) * zmsku ! bracket for halo 1 - halo 2 compatibility 193 zahv_w = ( ( pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk) & 194 & ) & ! bracket for halo 1 - halo 2 compatibility 195 & + ( pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk) & 196 & ) ) * zmskv ! bracket for halo 1 - halo 2 compatibility 194 197 ! 195 198 ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & … … 200 203 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 201 204 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 202 ! NOTE: [halo1-halo2] 203 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 204 akz(ji,jj,jk) = 0.25_wp * ( & 205 & (( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & 206 & + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )) & 207 & + (( pahv(ji,jj ,jk) + pahv(ji,jj ,jk-1) ) / ( e2v(ji,jj ) * e2v(ji,jj ) ) & 208 & + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )) ) 205 ! round brackets added to fix the order of floating point operations 206 ! needed to ensure halo 1 - halo 2 compatibility 207 akz(ji,jj,jk) = 0.25_wp * ( & 208 & ( ( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & 209 & + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) ) & 210 & ) & ! bracket for halo 1 - halo 2 compatibility 211 & + ( ( pahv(ji,jj ,jk) + pahv(ji,jj ,jk-1) ) / ( e2v(ji,jj ) * e2v(ji,jj ) ) & 212 & + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) & 213 & ) ) ! bracket for halo 1 - halo 2 compatibility 209 214 END_3D 210 215 ! … … 296 301 zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 297 302 ! 298 ! NOTE: [halo1-halo2] 299 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 300 zftu(ji,jj,jk) = ( zabe1 * zdit(ji,jj,jk) & 301 & + zcof1 * ( (zdkt (ji+1,jj) + zdk1t(ji,jj)) & 302 & + (zdk1t(ji+1,jj) + zdkt (ji,jj)) ) ) * umask(ji,jj,jk) 303 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 304 & + zcof2 * ( (zdkt (ji,jj+1) + zdk1t(ji,jj)) & 305 & + (zdk1t(ji,jj+1) + zdkt (ji,jj)) ) ) * vmask(ji,jj,jk) 303 ! round brackets added to fix the order of floating point operations 304 ! needed to ensure halo 1 - halo 2 compatibility 305 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 306 & + zcof1 * ( ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 307 & ) & ! bracket for halo 1 - halo 2 compatibility 308 & + ( zdk1t(ji+1,jj) + zdkt (ji,jj) & 309 & ) & ! bracket for halo 1 - halo 2 compatibility 310 & ) ) * umask(ji,jj,jk) 311 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 312 & + zcof2 * ( ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 313 & ) & ! bracket for halo 1 - halo 2 compatibility 314 & + ( zdk1t(ji,jj+1) + zdkt (ji,jj) & 315 & ) & ! bracket for halo 1 - halo 2 compatibility 316 & ) ) * vmask(ji,jj,jk) 306 317 END_2D 307 318 ! 308 319 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !== horizontal divergence and add to pta 309 320 DO_2D( iij-1, iij-1, iij-1, iij-1 ) !== horizontal divergence and add to pta 310 ! NOTE: [halo1-halo2] 311 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 312 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 313 & + zsign * ( (zftu(ji,jj,jk) - zftu(ji-1,jj,jk)) + & 314 & (zftv(ji,jj,jk) - zftv(ji,jj-1,jk)) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 321 ! round brackets added to fix the order of floating point operations 322 ! needed to ensure halo 1 - halo 2 compatibility 323 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 324 & + zsign * ( ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 325 & ) & ! bracket for halo 1 - halo 2 compatibility 326 & + ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk) & 327 & ) & ! bracket for halo 1 - halo 2 compatibility 328 & ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 315 329 END_2D 316 330 END DO ! End of slab … … 341 355 zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 342 356 ! 343 ! NOTE: [halo1-halo2] 344 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 345 ztfw(ji,jj,jk) = zcoef3 * ( (zdit(ji ,jj ,jk-1) + zdit(ji-1,jj ,jk)) & 346 & + (zdit(ji-1,jj ,jk-1) + zdit(ji ,jj ,jk)) ) & 347 & + zcoef4 * ( (zdjt(ji ,jj ,jk-1) + zdjt(ji ,jj-1,jk)) & 348 & + (zdjt(ji ,jj-1,jk-1) + zdjt(ji ,jj ,jk)) ) 357 ! round brackets added to fix the order of floating point operations 358 ! needed to ensure halo 1 - halo 2 compatibility 359 ztfw(ji,jj,jk) = zcoef3 * ( ( zdit(ji ,jj ,jk-1) + zdit(ji-1,jj ,jk) & 360 & ) & ! bracket for halo 1 - halo 2 compatibility 361 & + ( zdit(ji-1,jj ,jk-1) + zdit(ji ,jj ,jk) & 362 & ) & ! bracket for halo 1 - halo 2 compatibility 363 & ) & 364 & + zcoef4 * ( ( zdjt(ji ,jj ,jk-1) + zdjt(ji ,jj-1,jk) & 365 & ) & ! bracket for halo 1 - halo 2 compatibility 366 & + ( zdjt(ji ,jj-1,jk-1) + zdjt(ji ,jj ,jk) & 367 & ) & ! bracket for halo 1 - halo 2 compatibility 368 & ) 349 369 END_3D 350 370 ! !== add the vertical 33 flux ==! -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90
r14663 r14680 158 158 ENDIF 159 159 ! 160 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) !== Second derivative (divergence) added to the general tracer trends ==! 161 ! NOTE: [halo1-halo2] 162 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 163 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( (ztu(ji,jj,jk) - ztu(ji-1,jj,jk)) & 164 & + (ztv(ji,jj,jk) - ztv(ji,jj-1,jk)) ) & 165 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 160 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) !== Second derivative (divergence) added to the general tracer trends ==! 161 ! round brackets added to fix the order of floating point operations 162 ! needed to ensure halo 1 - halo 2 compatibility 163 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 164 & ) & ! bracket for halo 1 - halo 2 compatibility 165 & + ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) & 166 & ) & ! bracket for halo 1 - halo 2 compatibility 167 & ) / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 166 168 END_3D 167 169 ! -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_triad.F90
r14632 r14680 107 107 REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend 108 108 ! 109 INTEGER :: ji, jj, jk, jn ! dummy loop indices 110 INTEGER :: ip,jp,kp ! dummy loop indices 111 INTEGER :: ierr, iij ! local integer 112 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 113 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 109 INTEGER :: ji, jj, jk, jn, kp, iij ! dummy loop indices 114 110 REAL(wp) :: zcoef0, ze3w_2, zsign ! - - 115 111 ! 116 REAL(wp) :: zslope_skew, zslope_iso, zslope2, zbu, zbv 117 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 118 REAL(wp) :: zah, zah_slp, zaei_slp 119 REAL(wp), DIMENSION(A2D(nn_hls),0:1) :: zdkt3d ! vertical tracer gradient at 2 levels 120 REAL(wp), DIMENSION(A2D(nn_hls) ) :: z2d ! 2D workspace 121 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zdit, zdjt, zpsi_uw, zpsi_vw ! 3D - 122 ! NOTE: [halo1-halo2] 123 REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: zftu, zftv 124 REAL(wp), DIMENSION(A2D(nn_hls),jpk,2,2) :: ztfw 112 REAL(wp) :: zslope2, zbu, zbv, zbu1, zbv1, zslope21, zah, zah1, zah_ip1, zah_jp1, zbu_ip1, zbv_jp1 113 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt, zdyt_jp1, ze3wr_jp1, zdzt_jp1, zah_slp1, zah_slp_jp1, zaei_slp_jp1 114 REAL(wp) :: zah_slp, zaei_slp, zdxt_ip1, ze3wr_ip1, zdzt_ip1, zah_slp_ip1, zaei_slp_ip1, zaei_slp1 115 REAL(wp), DIMENSION(A2D(nn_hls),0:1) :: zdkt3d ! vertical tracer gradient at 2 levels 116 REAL(wp), DIMENSION(A2D(nn_hls) ) :: z2d ! 2D workspace 117 REAL(wp), DIMENSION(A2D(nn_hls) ,jpk) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ! 3D - 125 118 !!---------------------------------------------------------------------- 126 119 ! … … 163 156 END_3D 164 157 ! 165 ! NOTE: [halo1-halo2] 166 zftu(:,:,:,:) = 0._wp 167 zftv(:,:,:,:) = 0._wp 168 ! 169 DO ip = 0, 1 ! i-k triads 170 DO kp = 0, 1 171 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 172 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 173 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 174 zbu = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm) 175 zah = 0.25_wp * pahu(ji-ip,jj,jk) 176 zslope_skew = triadi_g(ji,jj,jk,1-ip,kp) 177 ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 178 zslope2 = zslope_skew + ( gdept(ji-ip+1,jj,jk,Kmm) - gdept(ji-ip,jj,jk,Kmm) ) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 179 zslope2 = zslope2 *zslope2 180 ! NOTE: [halo1-halo2] 181 zftu(ji,jj,jk+kp,ip+1) = zftu(ji,jj,jk+kp,ip+1) + & 182 & zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2 183 zftv(ji,jj,jk+kp,ip+1) = zftv(ji,jj,jk+kp,ip+1) + & 184 & zah * r1_e1u(ji-ip,jj) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 185 ! 186 END_3D 187 END DO 158 DO kp = 0, 1 ! i-k triads 159 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 160 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 161 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 162 zbu = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 163 zbu1 = e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) 164 zah = 0.25_wp * pahu(ji,jj,jk) 165 zah1 = 0.25_wp * pahu(ji-1,jj,jk) 166 ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 167 zslope2 = triadi_g(ji,jj,jk,1,kp) + ( gdept(ji+1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 168 zslope2 = zslope2 *zslope2 169 zslope21 = triadi_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji-1,jj,jk,Kmm) ) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp) 170 zslope21 = zslope21 *zslope21 171 ! round brackets added to fix the order of floating point operations 172 ! needed to ensure halo 1 - halo 2 compatibility 173 ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + ( zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2 & 174 & + zah1 * zbu1 * ze3wr * r1_e1e2t(ji,jj) * zslope21 & 175 & ) ! bracket for halo 1 - halo 2 compatibility 176 akz (ji,jj,jk+kp) = akz (ji,jj,jk+kp) + ( zah * r1_e1u(ji,jj) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) & 177 + zah1 * r1_e1u(ji-1,jj) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp) & 178 & ) ! bracket for halo 1 - halo 2 compatibility 179 END_3D 188 180 END DO 189 181 ! 190 ! NOTE: [halo1-halo2] Use DO_3D instead of DO_3D_OVR 191 ! ip loop contributions added here to ensure consistent floating point arithmetic for different nn_hls 192 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 193 ah_wslp2(ji,jj,jk) = ah_wslp2(ji,jj,jk) + (zftu(ji,jj,jk,1) + zftu(ji,jj,jk,2)) 194 akz (ji,jj,jk) = akz (ji,jj,jk) + (zftv(ji,jj,jk,1) + zftv(ji,jj,jk,2)) 195 END_3D 196 ! 197 ! NOTE: [halo1-halo2] 198 zftu(:,:,:,:) = 0._wp 199 zftv(:,:,:,:) = 0._wp 200 ! 201 DO jp = 0, 1 ! j-k triads 202 DO kp = 0, 1 203 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 204 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 205 ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 206 zbv = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm) 207 zah = 0.25_wp * pahv(ji,jj-jp,jk) 208 zslope_skew = triadj_g(ji,jj,jk,1-jp,kp) 209 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 210 ! (do this by *adding* gradient of depth) 211 zslope2 = zslope_skew + ( gdept(ji,jj-jp+1,jk,Kmm) - gdept(ji,jj-jp,jk,Kmm) ) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 212 zslope2 = zslope2 * zslope2 213 ! NOTE: [halo1-halo2] 214 zftu(ji,jj,jk+kp,jp+1) = zftu(ji,jj,jk+kp,jp+1) + & 215 & zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2 216 zftv(ji,jj,jk+kp,jp+1) = zftv(ji,jj,jk+kp,jp+1) + & 217 & zah * r1_e2v(ji,jj-jp) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 218 ! 219 END_3D 220 END DO 182 DO kp = 0, 1 ! j-k triads 183 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 184 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 185 ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 186 zbv = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 187 zbv1 = e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) 188 zah = 0.25_wp * pahv(ji,jj,jk) 189 zah1 = 0.25_wp * pahv(ji,jj-1,jk) 190 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 191 ! (do this by *adding* gradient of depth) 192 zslope2 = triadj_g(ji,jj,jk,1,kp) + ( gdept(ji,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 193 zslope2 = zslope2 * zslope2 194 zslope21 = triadj_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji,jj-1,jk,Kmm) ) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp) 195 zslope21 = zslope21 * zslope21 196 ! round brackets added to fix the order of floating point operations 197 ! needed to ensure halo 1 - halo 2 compatibility 198 ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + ( zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2 & 199 & + zah1 * zbv1 * ze3wr * r1_e1e2t(ji,jj) * zslope21 & 200 & ) ! bracket for halo 1 - halo 2 compatibility 201 akz (ji,jj,jk+kp) = akz (ji,jj,jk+kp) + ( zah * r1_e2v(ji,jj) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) & 202 & + zah1 * r1_e2v(ji,jj-1) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp) & 203 & ) ! bracket for halo 1 - halo 2 compatibility 204 ! 205 END_3D 221 206 END DO 222 !223 ! NOTE: [halo1-halo2] Use DO_3D instead of DO_3D_OVR224 ! jp loop contributions added here to ensure consistent floating point arithmetic for different nn_hls225 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )226 ah_wslp2(ji,jj,jk) = ah_wslp2(ji,jj,jk) + (zftu(ji,jj,jk,1) + zftu(ji,jj,jk,2))227 akz (ji,jj,jk) = akz (ji,jj,jk) + (zftv(ji,jj,jk,1) + zftv(ji,jj,jk,2))228 END_3D229 207 ! 230 208 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient … … 259 237 zpsi_vw(:,:,:) = 0._wp 260 238 261 DO jp = 0, 1 262 DO kp = 0, 1 263 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 264 zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 265 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) 266 zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 267 & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp) 268 END_3D 269 END DO 239 DO kp = 0, 1 240 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 241 ! round brackets added to fix the order of floating point operations 242 ! needed to ensure halo 1 - halo 2 compatibility 243 zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 244 & + ( 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji,jj,jk,1,kp) & 245 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+1,jj,jk,0,kp) & 246 & ) ! bracket for halo 1 - halo 2 compatibility 247 zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 248 & + ( 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj,jk,1,kp) & 249 & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+1,jk,0,kp) & 250 & ) ! bracket for halo 1 - halo 2 compatibility 251 END_3D 270 252 END DO 271 253 CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) … … 279 261 ! Zero fluxes for each tracer 280 262 !!gm this should probably be done outside the jn loop 281 ! NOTE: [halo1-halo2] 282 ztfw(:,:,:,:,:) = 0._wp 283 zftu(:,:,:,:) = 0._wp 284 zftv(:,:,:,:) = 0._wp 263 ztfw(:,:,:) = 0._wp 264 zftu(:,:,:) = 0._wp 265 zftv(:,:,:) = 0._wp 285 266 ! 286 267 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== before lateral T & S gradients at T-level jk ==! … … 327 308 ! 328 309 IF( ln_botmix_triad ) THEN 329 DO ip = 0, 1 !== Horizontal & vertical fluxes 330 DO kp = 0, 1 331 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 332 DO_2D( iij, iij-1, iij, iij-1 ) 333 ze1ur = r1_e1u(ji,jj) 334 zdxt = zdit(ji,jj,jk) * ze1ur 335 ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 336 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 337 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 338 zslope_iso = triadi (ji+ip,jj,jk,1-ip,kp) 339 ! 340 zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 341 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahu is masked.... 342 zah = pahu(ji,jj,jk) 343 zah_slp = zah * zslope_iso 344 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew 345 ! NOTE: [halo1-halo2] 346 zftu(ji ,jj,jk,ip+1 ) = zftu(ji ,jj,jk,ip+1 ) - & 347 & ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 348 ztfw(ji,jj,jk+kp,ip+1,1) = ztfw(ji,jj,jk+kp,ip+1,1) - & 349 & (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 350 END_2D 351 END DO 310 DO kp = 0, 1 !== Horizontal & vertical fluxes 311 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 312 DO_2D( iij, iij-1, iij, iij-1 ) 313 ze1ur = r1_e1u(ji,jj) 314 zdxt = zdit(ji,jj,jk) * ze1ur 315 zdxt_ip1 = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj) 316 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 317 ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm) 318 zdzt = zdkt3d(ji,jj,kp) * ze3wr 319 zdzt_ip1 = zdkt3d(ji+1,jj,kp) * ze3wr_ip1 320 ! 321 zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 322 zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm) 323 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahu is masked.... 324 zah = pahu(ji,jj,jk) 325 zah_ip1 = pahu(ji+1,jj,jk) 326 zah_slp = zah * triadi(ji,jj,jk,1,kp) 327 zah_slp_ip1 = zah_ip1 * triadi(ji+1,jj,jk,1,kp) 328 zah_slp1 = zah * triadi(ji+1,jj,jk,0,kp) 329 IF( ln_ldfeiv ) THEN 330 zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp) 331 zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp) 332 zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp) 333 ENDIF 334 ! round brackets added to fix the order of floating point operations 335 ! needed to ensure halo 1 - halo 2 compatibility 336 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) & 337 & - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur & 338 & + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur & 339 & ) ! bracket for halo 1 - halo 2 compatibility 340 ztfw(ji+1,jj,jk+kp) = ztfw(ji+1,jj,jk+kp) & 341 & - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1 & 342 & + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1 & 343 & ) ! bracket for halo 1 - halo 2 compatibility 344 END_2D 352 345 END DO 353 346 ! 354 DO jp = 0, 1 355 DO kp = 0, 1 356 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 357 DO_2D( iij, iij-1, iij, iij-1 ) 358 ze2vr = r1_e2v(ji,jj) 359 zdyt = zdjt(ji,jj,jk) * ze2vr 360 ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm) 361 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 362 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 363 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 364 zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 365 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahv is masked... 366 zah = pahv(ji,jj,jk) 367 zah_slp = zah * zslope_iso 368 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew 369 ! NOTE: [halo1-halo2] 370 zftv(ji,jj ,jk,jp+1 ) = zftv(ji,jj ,jk,jp+1 ) - & 371 & ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 372 ztfw(ji,jj,jk+kp,jp+1,2) = ztfw(ji,jj,jk+kp,jp+1,2) - & 373 & (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 374 END_2D 375 END DO 347 DO kp = 0, 1 348 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 349 DO_2D( iij, iij-1, iij, iij-1 ) 350 ze2vr = r1_e2v(ji,jj) 351 zdyt = zdjt(ji,jj,jk) * ze2vr 352 zdyt_jp1 = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1) 353 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 354 ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm) 355 zdzt = zdkt3d(ji,jj,kp) * ze3wr 356 zdzt_jp1 = zdkt3d(ji,jj+1,kp) * ze3wr_jp1 357 zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 358 zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm) 359 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahu is masked.... 360 zah = pahv(ji,jj,jk) ! pahv(ji,jj+jp,jk) ???? 361 zah_jp1 = pahv(ji,jj+1,jk) 362 zah_slp = zah * triadj(ji,jj,jk,1,kp) 363 zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp) 364 zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp) 365 IF( ln_ldfeiv ) THEN 366 zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp) 367 zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp) 368 zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp) 369 ENDIF 370 ! round brackets added to fix the order of floating point operations 371 ! needed to ensure halo 1 - halo 2 compatibility 372 zftv(ji,jj ,jk ) = zftv(ji,jj ,jk ) & 373 & - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr & 374 & + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr & 375 & ) ! bracket for halo 1 - halo 2 compatibility 376 ztfw(ji,jj+1,jk+kp) = ztfw(ji,jj+1,jk+kp) & 377 & - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1 & 378 & + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1 & 379 & ) ! bracket for halo 1 - halo 2 compatibility 380 END_2D 376 381 END DO 377 382 ! 378 383 ELSE 379 384 ! 380 DO ip = 0, 1 !== Horizontal & vertical fluxes 381 DO kp = 0, 1 382 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 383 DO_2D( iij, iij-1, iij, iij-1 ) 384 ze1ur = r1_e1u(ji,jj) 385 zdxt = zdit(ji,jj,jk) * ze1ur 386 ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 387 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 388 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 389 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 390 ! 391 zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 392 ! ln_botmix_triad is .F. mask zah for bottom half cells 393 zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp) ! pahu(ji+ip,jj,jk) ===>> ???? 394 zah_slp = zah * zslope_iso 395 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew ! aeit(ji+ip,jj,jk)*zslope_skew 396 ! NOTE: [halo1-halo2] 397 zftu(ji ,jj,jk,ip+1 ) = zftu(ji ,jj,jk,ip+1 ) - & 398 & ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 399 ztfw(ji,jj,jk+kp,ip+1,1) = ztfw(ji,jj,jk+kp,ip+1,1) - & 400 & (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 401 END_2D 402 END DO 385 DO kp = 0, 1 !== Horizontal & vertical fluxes 386 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 387 DO_2D( iij, iij-1, iij, iij-1 ) 388 ze1ur = r1_e1u(ji,jj) 389 zdxt = zdit(ji,jj,jk) * ze1ur 390 zdxt_ip1 = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj) 391 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 392 ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm) 393 zdzt = zdkt3d(ji,jj,kp) * ze3wr 394 zdzt_ip1 = zdkt3d(ji+1,jj,kp) * ze3wr_ip1 395 ! 396 zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 397 zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm) 398 ! ln_botmix_triad is .F. mask zah for bottom half cells 399 zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp) ! pahu(ji+ip,jj,jk) ===>> ???? 400 zah_ip1 = pahu(ji+1,jj,jk) * umask(ji+1,jj,jk+kp) 401 zah_slp = zah * triadi(ji,jj,jk,1,kp) 402 zah_slp_ip1 = zah_ip1 * triadi(ji+1,jj,jk,1,kp) 403 zah_slp1 = zah * triadi(ji+1,jj,jk,0,kp) 404 IF( ln_ldfeiv ) THEN 405 zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp) 406 zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp) 407 zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp) 408 ENDIF 409 ! zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur - ( zah * zdxt + (zah_slp1 - zaei_slp1) * zdzt_ip1 ) * zbu * ze1ur 410 ! ztfw(ji+1,jj,jk+kp) = ztfw(ji+1,jj,jk+kp) - (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1 - (zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1 411 ! round brackets added to fix the order of floating point operations 412 ! needed to ensure halo 1 - halo 2 compatibility 413 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) & 414 & - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur & 415 & + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur & 416 & ) ! bracket for halo 1 - halo 2 compatibility 417 ztfw(ji+1,jj,jk+kp) = ztfw(ji+1,jj,jk+kp) & 418 & - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1 & 419 & + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1 & 420 & ) ! bracket for halo 1 - halo 2 compatibility 421 END_2D 403 422 END DO 404 423 ! 405 DO jp = 0, 1 406 DO kp = 0, 1 407 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 408 DO_2D( iij, iij-1, iij, iij-1 ) 409 ze2vr = r1_e2v(ji,jj) 410 zdyt = zdjt(ji,jj,jk) * ze2vr 411 ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm) 412 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 413 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 414 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 415 zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 416 ! ln_botmix_triad is .F. mask zah for bottom half cells 417 zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! pahv(ji,jj+jp,jk) ???? 418 zah_slp = zah * zslope_iso 419 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew ! aeit(ji,jj+jp,jk)*zslope_skew 420 ! NOTE: [halo1-halo2] 421 zftv(ji,jj,jk, jp+1 ) = zftv(ji,jj,jk, jp+1 ) - & 422 & ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 423 ztfw(ji,jj,jk+kp,jp+1,2) = ztfw(ji,jj,jk+kp,jp+1,2) - & 424 & (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 425 END_2D 426 END DO 424 DO kp = 0, 1 425 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 426 DO_2D( iij, iij-1, iij, iij-1 ) 427 ze2vr = r1_e2v(ji,jj) 428 zdyt = zdjt(ji,jj,jk) * ze2vr 429 zdyt_jp1 = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1) 430 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 431 ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm) 432 zdzt = zdkt3d(ji,jj,kp) * ze3wr 433 zdzt_jp1 = zdkt3d(ji,jj+1,kp) * ze3wr_jp1 434 zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 435 zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm) 436 ! ln_botmix_triad is .F. mask zah for bottom half cells 437 zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! pahv(ji,jj+jp,jk) ???? 438 zah_jp1 = pahv(ji,jj+1,jk) * vmask(ji,jj+1,jk+kp) 439 zah_slp = zah * triadj(ji,jj,jk,1,kp) 440 zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp) 441 zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp) 442 IF( ln_ldfeiv ) THEN 443 zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp) 444 zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp) 445 zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp) 446 ENDIF 447 ! zftv(ji,jj ,jk ) = zftv(ji,jj ,jk ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr - ( zah * zdyt + (zah_slp1 - zaei_slp1) * zdzt_jp1 ) * zbv * ze2vr 448 ! ztfw(ji,jj+1,jk+kp) = ztfw(ji,jj+1,jk+kp) - ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1 - (zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1 449 ! round brackets added to fix the order of floating point operations 450 ! needed to ensure halo 1 - halo 2 compatibility 451 zftv(ji,jj ,jk ) = zftv(ji,jj ,jk ) & 452 & - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr & 453 & + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr & 454 & ) ! bracket for halo 1 - halo 2 compatibility 455 ztfw(ji,jj+1,jk+kp) = ztfw(ji,jj+1,jk+kp) & 456 & - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1 & 457 & + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1 & 458 & ) ! bracket for halo 1 - halo 2 compatibility 459 END_2D 427 460 END DO 428 461 ENDIF 429 ! NOTE: [halo1-halo2]430 ! ip and jp loop contributions added here to ensure consistent floating point arithmetic for different nn_hls431 DO_2D( iij, iij-1, iij, iij-1 )432 zftu(ji,jj,jk,1) = zftu(ji,jj,jk,1) + zftu(ji,jj,jk,2)433 zftv(ji,jj,jk,1) = zftv(ji,jj,jk,1) + zftv(ji,jj,jk,2)434 END_2D435 DO_2D( iij-1, iij-1, iij-1, iij-1 )436 ztfw(ji,jj,jk,1,1) = (ztfw(ji,jj,jk,1,1) + ztfw(ji-1,jj,jk,2,1)) + &437 & (ztfw(ji,jj,jk,1,2) + ztfw(ji,jj-1,jk,2,2))438 END_2D439 462 ! !== horizontal divergence and add to the general trend ==! 440 463 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 441 464 DO_2D( iij-1, iij-1, iij-1, iij-1 ) 442 ! NOTE: [halo1-halo2] 443 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 444 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 445 & + zsign * ( (zftu(ji-1,jj,jk,1) - zftu(ji,jj,jk,1)) & 446 & + (zftv(ji,jj-1,jk,1) - zftv(ji,jj,jk,1)) ) & 447 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 465 ! round brackets added to fix the order of floating point operations 466 ! needed to ensure halo 1 - halo 2 compatibility 467 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 468 & + zsign * ( ( zftu(ji-1,jj ,jk) - zftu(ji,jj,jk) & 469 & ) & ! bracket for halo 1 - halo 2 compatibility 470 & + ( zftv(ji,jj-1,jk) - zftv(ji,jj,jk) & 471 & ) & ! bracket for halo 1 - halo 2 compatibility 472 & ) / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 448 473 END_2D 449 474 ! … … 454 479 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 455 480 DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 456 ztfw(ji,jj,jk ,1,1) = ztfw(ji,jj,jk,1,1) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) &481 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 457 482 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 458 483 & * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) … … 463 488 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 464 489 DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 465 ztfw(ji,jj,jk ,1,1) = ztfw(ji,jj,jk,1,1) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) &490 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 466 491 & * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 467 492 END_3D 468 493 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 494 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 469 495 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 470 ztfw(ji,jj,jk ,1,1) = ztfw(ji,jj,jk,1,1) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) &496 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 471 497 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & 472 498 & + akz (ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) ) ) … … 476 502 ! 477 503 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 478 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) 479 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( ztfw(ji,jj,jk+1,1,1) - ztfw(ji,jj,jk,1,1) ) & 504 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 505 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 506 & + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & 480 507 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 481 508 END_3D … … 485 512 ! 486 513 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 487 ! NOTE: [halo1-halo2] 488 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:,1) ) 514 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:) ) 489 515 ! ! Diffusive heat transports 490 ! NOTE: [halo1-halo2] 491 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:,1), zftv(:,:,:,1) ) 516 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:), zftv(:,:,:) ) 492 517 ! 493 518 ENDIF !== end pass selection ==! -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/zpshde.F90
r14636 r14680 175 175 pgru(:,:) = 0._wp 176 176 pgrv(:,:) = 0._wp ! depth of the partial step level 177 DO_2D( nn_hls -1, nn_hls-1, nn_hls-1, nn_hls-1 )177 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 178 178 iku = mbku(ji,jj) 179 179 ikv = mbkv(ji,jj) … … 191 191 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 192 192 ! 193 DO_2D( nn_hls -1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level193 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! Gradient of density at the last level 194 194 iku = mbku(ji,jj) 195 195 ikv = mbkv(ji,jj) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/stpmlf.F90
r14636 r14680 187 187 CALL lbc_lnk( 'stp_MLF', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 188 188 ENDIF 189 ! CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1.0_wp, vv(:,:,:,Nnn), 'V', -1.0_wp )190 ! IF(.NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Nnn), 'U', 1.0_wp, r3v(:,:,Nnn), 'V', 1.0_wp, r3t(:,:,Nnn), 'T', 1.0_wp )191 189 ENDIF 192 190 CALL zdf_phy( kstp, Nbb, Nnn, Nrhs ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD) … … 286 284 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height 287 285 IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) ! "now" ssh/h_0 ratio from filtrered ssh 286 ! [comm_cleanup] this should not be needed 287 IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp ) 288 288 #if defined key_top 289 289 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Note: See TracChangeset
for help on using the changeset viewer.