Changeset 14712
- Timestamp:
- 2021-04-14T12:17:14+02:00 (4 years ago)
- Location:
- NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv.F90
r14680 r14712 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]79 78 CALL dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs ) ! 2nd order centered scheme 80 79 CASE( np_FLX_ubs ) 81 ! [comm_cleanup: dyn_adv_ubs NOT TESTED]82 80 CALL dyn_adv_ubs ( kt, Kbb, Kmm, puu, pvv, Krhs ) ! 3rd order UBS scheme (UP3) 83 81 END SELECT -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv_cen2.F90
r14680 r14712 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 ! [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) 74 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes (at T- and F-point) 76 75 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) ) 77 76 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) ) … … 79 78 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) ) 80 79 END_2D 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 80 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 83 81 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 84 82 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 100 98 ! !== Vertical advection ==! 101 99 ! 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 100 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 104 101 zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp 105 102 zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp 106 103 END_2D 107 104 IF( ln_linssh ) THEN ! linear free surface: advection through the surface 108 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 109 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 105 DO_2D( 0, 0, 0, 0 ) 110 106 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) 111 107 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) … … 113 109 ENDIF 114 110 DO jk = 2, jpkm1 ! interior advective fluxes 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 111 DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport 117 112 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 118 113 END_2D 119 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 120 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 114 DO_2D( 0, 0, 0, 0 ) 121 115 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) ) 122 116 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) ) 123 117 END_2D 124 118 END DO 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 119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 127 120 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) & 128 121 & / e3u(ji,jj,jk,Kmm) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv_ubs.F90
r14680 r14712 108 108 zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 109 109 ! 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 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 ) ! laplacia 112 112 113 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) 113 114 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) … … 137 138 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 138 139 ! 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 140 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes at T- and F-point 141 141 zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 142 142 zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) … … 170 170 & * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) - gamma1 * zl_v ) 171 171 END_2D 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 172 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 174 173 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 175 174 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 190 189 ! ! Vertical advection ! 191 190 ! ! ==================== ! 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 191 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 194 192 zfu_uw(ji,jj,jpk) = 0._wp 195 193 zfv_vw(ji,jj,jpk) = 0._wp … … 198 196 END_2D 199 197 IF( ln_linssh ) THEN ! constant volume : advection through the surface 200 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 201 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 198 DO_2D( 0, 0, 0, 0 ) 202 199 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) 203 200 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) … … 205 202 ENDIF 206 203 DO jk = 2, jpkm1 ! interior fluxes 207 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) 208 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 204 DO_2D( 0, 1, 0, 1 ) 209 205 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 210 206 END_2D 211 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 212 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 207 DO_2D( 0, 0, 0, 0 ) 213 208 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) ) 214 209 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) ) 215 210 END_2D 216 211 END DO 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 212 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 219 213 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) & 220 214 & / e3u(ji,jj,jk,Kmm) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynatf.F90
r14574 r14712 169 169 # endif 170 170 ! 171 CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp ) !* local domain boundaries171 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp ) !* local domain boundaries 172 172 ! 173 173 ! !* BDY open boundaries … … 201 201 IF( ln_linssh ) THEN ! Fixed volume ! 202 202 ! ! =============! 203 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 203 ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 204 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 204 205 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 205 206 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 237 238 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 238 239 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 239 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 240 ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 241 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 240 242 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 241 243 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 248 250 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 249 251 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 250 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 252 ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 253 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 251 254 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 252 255 zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynhpg.F90
r14574 r14712 462 462 END IF 463 463 END_2D 464 CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 464 ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 465 ! zcpx and zcpy are written and used only in the inner domain - can't test it 466 ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 465 467 END IF 466 468 ! … … 689 691 END IF 690 692 END_2D 691 CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 693 ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 694 ! zcpx and zcpy are written and used only in the inner domain - can't test it 695 ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 692 696 END IF 693 697 … … 786 790 !---------------------------------------------------------------------------------------- 787 791 788 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 792 ! [ comm_cleanup ] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 793 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 789 794 zdrhox(ji,jj,jk) = rhd (ji+1,jj ,jk) - rhd (ji,jj,jk ) 790 795 zdzx (ji,jj,jk) = - gde3w(ji+1,jj ,jk) + gde3w(ji,jj,jk ) … … 1043 1048 ENDIF 1044 1049 END_2D 1045 CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 1050 ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 1051 ! zcpx and zcpy are written and used only in the inner domain - can't test it 1052 ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 1046 1053 ENDIF 1047 1054 … … 1113 1120 END_2D 1114 1121 1115 CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 1122 ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 1123 ! zcpx and zcpy are written and used only in the inner domain 1124 ! CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 1116 1125 1117 1126 DO_2D( 0, 0, 0, 0 ) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynkeg.F90
r14680 r14712 101 101 ! 102 102 CASE ( nkeg_C2 ) !-- Standard scheme --! 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 ) 103 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 105 104 zu = puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 106 105 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) … … 110 109 END_3D 111 110 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 112 ! [comm_cleanup : Hollingsworth scheme NOT TESTED] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )111 ! [comm_cleanup ] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 113 112 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 113 ! round brackets added to fix the order of floating point operations 114 ! needed to ensure halo 1 - halo 2 compatibility 114 115 zu = 8._wp * ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 115 116 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) & 116 & + ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) & 117 & + ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) * ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) 117 & + ( ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) & 118 & + ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) * ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) & 119 & ) ! bracket for halo 1 - halo 2 compatibility 118 120 ! 119 121 zv = 8._wp * ( pvv(ji ,jj-1,jk,Kmm) * pvv(ji ,jj-1,jk,Kmm) & 120 122 & + pvv(ji ,jj ,jk,Kmm) * pvv(ji ,jj ,jk,Kmm) ) & 121 & + ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) & 122 & + ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) * ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) 123 & + ( ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) & 124 & + ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) * ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) & 125 & ) ! bracket for halo 1 - halo 2 compatibility 123 126 zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 124 127 END_3D … … 127 130 END SELECT 128 131 ! 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 ==! 132 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== grad( KE ) added to the general momentum trends ==! 131 133 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 132 134 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/dynldf_iso.F90
r14574 r14712 128 128 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 129 129 ! 130 DO_3D( 0, 0, 0, 0, 1, jpk ) ! set the slopes of iso-level 130 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 131 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) ! set the slopes of iso-level 131 132 uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 132 133 vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) … … 135 136 END_3D 136 137 ! Lateral boundary conditions on the slopes 137 CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp )138 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 138 139 ! 139 140 ENDIF -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynldf_lap_blp.F90
r14574 r14712 83 83 DO jk = 1, jpkm1 ! Horizontal slab 84 84 ! 85 DO_2D( 0, 1, 0, 1 ) 85 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) 86 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 86 87 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 87 88 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & ! ahmf already * by fmask … … 94 95 END_2D 95 96 ! 96 DO_2D( 0, 0, 0, 0 ) ! - curl( curl) + grad( div ) 97 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! - curl( curl) + grad( div ) 98 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! - curl( curl) + grad( div ) 97 99 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 98 100 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & … … 114 116 DO jk = 1, jpkm1 ! Horizontal slab 115 117 ! 116 DO_2D( 0, 1, 0, 1 ) 118 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) 119 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 117 120 ! ! shearing stress component (F-point) NB : ahmf has already been multiplied by fmask 118 121 zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) & … … 129 132 END_2D 130 133 ! 131 DO_2D( 0, 0, 0, 0 ) 134 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 135 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 132 136 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 133 137 & * ( ( zten(ji+1,jj ) * e2t(ji+1,jj )*e2t(ji+1,jj ) * e3t(ji+1,jj ,jk,Kmm) & … … 185 189 CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 ) ! rotated laplacian applied to pt (output in zlap,Kbb) 186 190 ! 187 CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp ) ! Lateral boundary conditions191 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp ) ! Lateral boundary conditions 188 192 ! 189 193 CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 ) ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynvor.F90
r14574 r14712 256 256 ALLOCATE( zwz(jpi,jpj,jpk) ) 257 257 DO jk = 1, jpkm1 ! Horizontal slab 258 DO_2D( 1, 0, 1, 0 ) 258 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 259 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 259 260 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 260 261 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 261 262 END_2D 262 263 IF( ln_dynvor_msk ) THEN ! mask relative vorticity 263 DO_2D( 1, 0, 1, 0 ) 264 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 265 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 264 266 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 265 267 END_2D 266 268 ENDIF 267 269 END DO 268 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )270 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 269 271 ! 270 272 END SELECT … … 625 627 ! 626 628 #if defined key_qco || defined key_linssh 627 DO_2D( 1, 0, 1, 0 ) ! == reciprocal of e3 at F-point (key_qco) 629 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! == reciprocal of e3 at F-point (key_qco) 630 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! == reciprocal of e3 at F-point (key_qco) 628 631 z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) 629 632 END_2D … … 631 634 SELECT CASE( nn_e3f_typ ) ! == reciprocal of e3 at F-point 632 635 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 633 DO_2D( 1, 0, 1, 0 ) 636 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 637 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 634 638 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 635 639 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 641 645 END_2D 642 646 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 643 DO_2D( 1, 0, 1, 0 ) 647 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 648 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 644 649 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 645 650 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 658 663 ! 659 664 CASE ( np_COR ) !* Coriolis (planetary vorticity) 660 DO_2D( 1, 0, 1, 0 ) 665 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 666 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 661 667 zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 662 668 END_2D 663 669 CASE ( np_RVO ) !* relative vorticity 664 DO_2D( 1, 0, 1, 0 ) 670 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 671 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 665 672 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 666 673 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 667 674 END_2D 668 675 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 669 DO_2D( 1, 0, 1, 0 ) 676 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 677 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 670 678 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 671 679 END_2D 672 680 ENDIF 673 681 CASE ( np_MET ) !* metric term 674 DO_2D( 1, 0, 1, 0 ) 682 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 683 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 675 684 zwz(ji,jj,jk) = ( ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 676 685 & - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) 677 686 END_2D 678 687 CASE ( np_CRV ) !* Coriolis + relative vorticity 679 DO_2D( 1, 0, 1, 0 ) 680 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 681 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & 682 & * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 688 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 689 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 690 ! round brackets added to fix the order of floating point operations 691 ! needed to ensure halo 1 - halo 2 compatibility 692 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 693 & ) & ! bracket for halo 1 - halo 2 compatibility 694 & - ( e1u(ji ,jj+1) * pu(ji,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk) & 695 & ) & ! bracket for halo 1 - halo 2 compatibility 696 & ) * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 683 697 END_2D 684 698 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 685 DO_2D( 1, 0, 1, 0 ) 699 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 700 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 686 701 zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 687 702 END_2D 688 703 ENDIF 689 704 CASE ( np_CME ) !* Coriolis + metric 690 DO_2D( 1, 0, 1, 0 ) 705 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 706 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 691 707 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 692 708 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) … … 699 715 ! ! =============== 700 716 ! 701 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )717 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 702 718 ! 703 719 ! ! =============== … … 776 792 SELECT CASE( kvor ) !== vorticity considered ==! 777 793 CASE ( np_COR ) !* Coriolis (planetary vorticity) 778 DO_2D( 1, 0, 1, 0 ) 794 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 795 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 779 796 zwz(ji,jj,jk) = ff_f(ji,jj) 780 797 END_2D 781 798 CASE ( np_RVO ) !* relative vorticity 782 DO_2D( 1, 0, 1, 0 ) 799 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 800 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 783 801 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 784 802 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 786 804 END_2D 787 805 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 788 DO_2D( 1, 0, 1, 0 ) 806 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 807 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 789 808 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 790 809 END_2D 791 810 ENDIF 792 811 CASE ( np_MET ) !* metric term 793 DO_2D( 1, 0, 1, 0 ) 812 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 813 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 794 814 zwz(ji,jj,jk) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 795 815 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 796 816 END_2D 797 817 CASE ( np_CRV ) !* Coriolis + relative vorticity 798 DO_2D( 1, 0, 1, 0 ) 818 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 819 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 799 820 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 800 821 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 802 823 END_2D 803 824 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 804 DO_2D( 1, 0, 1, 0 ) 825 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 826 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 805 827 zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 806 828 END_2D 807 829 ENDIF 808 830 CASE ( np_CME ) !* Coriolis + metric 809 DO_2D( 1, 0, 1, 0 ) 831 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 832 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 810 833 zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 811 834 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 819 842 ! ! =============== 820 843 ! 821 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )844 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 822 845 ! 823 846 ! ! =============== -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traatf.F90
r14576 r14712 111 111 ! ! local domain boundaries (T-point, unchanged sign) 112 112 ! [comm_cleanup] ! lbc_lnk moved into stp 113 !CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp )113 IF (nn_hls.eq.1) CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 114 114 ! 115 115 IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries … … 158 158 ! 159 159 ! [comm_cleanup] 160 !CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp )160 IF (nn_hls.eq.1) CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 161 161 162 162 ENDIF -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfosm.F90
r14665 r14712 400 400 zz0 = rn_abs ! surface equi-partition in 2-bands 401 401 zz1 = 1. - rn_abs 402 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 403 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 402 DO_2D( 0, 0, 0, 0 ) 404 403 ! Surface downward irradiance (so always +ve) 405 404 zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp … … 411 410 END_2D 412 411 ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 413 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 414 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 412 DO_2D( 0, 0, 0, 0 ) 415 413 zthermal = rab_n(ji,jj,1,jp_tem) 416 414 zbeta = rab_n(ji,jj,1,jp_sal) … … 439 437 ! Assume constant La#=0.3 440 438 CASE(0) 441 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 442 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 439 DO_2D( 0, 0, 0, 0 ) 443 440 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 444 441 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 … … 449 446 ! Assume Pierson-Moskovitz wind-wave spectrum 450 447 CASE(1) 451 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 452 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 448 DO_2D( 0, 0, 0, 0 ) 453 449 ! Use wind speed wndm included in sbc_oce module 454 450 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) … … 459 455 zfac = 2.0_wp * rpi / 16.0_wp 460 456 461 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 462 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 457 DO_2D( 0, 0, 0, 0 ) 463 458 IF (hsw(ji,jj) > 1.e-4) THEN 464 459 ! Use wave fields … … 477 472 IF (ln_zdfosm_ice_shelter) THEN 478 473 ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 479 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 480 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 474 DO_2D( 0, 0, 0, 0 ) 481 475 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 482 476 dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) … … 500 494 z_two_thirds = 2.0_wp / 3.0_wp 501 495 502 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 503 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 496 DO_2D( 0, 0, 0, 0 ) 504 497 zthickness = rn_osm_hblfrac*hbl(ji,jj) 505 498 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) … … 516 509 zsqrtpi = SQRT(rpi) 517 510 518 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 519 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 511 DO_2D( 0, 0, 0, 0 ) 520 512 zthickness = rn_osm_hblfrac*hbl(ji,jj) 521 513 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) … … 538 530 ! Langmuir velocity scale (zwstrl), La # (zla) 539 531 ! mixed scale (zvstr), convective velocity scale (zwstrc) 540 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 541 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 532 DO_2D( 0, 0, 0, 0 ) 542 533 ! Langmuir velocity scale (zwstrl), at T-point 543 534 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird … … 572 563 hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) ) 573 564 ibld(:,:) = 4 574 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 575 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 5, jpkm1 ) 565 DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 576 566 IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 577 567 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) … … 580 570 ! ########################################################################## 581 571 582 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 583 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 572 DO_2D( 0, 0, 0, 0 ) 584 573 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 585 574 imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji, jj, ibld(ji,jj), Kmm )) , 1 )) … … 601 590 ! Fox-Kemper Scheme 602 591 mld_prof = 4 603 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 604 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 592 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 605 593 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 606 594 END_3D … … 608 596 CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle) 609 597 610 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 611 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 598 DO_2D( 0, 0, 0, 0 ) 612 599 zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 613 600 END_2D … … 624 611 lflux(:,:) = .FALSE. 625 612 lmle(:,:) = .FALSE. 626 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 627 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 613 DO_2D( 0, 0, 0, 0 ) 628 614 IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 629 615 END_2D … … 631 617 632 618 ! Test if pycnocline well resolved 633 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 634 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 619 DO_2D( 0, 0, 0, 0 ) 635 620 IF (lconv(ji,jj) ) THEN 636 621 ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm) … … 653 638 ! Rate of change of hbl 654 639 CALL zdf_osm_calculate_dhdt( zdhdt, zddhdt ) 655 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 656 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 640 DO_2D( 0, 0, 0, 0 ) 657 641 zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need ww here, so subtract it 658 642 ! adjustment to represent limiting by ocean bottom … … 666 650 ibld(:,:) = 4 667 651 668 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 669 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 4, jpkm1 ) 652 DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 670 653 IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 671 654 ibld(ji,jj) = jk … … 686 669 CALL zdf_osm_pycnocline_thickness( dh, zdh ) 687 670 688 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 689 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 671 DO_2D( 0, 0, 0, 0 ) 690 672 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE. 691 673 END_2D … … 727 709 728 710 729 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 730 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 711 DO_2D( 0, 0, 0, 0 ) 731 712 IF ( lconv(ji,jj) ) THEN 732 713 DO jk = 2, imld(ji,jj) … … 763 744 IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv ) 764 745 END IF 765 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 766 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 746 DO_2D( 0, 0, 0, 0 ) 767 747 IF ( lconv(ji,jj) ) THEN 768 748 DO jk = 2, imld(ji,jj) … … 796 776 ENDWHERE 797 777 798 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 799 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 778 DO_2D( 0, 0, 0, 0 ) 800 779 IF (lconv(ji,jj) ) THEN 801 780 DO jk = 2, imld(ji,jj) … … 859 838 ENDWHERE 860 839 861 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 862 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 840 DO_2D( 0, 0, 0, 0 ) 863 841 IF ( lconv(ji,jj) ) THEN 864 842 DO jk = 2 , imld(ji,jj) … … 878 856 END_2D 879 857 880 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 881 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 858 DO_2D( 0, 0, 0, 0 ) 882 859 IF ( lpyc(ji,jj) ) THEN 883 860 IF ( j_ddh(ji,jj) == 0 ) THEN … … 914 891 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 915 892 916 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 917 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 893 DO_2D( 1, 0, 1, 0 ) 918 894 919 895 IF ( lconv(ji,jj) ) THEN … … 931 907 END_2D 932 908 933 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 934 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 909 DO_2D( 0, 0, 0, 0 ) 935 910 IF ( lconv(ji,jj) ) THEN 936 911 DO jk = 2, imld(ji,jj) … … 979 954 ENDWHERE 980 955 981 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 982 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 956 DO_2D( 0, 0, 0, 0 ) 983 957 IF ( lconv(ji,jj) ) THEN 984 958 DO jk = 2, imld(ji,jj) … … 1027 1001 ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 1028 1002 1029 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1030 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1003 DO_2D( 0, 0, 0, 0 ) 1031 1004 IF ( .not. lconv(ji,jj) ) THEN 1032 1005 DO jk = 2, ibld(ji,jj) … … 1044 1017 1045 1018 ! pynocline contributions 1046 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1047 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1019 DO_2D( 0, 0, 0, 0 ) 1048 1020 IF ( .not. lconv(ji,jj) ) THEN 1049 1021 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN … … 1063 1035 END IF 1064 1036 1065 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1066 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1037 DO_2D( 0, 0, 0, 0 ) 1067 1038 ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 1068 1039 ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp … … 1089 1060 ! rotate non-gradient velocity terms back to model reference frame 1090 1061 1091 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1092 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1062 DO_2D( 0, 0, 0, 0 ) 1093 1063 DO jk = 2, ibld(ji,jj) 1094 1064 ztemp = ghamu(ji,jj,jk) … … 1106 1076 ! KPP-style Ri# mixing 1107 1077 IF( ln_kpprimix) THEN 1108 1109 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) !* Shear production at uw- and vw-points (energy conserving form) 1110 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) 1078 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) !* Shear production at uw- and vw-points (energy conserving form) 1111 1079 z3du(ji,jj,jk) = 0.5 * ( uu(ji,jj,jk-1,Kmm) - uu(ji ,jj,jk,Kmm) ) & 1112 1080 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & … … 1117 1085 END_3D 1118 1086 ! 1119 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1120 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 1087 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1121 1088 ! ! shear prod. at w-point weightened by mask 1122 1089 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & … … 1129 1096 END_3D 1130 1097 1131 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1132 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1098 DO_2D( 0, 0, 0, 0 ) 1133 1099 DO jk = ibld(ji,jj) + 1, jpkm1 1134 1100 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri … … 1141 1107 ! KPP-style set diffusivity large if unstable below BL 1142 1108 IF( ln_convmix) THEN 1143 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1144 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1109 DO_2D( 0, 0, 0, 0 ) 1145 1110 DO jk = ibld(ji,jj) + 1, jpkm1 1146 1111 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv … … 1152 1117 1153 1118 IF ( ln_osm_mle ) THEN ! set up diffusivity and non-gradient mixing 1154 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1155 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1119 DO_2D( 0, 0, 0, 0 ) 1156 1120 IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 1157 1121 ! Calculate MLE flux contribution from surface fluxes … … 1194 1158 ! GN 25/8: need to change tmask --> wmask 1195 1159 1196 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1197 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 1160 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1198 1161 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1199 1162 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 1200 1163 END_3D 1201 1164 ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and v grids 1202 IF (nn_hls.eq.1)CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp, &1203 1165 CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp, & 1166 & ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 1204 1167 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1205 1168 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & … … 1213 1176 END_3D 1214 1177 ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged) 1215 ! [comm_cleanup] ! no need lbc_lnk for output 1216 ! NOTE: [tiling] still needed (at least for hmle in tra_mle_trp) 1217 CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1178 CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1218 1179 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1219 1180 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign changed) 1220 ! [comm_cleanup] ! no need lbc_lnk for output 1221 ! CALL lbc_lnk( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp, & 1222 ! & ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 1181 CALL lbc_lnk( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp, & 1182 & ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 1223 1183 1224 1184 IF(ln_dia_osm) THEN … … 1320 1280 REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 1321 1281 1322 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1323 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1282 DO_2D( 0, 0, 0, 0 ) 1324 1283 IF ( lconv(ji,jj) ) THEN 1325 1284 … … 1364 1323 END_2D 1365 1324 ! 1366 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1367 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1325 DO_2D( 0, 0, 0, 0 ) 1368 1326 IF ( lconv(ji,jj) ) THEN 1369 1327 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity … … 1464 1422 1465 1423 ! Determins stability and set flag lconv 1466 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1467 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1424 DO_2D( 0, 0, 0, 0 ) 1468 1425 IF ( zhol(ji,jj) < 0._wp ) THEN 1469 1426 lconv(ji,jj) = .TRUE. … … 1482 1439 j_ddh(:,:) = 1 1483 1440 1484 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1485 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1441 DO_2D( 0, 0, 0, 0 ) 1486 1442 IF ( lconv(ji,jj) ) THEN 1487 1443 IF ( zdb_bl(ji,jj) > 0._wp ) THEN … … 1520 1476 ! Calculate entrainment buoyancy flux due to surface fluxes. 1521 1477 1522 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1523 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1478 DO_2D( 0, 0, 0, 0 ) 1524 1479 IF ( lconv(ji,jj) ) THEN 1525 1480 zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln … … 1546 1501 zwb_min(:,:) = 0._wp 1547 1502 1548 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1549 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1503 DO_2D( 0, 0, 0, 0 ) 1550 1504 IF ( lshear(ji,jj) ) THEN 1551 1505 IF ( lconv(ji,jj) ) THEN … … 1608 1562 zu = 0._wp 1609 1563 zv = 0._wp 1610 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1611 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1564 DO_2D( 0, 0, 0, 0 ) 1612 1565 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 1613 1566 zbeta = rab_n(ji,jj,1,jp_sal) … … 1666 1619 REAL(wp) :: ztemp 1667 1620 1668 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1669 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1621 DO_2D( 0, 0, 0, 0 ) 1670 1622 ztemp = zu(ji,jj) 1671 1623 zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj) … … 1701 1653 znd_param(:,:) = 0._wp 1702 1654 1703 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1704 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1655 DO_2D( 0, 0, 0, 0 ) 1705 1656 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 1706 1657 zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj) 1707 1658 END_2D 1708 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1709 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1659 DO_2D( 0, 0, 0, 0 ) 1710 1660 ! 1711 1661 IF ( lconv(ji,jj) ) THEN … … 1731 1681 1732 1682 ! Diagnosis 1733 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1734 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1683 DO_2D( 0, 0, 0, 0 ) 1735 1684 IF ( lconv(ji,jj) ) THEN 1736 1685 zwb_ent = - 2.0 * 0.2 * zwbav(ji,jj) & … … 1802 1751 1803 1752 1804 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1805 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1753 DO_2D( 0, 0, 0, 0 ) 1806 1754 IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 1807 1755 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? … … 1833 1781 REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.15 1834 1782 1835 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1836 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1783 DO_2D( 0, 0, 0, 0 ) 1837 1784 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1838 1785 IF ( lconv(ji,jj) ) THEN ! convective conditions … … 1919 1866 REAL(wp) :: zzeta_v = 0.45 1920 1867 ! 1921 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1922 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1868 DO_2D( 0, 0, 0, 0 ) 1923 1869 ! 1924 1870 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN … … 1983 1929 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 1984 1930 1985 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1986 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1931 DO_2D( 0, 0, 0, 0 ) 1987 1932 1988 1933 IF ( lshear(ji,jj) ) THEN … … 2127 2072 REAL(wp) :: zthermal, zbeta 2128 2073 2129 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2130 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2074 DO_2D( 0, 0, 0, 0 ) 2131 2075 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 2132 2076 ! … … 2232 2176 REAL, PARAMETER :: a_ddh_2 = 3.5 ! also in pycnocline_depth 2233 2177 2234 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2235 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2178 DO_2D( 0, 0, 0, 0 ) 2236 2179 2237 2180 IF ( lshear(ji,jj) ) THEN … … 2379 2322 zmld(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 2380 2323 zN2_c = grav * rn_osm_mle_rho_c * r1_rho0 ! convert density criteria into N^2 criteria 2381 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 2382 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 ) 2324 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 2383 2325 ikt = mbkt(ji,jj) 2384 2326 zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 2385 2327 IF( zmld(ji,jj) < zN2_c ) mld_prof(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 2386 2328 END_3D 2387 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 2388 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 2329 DO_2D( 1, 1, 1, 1 ) 2389 2330 mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj)) 2390 2331 zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) … … 2396 2337 ztm(:,:) = 0._wp 2397 2338 zsm(:,:) = 0._wp 2398 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax ) 2399 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax ) 2339 DO_3D( 1, 1, 1, 1, 1, ikmax ) 2400 2340 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 2401 2341 ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) … … 2407 2347 ! calculate horizontal gradients at u & v points 2408 2348 2409 ! [comm_cleanup] ! DO_2D( 1, 0, 0, 0 ) 2410 DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 2349 DO_2D( 1, 0, 0, 0 ) 2411 2350 zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 2412 2351 zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) … … 2416 2355 END_2D 2417 2356 2418 ! [comm_cleanup] ! DO_2D( 0, 0, 1, 0 ) 2419 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 2357 DO_2D( 0, 0, 1, 0 ) 2420 2358 zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 2421 2359 zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) … … 2428 2366 CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm) 2429 2367 2430 ! [comm_cleanup] ! DO_2D( 1, 0, 0, 0 ) 2431 DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 2368 DO_2D( 1, 0, 0, 0 ) 2432 2369 dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal)) 2433 2370 END_2D 2434 ! [comm_cleanup] ! DO_2D( 0, 0, 1, 0 ) 2435 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 2371 DO_2D( 0, 0, 1, 0 ) 2436 2372 dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal)) 2437 2373 END_2D 2438 2374 2439 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2440 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2375 DO_2D( 0, 0, 0, 0 ) 2441 2376 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 2442 2377 zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & … … 2465 2400 ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 2466 2401 2467 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2468 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2402 DO_2D( 0, 0, 0, 0 ) 2469 2403 IF ( lconv(ji,jj) ) THEN 2470 2404 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf … … 2475 2409 END_2D 2476 2410 ! Timestep mixed layer eddy depth. 2477 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2478 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2411 DO_2D( 0, 0, 0, 0 ) 2479 2412 IF ( lmle(ji,jj) ) THEN ! MLE layer growing. 2480 2413 ! Buoyancy gradient at base of MLE layer. … … 2500 2433 2501 2434 mld_prof = 4 2502 2503 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 2504 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 2435 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 2505 2436 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 2506 2437 END_3D 2507 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2508 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2438 DO_2D( 0, 0, 0, 0 ) 2509 2439 zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 2510 2440 END_2D … … 2655 2585 ! ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 2656 2586 z1_t2 = 2.e-5 2657 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 2658 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 2587 DO_2D( 1, 1, 1, 1 ) 2659 2588 r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2) 2660 2589 END_2D … … 2701 2630 etmean(:,:,:) = 0.e0 2702 2631 2703 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2704 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 2632 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2705 2633 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 2706 2634 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & … … 2716 2644 etmean(:,:,:) = 0.e0 2717 2645 2718 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2719 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 2646 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2720 2647 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 2721 2648 & / MAX( 1., 2.* tmask(ji,jj,jk) & … … 2832 2759 ! 2833 2760 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 2834 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 2835 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 2761 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 2836 2762 ikt = mbkt(ji,jj) 2837 2763 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) … … 2839 2765 END_3D 2840 2766 ! 2841 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 2842 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 2767 DO_2D( 1, 1, 1, 1 ) 2843 2768 iiki = MAX(4,imld_rst(ji,jj)) 2844 2769 hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm ) ! Turbocline depth … … 2875 2800 ! 2876 2801 IF( kt == nit000 ) THEN 2877 IF( .NOT. l_istiled.OR. ntile == 1 ) THEN ! Do only on the first tile2802 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 2878 2803 IF(lwp) WRITE(numout,*) 2879 2804 IF(lwp) WRITE(numout,*) 'tra_osm : OSM non-local tracer fluxes' … … 2948 2873 ! 2949 2874 IF( kt == nit000 ) THEN 2950 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 2951 IF(lwp) WRITE(numout,*) 2952 IF(lwp) WRITE(numout,*) 'dyn_osm : OSM non-local velocity' 2953 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 2954 ENDIF 2875 IF(lwp) WRITE(numout,*) 2876 IF(lwp) WRITE(numout,*) 'dyn_osm : OSM non-local velocity' 2877 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 2955 2878 ENDIF 2956 2879 !code saving tracer trends removed, replace with trdmxl_oce -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/step.F90
r14636 r14712 224 224 & CALL Agrif_Sponge_dyn ! momentum sponge 225 225 #endif 226 IF (nn_hls.eq.2) THEN 227 ! [comm_cleanup] ! needed from DYN 228 CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) 229 IF(.NOT.ln_linssh) CALL lbc_lnk( 'stp', e3f, 'F', 1. ) 230 ! [comm_cleanup] ! needed from DYN dyn_ldf_blp 231 CALL lbc_lnk( 'stp', uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.) 232 ENDIF 226 233 CALL dyn_adv( kstp, Nbb, Nnn , uu, vv, Nrhs ) ! advection (VF or FF) ==> RHS 227 234 CALL dyn_vor( kstp, Nnn , uu, vv, Nrhs ) ! vorticity ==> RHS … … 349 356 !!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 350 357 ! [comm_cleanup] 351 CALL lbc_lnk( 'stp', ts(:,:,:,jp_tem,Naa), 'T', 1.0_wp, ts(:,:,:,jp_sal,Naa), 'T', 1.0_wp ) 358 IF (nn_hls.eq.2) CALL lbc_lnk( 'stp', ts(:,:,:,jp_tem,Naa), 'T', 1.0_wp, ts(:,:,:,jp_sal,Naa), 'T', 1.0_wp, & 359 & uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1.) 360 352 361 CALL tra_atf ( kstp, Nbb, Nnn, Naa, ts ) ! time filtering of "now" tracer arrays 353 362 CALL dyn_atf ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v ) ! time filtering of "now" velocities and scale factors -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/stpmlf.F90
r14680 r14712 62 62 # include "do_loop_substitute.h90" 63 63 # include "domzgr_substitute.h90" 64 # include "do_loop_substitute.h90"65 64 !!---------------------------------------------------------------------- 66 65 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 241 240 & CALL Agrif_Sponge_dyn ! momentum sponge 242 241 #endif 242 ! [comm_cleanup] ! lbc_lnk from DYN 243 IF (nn_hls.eq.2) THEN 244 CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1., & 245 & uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.) 246 IF(.NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Nnn), 'U', 1.0_wp, r3v(:,:,Nnn), 'V', 1.0_wp, & 247 & r3u(:,:,Nbb), 'U', 1.0_wp, r3v(:,:,Nbb), 'V', 1.0_wp, & 248 & r3t(:,:,Nbb), 'T', 1.0_wp ) 249 ENDIF 243 250 CALL dyn_adv( kstp, Nbb, Nnn , uu, vv, Nrhs ) ! advection (VF or FF) ==> RHS 244 251 CALL dyn_vor( kstp, Nnn , uu, vv, Nrhs ) ! vorticity ==> RHS 245 252 CALL dyn_ldf( kstp, Nbb, Nnn , uu, vv, Nrhs ) ! lateral mixing 246 253 IF( ln_zdfosm ) CALL dyn_osm( kstp, Nnn , uu, vv, Nrhs ) ! OSMOSIS non-local velocity fluxes ==> RHS 254 247 255 CALL dyn_hpg( kstp, Nnn , uu, vv, Nrhs ) ! horizontal gradient of Hydrostatic pressure 248 256 CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa ) ! surface pressure gradient
Note: See TracChangeset
for help on using the changeset viewer.