Changeset 14757 for NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup
- Timestamp:
- 2021-04-27T17:33:44+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src
- Files:
-
- 48 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DOM/domqco.F90
r14730 r14757 96 96 #endif 97 97 ! 98 IF(nn_hls .eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Kbb), 'U', 1.0_wp, r3v(:,:,Kbb), 'V', 1.0_wp, r3t(:,:,Kbb), 'T', 1.0_wp, &98 IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Kbb), 'U', 1.0_wp, r3v(:,:,Kbb), 'V', 1.0_wp, r3t(:,:,Kbb), 'T', 1.0_wp, & 99 99 & r3u(:,:,Kmm), 'U', 1.0_wp, r3v(:,:,Kmm), 'V', 1.0_wp, r3t(:,:,Kmm), 'T', 1.0_wp, r3f(:,:), 'F', 1.0_wp ) 100 100 END SUBROUTINE dom_qco_init … … 156 156 #if ! defined key_qcoTest_FluxForm 157 157 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 158 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )159 158 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 160 159 pr3u(ji,jj) = 0.5_wp * ( e1e2t(ji ,jj) * pssh(ji ,jj) & … … 165 164 !!st ELSE !- Flux Form (simple averaging) 166 165 #else 167 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )168 166 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 169 167 pr3u(ji,jj) = 0.5_wp * ( pssh(ji,jj) + pssh(ji+1,jj ) ) * r1_hu_0(ji,jj) … … 174 172 ! 175 173 IF( .NOT.PRESENT( pr3f ) ) THEN !- lbc on ratio at u-, v-points only 176 IF (nn_hls .eq.1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp )174 IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 177 175 ! 178 176 ! … … 183 181 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 184 182 185 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line186 183 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 187 184 ! round brackets added to fix the order of floating point operations … … 197 194 !!st ELSE !- Flux Form (simple averaging) 198 195 #else 199 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line200 196 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 201 197 ! round brackets added to fix the order of floating point operations … … 209 205 #endif 210 206 ! ! lbc on ratio at u-,v-,f-points 211 IF (nn_hls .eq.1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp )207 IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 212 208 ! 213 209 ENDIF -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/divhor.F90
r14667 r14757 75 75 ENDIF 76 76 ! 77 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Horizontal divergence ==!78 77 DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 ) !== Horizontal divergence ==! 79 78 ! round brackets added to fix the order of floating point operations … … 97 96 IF( ln_isf ) CALL isf_hdiv( kt, Kmm, hdiv ) !== ice shelf ==! (update hdiv field) 98 97 ! 99 IF (nn_hls .eq.1) CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp ) ! (no sign change)98 IF (nn_hls==1) CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp ) ! (no sign change) 100 99 ! 101 100 IF( ln_timing ) CALL timing_stop('div_hor') -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynadv_ubs.F90
r14682 r14757 108 108 zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 109 109 ! 110 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! laplacian111 110 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! laplacia 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) 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) 115 zlu_uv(ji,jj,jk,1) = ( puu (ji ,jj+1,jk,Kbb) - puu (ji ,jj ,jk,Kbb) ) * fmask(ji ,jj ,jk) & 116 & - ( puu (ji ,jj ,jk,Kbb) - puu (ji ,jj-1,jk,Kbb) ) * fmask(ji ,jj-1,jk) 117 zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj ,jk,Kbb) - pvv (ji ,jj ,jk,Kbb) ) * fmask(ji ,jj ,jk) & 118 & - ( pvv (ji ,jj ,jk,Kbb) - pvv (ji-1,jj ,jk,Kbb) ) * fmask(ji-1,jj ,jk) 119 ! 120 zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj ,jk) ) * umask(ji,jj,jk) 121 zlv_vv(ji,jj,jk,2) = ( zfv(ji ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji ,jj-1,jk) ) * vmask(ji,jj,jk) 122 zlu_uv(ji,jj,jk,2) = ( zfu(ji ,jj+1,jk) - zfu(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 123 & - ( zfu(ji ,jj ,jk) - zfu(ji ,jj-1,jk) ) * fmask(ji ,jj-1,jk) 124 zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj ,jk) - zfv(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 125 & - ( zfv(ji ,jj ,jk) - zfv(ji-1,jj ,jk) ) * fmask(ji-1,jj ,jk) 111 ! round brackets added to fix the order of floating point operations 112 ! needed to ensure halo 1 - halo 2 compatibility 113 zlu_uu(ji,jj,jk,1) = ( ( puu (ji+1,jj ,jk,Kbb) - puu (ji ,jj ,jk,Kbb) & 114 & ) & ! bracket for halo 1 - halo 2 compatibility 115 & + ( puu (ji-1,jj ,jk,Kbb) - puu (ji ,jj ,jk,Kbb) & 116 & ) & ! bracket for halo 1 - halo 2 compatibility 117 & ) * umask(ji ,jj ,jk) 118 zlv_vv(ji,jj,jk,1) = ( ( pvv (ji ,jj+1,jk,Kbb) - pvv (ji ,jj ,jk,Kbb) & 119 & ) & ! bracket for halo 1 - halo 2 compatibility 120 & + ( pvv (ji ,jj-1,jk,Kbb) - pvv (ji ,jj ,jk,Kbb) & 121 & ) & ! bracket for halo 1 - halo 2 compatibility 122 & ) * vmask(ji ,jj ,jk) 123 zlu_uv(ji,jj,jk,1) = ( puu (ji ,jj+1,jk,Kbb) - puu (ji ,jj ,jk,Kbb) ) * fmask(ji ,jj ,jk) & 124 & - ( puu (ji ,jj ,jk,Kbb) - puu (ji ,jj-1,jk,Kbb) ) * fmask(ji ,jj-1,jk) 125 zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj ,jk,Kbb) - pvv (ji ,jj ,jk,Kbb) ) * fmask(ji ,jj ,jk) & 126 & - ( pvv (ji ,jj ,jk,Kbb) - pvv (ji-1,jj ,jk,Kbb) ) * fmask(ji-1,jj ,jk) 127 ! 128 ! round brackets added to fix the order of floating point operations 129 ! needed to ensure halo 1 - halo 2 compatibility 130 zlu_uu(ji,jj,jk,2) = ( ( zfu(ji+1,jj ,jk) - zfu(ji ,jj ,jk) & 131 & ) & ! bracket for halo 1 - halo 2 compatibility 132 & + ( zfu(ji-1,jj ,jk) - zfu(ji ,jj ,jk) & 133 & ) & ! bracket for halo 1 - halo 2 compatibility 134 & ) * umask(ji ,jj ,jk) 135 zlv_vv(ji,jj,jk,2) = ( ( zfv(ji ,jj+1,jk) - zfv(ji ,jj ,jk) & 136 & ) & ! bracket for halo 1 - halo 2 compatibility 137 & + ( zfv(ji ,jj-1,jk) - zfv(ji ,jj ,jk) & 138 & ) & ! bracket for halo 1 - halo 2 compatibility 139 & ) * vmask(ji ,jj ,jk) 140 zlu_uv(ji,jj,jk,2) = ( zfu(ji ,jj+1,jk) - zfu(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 141 & - ( zfu(ji ,jj ,jk) - zfu(ji ,jj-1,jk) ) * fmask(ji ,jj-1,jk) 142 zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj ,jk) - zfv(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 143 & - ( zfv(ji ,jj ,jk) - zfv(ji-1,jj ,jk) ) * fmask(ji-1,jj ,jk) 126 144 END_2D 127 145 END DO 128 IF (nn_hls.eq.1) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp, & 129 & zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp, & 130 & zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp, & 131 & zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp ) 146 ! NOTE: [tiling] sign reversal necessary for results to be independent of nn_hls (bug in trunk) 147 IF( nn_hls==1 ) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', -1.0_wp , zlu_uv(:,:,:,1), 'U', -1.0_wp, & 148 & zlu_uu(:,:,:,2), 'U', -1.0_wp , zlu_uv(:,:,:,2), 'U', -1.0_wp, & 149 & zlv_vv(:,:,:,1), 'V', -1.0_wp , zlv_vu(:,:,:,1), 'V', -1.0_wp, & 150 & zlv_vv(:,:,:,2), 'V', -1.0_wp , zlv_vu(:,:,:,2), 'V', -1.0_wp ) 132 151 ! 133 152 ! ! ====================== ! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynatf.F90
r14682 r14757 169 169 # endif 170 170 ! 171 IF (nn_hls .eq.1) CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp ) !* local domain boundaries171 IF (nn_hls==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 ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 )204 203 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 205 204 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) ) … … 238 237 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 239 238 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 240 ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 )241 239 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 242 240 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) ) … … 250 248 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 251 249 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 252 ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 )253 250 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 254 251 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynhpg.F90
r14682 r14757 118 118 CASE ( np_zps ) ; CALL hpg_zps ( kt, Kmm, puu, pvv, Krhs ) ! z-coordinate plus partial steps (interpolation) 119 119 CASE ( np_sco ) ; CALL hpg_sco ( kt, Kmm, puu, pvv, Krhs ) ! s-coordinate (standard jacobian formulation) 120 CASE ( np_djc ) ; CALL hpg_djc ( kt, Kmm, puu, pvv, Krhs ) ! s-coordinate (Density Jacobian with Cubic polynomial) 120 CASE ( np_djc ) 121 ! [ comm_cleanup ] : it should not be needed but the removal/shift of this lbc_lnk results in a seg_fault error 122 IF (nn_hls==2) CALL lbc_lnk( 'dynhpg', r3t(:,:,Kmm), 'T', 1.) 123 CALL hpg_djc ( kt, Kmm, puu, pvv, Krhs ) ! s-coordinate (Density Jacobian with Cubic polynomial) 121 124 CASE ( np_prj ) ; CALL hpg_prj ( kt, Kmm, puu, pvv, Krhs ) ! s-coordinate (Pressure Jacobian scheme) 122 125 CASE ( np_isf ) ; CALL hpg_isf ( kt, Kmm, puu, pvv, Krhs ) ! s-coordinate similar to sco modify for ice shelf … … 462 465 END IF 463 466 END_2D 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 it466 ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )467 467 END IF 468 468 ! … … 691 691 END IF 692 692 END_2D 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 ) 693 ! NOTE: [tiling] sign reversal necessary for results to be independent of nn_hls (bug in trunk) 694 IF( nn_hls == 1 ) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1._wp, zdzx, 'U', -1._wp, zdrhoy, 'V', -1._wp, zdzy, 'V', -1._wp ) 696 695 END IF 697 696 … … 789 788 ! 5. compute and store elementary horizontal differences in provisional arrays 790 789 !---------------------------------------------------------------------------------------- 791 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 ) 790 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 794 791 zdrhox(ji,jj,jk) = rhd (ji+1,jj ,jk) - rhd (ji,jj,jk ) 795 792 zdzx (ji,jj,jk) = - gde3w(ji+1,jj ,jk) + gde3w(ji,jj,jk ) … … 798 795 END_3D 799 796 800 CALL lbc_lnk( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V',1. )797 IF (nn_hls==1) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1., zdzx, 'U', -1., zdrhoy, 'V', -1., zdzy, 'V', -1. ) 801 798 802 799 !------------------------------------------------------------------------- … … 1048 1045 ENDIF 1049 1046 END_2D 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 it1052 ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp )1053 1047 ENDIF 1054 1048 … … 1119 1113 & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 1120 1114 END_2D 1121 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 domain1124 ! CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp )1125 1115 1126 1116 DO_2D( 0, 0, 0, 0 ) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynkeg.F90
r14682 r14757 109 109 END_3D 110 110 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 111 ! [comm_cleanup ] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )112 111 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 113 112 ! round brackets added to fix the order of floating point operations … … 126 125 zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 127 126 END_3D 128 IF (nn_hls .eq.1) CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp )127 IF (nn_hls==1) CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp ) 129 128 ! 130 129 END SELECT -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynldf_iso.F90
r14682 r14757 128 128 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 129 129 ! 130 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )131 130 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) ! set the slopes of iso-level 132 131 uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) … … 136 135 END_3D 137 136 ! Lateral boundary conditions on the slopes 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 )137 IF (nn_hls==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 ) 139 138 ! 140 139 ENDIF -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynldf_lap_blp.F90
r14682 r14757 83 83 DO jk = 1, jpkm1 ! Horizontal slab 84 84 ! 85 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )86 85 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 87 86 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) … … 95 94 END_2D 96 95 ! 97 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! - curl( curl) + grad( div )98 96 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! - curl( curl) + grad( div ) 99 97 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use … … 116 114 DO jk = 1, jpkm1 ! Horizontal slab 117 115 ! 118 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )119 116 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 120 117 ! ! shearing stress component (F-point) NB : ahmf has already been multiplied by fmask … … 132 129 END_2D 133 130 ! 134 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )135 131 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 136 132 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & … … 189 185 CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 ) ! rotated laplacian applied to pt (output in zlap,Kbb) 190 186 ! 191 IF (nn_hls .eq.1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp ) ! Lateral boundary conditions187 IF (nn_hls==1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp ) ! Lateral boundary conditions 192 188 ! 193 189 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_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynvor.F90
r14682 r14757 256 256 ALLOCATE( zwz(jpi,jpj,jpk) ) 257 257 DO jk = 1, jpkm1 ! Horizontal slab 258 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )259 258 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 260 259 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & … … 262 261 END_2D 263 262 IF( ln_dynvor_msk ) THEN ! mask relative vorticity 264 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )265 263 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 266 264 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) … … 268 266 ENDIF 269 267 END DO 270 IF (nn_hls .eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )268 IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 271 269 ! 272 270 END SELECT … … 627 625 ! 628 626 #if defined key_qco || defined key_linssh 629 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! == reciprocal of e3 at F-point (key_qco)630 627 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! == reciprocal of e3 at F-point (key_qco) 631 628 z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) … … 634 631 SELECT CASE( nn_e3f_typ ) ! == reciprocal of e3 at F-point 635 632 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 636 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )637 633 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 638 634 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & … … 645 641 END_2D 646 642 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 647 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )648 643 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 649 644 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & … … 663 658 ! 664 659 CASE ( np_COR ) !* Coriolis (planetary vorticity) 665 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )666 660 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 667 661 zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 668 662 END_2D 669 663 CASE ( np_RVO ) !* relative vorticity 670 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )671 664 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 672 665 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & … … 674 667 END_2D 675 668 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 676 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )677 669 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 678 670 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) … … 680 672 ENDIF 681 673 CASE ( np_MET ) !* metric term 682 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )683 674 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 684 675 zwz(ji,jj,jk) = ( ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & … … 686 677 END_2D 687 678 CASE ( np_CRV ) !* Coriolis + relative vorticity 688 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )689 679 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 690 680 ! round brackets added to fix the order of floating point operations … … 697 687 END_2D 698 688 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 699 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )700 689 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 701 690 zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) … … 703 692 ENDIF 704 693 CASE ( np_CME ) !* Coriolis + metric 705 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )706 694 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 707 695 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & … … 715 703 ! ! =============== 716 704 ! 717 IF (nn_hls .eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )705 IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 718 706 ! 719 707 ! ! =============== … … 792 780 SELECT CASE( kvor ) !== vorticity considered ==! 793 781 CASE ( np_COR ) !* Coriolis (planetary vorticity) 794 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )795 782 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 796 783 zwz(ji,jj,jk) = ff_f(ji,jj) 797 784 END_2D 798 785 CASE ( np_RVO ) !* relative vorticity 799 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )800 786 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 801 787 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & … … 804 790 END_2D 805 791 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 806 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )807 792 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 808 793 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) … … 810 795 ENDIF 811 796 CASE ( np_MET ) !* metric term 812 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )813 797 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 814 798 zwz(ji,jj,jk) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & … … 816 800 END_2D 817 801 CASE ( np_CRV ) !* Coriolis + relative vorticity 818 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )819 802 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 820 803 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & … … 823 806 END_2D 824 807 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 825 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )826 808 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 827 809 zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) … … 829 811 ENDIF 830 812 CASE ( np_CME ) !* Coriolis + metric 831 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )832 813 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 833 814 zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & … … 842 823 ! ! =============== 843 824 ! 844 IF (nn_hls .eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp )825 IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 845 826 ! 846 827 ! ! =============== -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynzad.F90
r14667 r14757 79 79 80 80 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 81 ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) ! vertical fluxes82 81 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! vertical fluxes 83 82 IF( ln_vortex_force ) THEN … … 87 86 ENDIF 88 87 END_2D 89 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! vertical momentum advection at w-point90 88 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! vertical momentum advection at w-point 91 89 zwuw(ji,jj,jk) = ( zww(ji+1,jj ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) … … 95 93 ! 96 94 ! Surface and bottom advective fluxes set to zero 97 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )98 95 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 99 96 zwuw(ji,jj, 1 ) = 0._wp … … 103 100 END_2D 104 101 ! 105 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points106 102 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points 107 103 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/sshwzv.F90
r14667 r14757 103 103 ! 104 104 zhdiv(:,:) = 0._wp 105 ! [comm_cleanup] ! DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports106 105 DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 ) ! Horizontal divergence of barotropic transports 107 106 zhdiv(ji,jj) = zhdiv(ji,jj) + e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk) … … 111 110 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 112 111 ! 113 ! [comm_cleanup]114 112 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 115 113 pssh(ji,jj,Kaa) = ( pssh(ji,jj,Kbb) - rDt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) ) ) * ssmask(ji,jj) … … 123 121 IF ( .NOT.ln_dynspg_ts ) THEN 124 122 IF( ln_bdy ) THEN 125 ! [comm_cleanup] 126 IF (nn_hls.eq.1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp ) ! Not sure that's necessary 123 IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp ) ! Not sure that's necessary 127 124 CALL bdy_ssh( pssh(:,:,Kaa) ) ! Duplicate sea level across open boundaries 128 125 ENDIF … … 183 180 ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 184 181 ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way) 185 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )186 182 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 187 183 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) ) 188 184 END_2D 189 185 END DO 190 IF (nn_hls .eq.1) CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp) ! - ML - Perhaps not necessary: not used for horizontal "connexions"186 IF (nn_hls==1) CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp) ! - ML - Perhaps not necessary: not used for horizontal "connexions" 191 187 ! ! Is it problematic to have a wrong vertical velocity in boundary cells? 192 188 ! ! Same question holds for hdiv. Perhaps just for security … … 363 359 zdt = 2._wp * rn_Dt ! 2*rn_Dt and not rDt (for restartability) 364 360 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 365 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )366 361 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 367 362 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) … … 381 376 END_3D 382 377 ELSE 383 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )384 378 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 385 379 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) … … 395 389 END_3D 396 390 ENDIF 397 IF (nn_hls .eq.1) CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp )391 IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 398 392 ! 399 393 CALL iom_put("Courant",Cu_adv) 400 394 ! 401 395 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 402 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary403 396 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary 404 397 ! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ISF/isfhdiv.F90
r14667 r14757 100 100 ! 101 101 ! update divergence at each level affected by ice shelf top boundary layer 102 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )103 102 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 104 103 ikt = ktop(ji,jj) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/LDF/ldfslp.F90
r14609 r14757 371 371 ! 372 372 ip = jl ; jp = jl ! guaranteed nonzero gradients ( absolute value larger than repsln) 373 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! done each pair of triad ! NB: not masked ==> a minimum value is set374 373 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! done each pair of triad ! NB: not masked ==> a minimum value is set 375 374 zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) ) ! i-gradient of T & S at u-point … … 384 383 ! 385 384 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 386 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )387 385 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 388 386 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) … … 399 397 400 398 DO kp = 0, 1 !== unmasked before density i- j-, k-gradients ==! 401 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! done each pair of triad ! NB: not masked ==> a minimum value is set402 399 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) ! done each pair of triad ! NB: not masked ==> a minimum value is set 403 400 IF( jk+kp > 1 ) THEN ! k-gradient of T & S a jk+kp … … 415 412 END DO 416 413 ! 417 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) !== Reciprocal depth of the w-point below ML base ==!418 414 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !== Reciprocal depth of the w-point below ML base ==! 419 415 jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1 ! MIN in case ML depth is the ocean depth … … 436 432 DO jl = 0, 1 ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 437 433 DO kp = 0, 1 ! with only the slope-max limit and MASKED 438 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )439 434 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 440 435 ip = jl ; jp = jl … … 474 469 ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 475 470 znot_thru_surface = REAL( 1-1/(jk+kp), wp ) !jk+kp=1,=0.; otherwise=1.0 476 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )477 471 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 478 472 ! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/LDF/ldftra.F90
r14667 r14757 647 647 ! ! Compute lateral diffusive coefficient at T-point 648 648 IF( ln_traldf_triad ) THEN 649 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )650 649 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 651 650 ! Take the max of N^2 and zero then take the vertical sum … … 662 661 END_3D 663 662 ELSE 664 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )665 663 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 666 664 ! Take the max of N^2 and zero then take the vertical sum … … 679 677 ENDIF 680 678 681 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )682 679 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 683 680 zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) … … 690 687 ! !== Bound on eiv coeff. ==! 691 688 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) 692 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )693 689 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 694 690 zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj) ! tropical decrease … … 697 693 CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp ) ! lateral boundary condition 698 694 ! 699 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )700 695 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 701 696 paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj ) ) * umask(ji,jj,1) … … 756 751 zpsi_uw(:,:,jpk) = 0._wp ; zpsi_vw(:,:,jpk) = 0._wp 757 752 ! 758 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 )759 753 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) 760 754 zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk ) + wslpi(ji+1,jj,jk) ) & … … 764 758 END_3D 765 759 ! 766 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 )767 760 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 768 761 pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 769 762 pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 770 763 END_3D 771 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )772 764 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 773 765 pw(ji,jj,jk) = pw(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj ,jk) & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/SBC/sbccpl.F90
r14511 r14757 1293 1293 IF( llnewtau ) THEN 1294 1294 zcoef = 1. / ( zrhoa * zcdrag ) 1295 DO_2D( 1, 1, 1, 1)1295 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 1296 1296 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1297 1297 END_2D -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/SBC/sbcrnf.F90
r14667 r14757 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 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )209 208 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 210 209 DO jk = 1, nk_rnf(ji,jj) … … 213 212 END_2D 214 213 ELSE !* variable volume case 215 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed216 214 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! update the depth over which runoffs are distributed 217 215 h_rnf(ji,jj) = 0._wp … … 360 358 ! 361 359 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 362 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )363 360 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 364 361 IF( h_rnf(ji,jj) > 0._wp ) THEN … … 374 371 ENDIF 375 372 END_2D 376 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! set the associated depth377 373 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth 378 374 h_rnf(ji,jj) = 0._wp … … 405 401 WHERE( zrnfcl(:,:,1) > 0._wp ) h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs 406 402 ! 407 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! take in account min depth of ocean rn_hmin408 403 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! take in account min depth of ocean rn_hmin 409 404 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN … … 414 409 ! 415 410 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 416 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )417 411 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 418 412 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN … … 426 420 END_2D 427 421 ! 428 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! set the associated depth429 422 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth 430 423 h_rnf(ji,jj) = 0._wp -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv.F90
r14730 r14757 180 180 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 181 181 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 182 IF (nn_hls .EQ.2) THEN182 IF (nn_hls==2) THEN 183 183 #if defined key_loop_fusion 184 184 CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) … … 190 190 END IF 191 191 CASE ( np_MUS ) ! MUSCL 192 IF (nn_hls .EQ.2) THEN192 IF (nn_hls==2) THEN 193 193 #if defined key_loop_fusion 194 194 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_cen.F90
r14511 r14757 119 119 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 120 120 END_3D 121 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond.121 IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. 122 122 ! 123 123 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 131 131 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v 132 132 END_3D 133 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. )133 IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 134 134 ! 135 135 CASE DEFAULT -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_fct.F90
r14511 r14757 238 238 END_2D 239 239 END DO 240 CALL lbc_lnk( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 241 ! 242 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 240 ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 241 CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 242 ! 243 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 243 244 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points 244 245 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 245 246 ! ! C4 minus upstream advective fluxes 246 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 247 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 248 END_3D 249 IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 247 ! round brackets added to fix the order of floating point operations 248 ! needed to ensure halo 1 - halo 2 compatibility 249 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu(ji,jj,jk) - zltu(ji+1,jj,jk) & 250 & ) & ! bracket for halo 1 - halo 2 compatibility 251 & ) - zwx(ji,jj,jk) 252 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv(ji,jj,jk) - zltv(ji,jj+1,jk) & 253 & ) & ! bracket for halo 1 - halo 2 compatibility 254 & ) - zwy(ji,jj,jk) 255 END_3D 250 256 ! 251 257 CASE( 41 ) !- 4th order centered ==>> !!gm coding attempt need to be tested 252 258 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 253 259 ztv(:,:,jpk) = 0._wp 254 DO_3D( nn_hls , nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! 1st derivative (gradient)260 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! 1st derivative (gradient) 255 261 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 256 262 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 257 263 END_3D 258 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)264 IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 259 265 ! 260 266 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 268 274 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 269 275 END_3D 270 IF (nn_hls .EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)276 IF (nn_hls==2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 271 277 ! 272 278 END SELECT … … 291 297 ENDIF 292 298 ! 293 IF (nn_hls .EQ.1) THEN299 IF (nn_hls==1) THEN 294 300 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 295 301 ELSE … … 449 455 END_2D 450 456 END DO 451 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign)457 IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 452 458 453 459 ! 3. monotonic flux in the i & j direction (paa & pbb) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_mus.F90
r14511 r14757 139 139 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 140 140 END_3D 141 ! lateral boundary conditions (changed sign)142 IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )143 141 ! !-- Slopes of tracer 144 142 zslpx(:,:,jpk) = 0._wp ! bottom values 145 143 zslpy(:,:,jpk) = 0._wp 146 DO_3D( nn_hls-1, 1, nn_hls-1,1, 1, jpkm1 )144 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 147 145 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 148 146 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 151 149 END_3D 152 150 ! 153 DO_3D( nn_hls-1, 1, nn_hls-1,1, 1, jpkm1 ) !-- Slopes limitation151 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !-- Slopes limitation 154 152 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 155 153 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 159 157 & 2.*ABS( zwy (ji,jj ,jk) ) ) 160 158 END_3D 161 ! 162 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes 159 ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 160 IF ( nn_hls==1 ) CALL lbc_lnk( 'traadv_mus', zslpx, 'T', -1.0_wp , zslpy, 'T', -1.0_wp ) ! lateral boundary conditions (changed sign) 161 ! 162 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes 163 163 ! MUSCL fluxes 164 164 z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) … … 176 176 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 177 177 END_3D 178 IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign)179 178 ! 180 179 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Tracer advective trend -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_qck.F90
r14511 r14757 149 149 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 150 150 END_3D 151 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions151 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 152 152 153 153 ! … … 167 167 END_3D 168 168 !--- Lateral boundary conditions 169 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwx(:,:,:), 'T', 1.0_wp )169 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwx(:,:,:), 'T', 1.0_wp ) 170 170 171 171 !--- QUICKEST scheme … … 176 176 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 177 177 END_3D 178 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions178 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 179 179 180 180 ! … … 239 239 END_2D 240 240 END DO 241 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions241 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 242 242 243 243 ! … … 259 259 260 260 !--- Lateral boundary conditions 261 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp )261 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 262 262 263 263 !--- QUICKEST scheme … … 268 268 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 269 269 END_3D 270 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions270 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions 271 271 ! 272 272 ! Tracer flux on the x-direction -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_ubs.F90
r14511 r14757 140 140 ! 141 141 END DO 142 IF (nn_hls .EQ.1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn)142 IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 143 143 ! 144 144 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== Horizontal advective fluxes ==! (UBS) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traatf.F90
r14682 r14757 110 110 #endif 111 111 ! ! local domain boundaries (T-point, unchanged sign) 112 ! [comm_cleanup] ! lbc_lnk moved into stp 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 ) 112 CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 114 113 ! 115 114 IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries … … 157 156 ENDIF 158 157 ! 159 ! [comm_cleanup] 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 ) 158 CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 161 159 162 160 ENDIF -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traatf_qco.F90
r14609 r14757 146 146 ENDIF 147 147 ! 148 ! [ comm_cleanup ] 149 IF (nn_hls.eq.1) CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 148 IF (nn_hls==1) CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 150 149 ! 151 150 ENDIF -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/trabbl.F90
r14609 r14757 141 141 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 142 142 ! lateral boundary conditions ; just need for outputs 143 ! [ comm_cleanup ] ! no need lbc_lnk for outputs144 ! CALL lbc_lnk( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp )145 143 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 146 144 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf_iso.F90
r14667 r14757 147 147 ENDIF 148 148 ! 149 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )150 149 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 151 150 akz (ji,jj,jk) = 0._wp … … 173 172 IF( kpass == 1 ) THEN !== first pass only ==! 174 173 ! 175 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )176 174 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 177 175 ! … … 196 194 ! 197 195 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 198 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )199 196 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 200 197 ! round brackets added to fix the order of floating point operations … … 210 207 ! 211 208 IF( ln_traldf_blp ) THEN ! bilaplacian operator 212 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )213 209 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 214 210 akz(ji,jj,jk) = 16._wp & … … 219 215 END_3D 220 216 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 221 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )222 217 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 223 218 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) … … 228 223 ! 229 224 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 230 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )231 225 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 232 226 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) … … 248 242 249 243 ! Horizontal tracer gradient 250 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 )251 244 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 252 245 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) … … 254 247 END_3D 255 248 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 256 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! bottom correction (partial bottom cell)257 249 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! bottom correction (partial bottom cell) 258 250 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) … … 260 252 END_2D 261 253 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 262 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )263 254 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 264 255 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) … … 274 265 DO jk = 1, jpkm1 ! Horizontal slab 275 266 ! 276 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )277 267 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 278 268 ! !== Vertical tracer gradient … … 284 274 END_2D 285 275 ! 286 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) !== Horizontal fluxes287 276 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) !== Horizontal fluxes 288 277 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) … … 314 303 END_2D 315 304 ! 316 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !== horizontal divergence and add to pta317 305 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== horizontal divergence and add to pta 318 306 ! round brackets added to fix the order of floating point operations … … 336 324 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 337 325 338 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! interior (2=<jk=<jpk-1)339 326 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 340 327 ! … … 367 354 ! !== add the vertical 33 flux ==! 368 355 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 369 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )370 356 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 371 357 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & … … 377 363 SELECT CASE( kpass ) 378 364 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 379 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )380 365 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 381 366 ztfw(ji,jj,jk) = & … … 384 369 END_3D 385 370 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 386 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )387 371 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 388 372 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & … … 393 377 ENDIF 394 378 ! 395 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==!396 379 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 397 380 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf_lap_blp.F90
r14667 r14757 239 239 END SELECT 240 240 ! 241 ! [comm_cleanup] 242 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 241 IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 243 242 ! ! Partial top/bottom cell: GRADh( zlap ) 244 243 IF( ln_zps ) THEN -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf_triad.F90
r14667 r14757 148 148 IF( kpass == 1 ) THEN !== first pass only and whatever the tracer is ==! 149 149 ! 150 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )151 150 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 152 151 akz (ji,jj,jk) = 0._wp … … 155 154 ! 156 155 DO kp = 0, 1 ! i-k triads 157 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )158 156 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 159 157 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) … … 179 177 ! 180 178 DO kp = 0, 1 ! j-k triads 181 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )182 179 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 183 180 ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) … … 207 204 ! 208 205 IF( ln_traldf_blp ) THEN ! bilaplacian operator 209 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )210 206 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 211 207 akz(ji,jj,jk) = 16._wp & … … 216 212 END_3D 217 213 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 218 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )219 214 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 220 215 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) … … 225 220 ! 226 221 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 227 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )228 222 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 229 223 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) … … 270 264 zftv(:,:,:) = 0._wp 271 265 ! 272 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== before lateral T & S gradients at T-level jk ==!273 266 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) !== before lateral T & S gradients at T-level jk ==! 274 267 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) … … 276 269 END_3D 277 270 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 278 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! bottom level279 271 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! bottom level 280 272 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) … … 282 274 END_2D 283 275 IF( ln_isfcav ) THEN ! top level (ocean cavities only) 284 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )285 276 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 286 277 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) … … 296 287 DO jk = 1, jpkm1 297 288 ! !== Vertical tracer gradient at level jk and jk+1 298 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )299 289 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 300 290 zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) … … 304 294 IF( jk == 1 ) THEN ; zdkt3d(:,:,0) = zdkt3d(:,:,1) 305 295 ELSE 306 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )307 296 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 308 297 zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) … … 314 303 IF( ln_botmix_triad ) THEN 315 304 DO kp = 0, 1 !== Horizontal & vertical fluxes 316 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )317 305 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 318 306 ze1ur = r1_e1u(ji,jj) … … 351 339 ! 352 340 DO kp = 0, 1 353 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )354 341 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 355 342 ze2vr = r1_e2v(ji,jj) … … 389 376 ! 390 377 DO kp = 0, 1 !== Horizontal & vertical fluxes 391 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )392 378 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 393 379 ze1ur = r1_e1u(ji,jj) … … 428 414 ! 429 415 DO kp = 0, 1 430 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )431 416 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 432 417 ze2vr = r1_e2v(ji,jj) … … 466 451 ENDIF 467 452 ! !== horizontal divergence and add to the general trend ==! 468 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )469 453 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 470 454 ! round brackets added to fix the order of floating point operations … … 482 466 ! !== add the vertical 33 flux ==! 483 467 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 484 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 )485 468 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 486 469 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & … … 491 474 SELECT CASE( kpass ) 492 475 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 493 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 )494 476 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 495 477 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & … … 497 479 END_3D 498 480 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 499 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 )500 481 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 501 482 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & … … 506 487 ENDIF 507 488 ! 508 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==!509 489 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 510 490 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/tramle.F90
r14538 r14757 110 110 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 111 111 CASE ( 0 ) != min of the 2 neighbour MLDs 112 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )113 112 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 114 113 zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) … … 116 115 END_2D 117 116 CASE ( 1 ) != average of the 2 neighbour MLDs 118 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )119 117 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 120 118 zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) … … 122 120 END_2D 123 121 CASE ( 2 ) != max of the 2 neighbour MLDs 124 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )125 122 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 126 123 zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) … … 129 126 END SELECT 130 127 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 131 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )132 128 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 133 129 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2u(ji,jj) & … … 141 137 ! 142 138 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 143 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )144 139 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 145 140 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2u(ji,jj) & … … 154 149 ! !== MLD used for MLE ==! 155 150 ! ! compute from the 10m density to deal with the diurnal cycle 156 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )157 151 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 158 152 inml_mle(ji,jj) = mbkt(ji,jj) + 1 ! init. to number of ocean w-level (T-level + 1) 159 153 END_2D 160 154 IF ( nla10 > 0 ) THEN ! avoid case where first level is thicker than 10m 161 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m)162 155 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m) 163 156 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle ) inml_mle(ji,jj) = jk ! Mixed layer … … 170 163 zbm (:,:) = 0._wp 171 164 zn2 (:,:) = 0._wp 172 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer173 165 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer 174 166 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points … … 180 172 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 181 173 CASE ( 0 ) != min of the 2 neighbour MLDs 182 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )183 174 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 184 175 zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) … … 186 177 END_2D 187 178 CASE ( 1 ) != average of the 2 neighbour MLDs 188 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )189 179 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 190 180 zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp … … 192 182 END_2D 193 183 CASE ( 2 ) != max of the 2 neighbour MLDs 194 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )195 184 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 196 185 zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) … … 199 188 END SELECT 200 189 ! ! convert density into buoyancy 201 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )202 190 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 203 191 zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) … … 213 201 ! 214 202 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 215 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )216 203 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 217 204 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & … … 225 212 ! 226 213 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 227 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )228 214 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 229 215 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & … … 236 222 ! 237 223 IF( nn_conv == 1 ) THEN ! No MLE in case of convection 238 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )239 224 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 240 225 IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp ) zpsim_u(ji,jj) = 0._wp … … 245 230 ENDIF ! end of ln_osm_mle conditional 246 231 ! !== structure function value at uw- and vw-points ==! 247 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )248 232 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 249 233 zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall) ! hu --> 1/hu … … 254 238 zpsi_vw(:,:,:) = 0._wp 255 239 ! 256 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, ikmax ) ! start from 2 : surface value = 0257 240 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax ) ! start from 2 : surface value = 0 258 241 … … 270 253 ! !== transport increased by the MLE induced transport ==! 271 254 DO jk = 1, ikmax 272 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! CAUTION pu,pv must be defined at row/column i=1 / j=1273 255 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 274 256 pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 275 257 pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 276 258 END_2D 277 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )278 259 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 279 260 pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk) & … … 290 271 ! 291 272 IF (ln_osm_mle.and.ln_zdfosm) THEN 292 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )293 273 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 294 274 zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 295 275 END_2D 296 276 ELSE 297 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )298 277 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 299 278 zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f … … 302 281 ! 303 282 ! divide by cross distance to give streamfunction with dimensions m^2/s 304 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, ikmax+1 )305 283 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, ikmax+1 ) 306 284 zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/zpshde.F90
r14667 r14757 169 169 END DO 170 170 ! 171 IF (nn_hls .EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.171 IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 172 172 ! 173 173 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) … … 202 202 ENDIF 203 203 END_2D 204 IF (nn_hls .EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions204 IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 205 205 ! 206 206 END IF … … 350 350 END DO 351 351 ! 352 IF (nn_hls .EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.352 IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 353 353 354 354 ! horizontal derivative of density anomalies (rd) … … 392 392 END_2D 393 393 394 IF (nn_hls .EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions394 IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 395 395 ! 396 396 END IF … … 443 443 ! 444 444 END DO 445 IF (nn_hls .EQ.1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.445 IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 446 446 447 447 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) … … 482 482 483 483 END_2D 484 IF (nn_hls .EQ.1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions484 IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions 485 485 ! 486 486 END IF -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfddm.F90
r14601 r14757 95 95 !!gm and many acces in memory 96 96 97 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==!98 97 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==! 99 98 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & … … 112 111 END_2D 113 112 114 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) !== indicators ==!115 113 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !== indicators ==! 116 114 ! stability indicator: msks=1 if rn2>0; 0 elsewhere … … 143 141 ! ------------------ 144 142 ! Constant eddy coefficient: reset to the background value 145 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )146 143 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 147 144 zinr = 1._wp / zrau(ji,jj) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfdrg.F90
r14601 r14757 117 117 ! 118 118 IF( l_log_not_linssh ) THEN !== "log layer" ==! compute Cd and -Cd*|U| 119 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )120 119 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 121 120 imk = k_mk(ji,jj) ! ocean bottom level at t-points … … 130 129 END_2D 131 130 ELSE !== standard Cd ==! 132 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )133 131 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 134 132 imk = k_mk(ji,jj) ! ocean bottom level at t-points … … 178 176 ENDIF 179 177 180 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )181 178 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 182 179 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels … … 192 189 ! 193 190 IF( ln_isfcav ) THEN ! ocean cavities 194 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )195 191 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 196 192 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels … … 436 432 l_log_not_linssh = .FALSE. !- don't update Cd at each time step 437 433 ! 438 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! pCd0 = mask (and boosted) logarithmic drag coef.439 434 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! pCd0 = mask (and boosted) logarithmic drag coef. 440 435 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfevd.F90
r14601 r14757 87 87 ! END WHERE 88 88 ! 89 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )90 89 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 91 90 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN … … 104 103 ! END WHERE 105 104 106 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )107 105 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 108 106 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfgls.F90
r14601 r14757 179 179 180 180 ! Compute surface, top and bottom friction at T-points 181 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !== surface ocean friction182 181 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== surface ocean friction 183 182 ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) ! surface friction … … 187 186 ! 188 187 IF( .NOT.ln_drg_OFF ) THEN !== top/bottom friction (explicit before friction) 189 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! bottom friction (explicit before friction)190 188 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! bottom friction (explicit before friction) 191 189 zmsku = 0.5_wp * ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) … … 195 193 END_2D 196 194 IF( ln_isfcav ) THEN 197 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! top friction198 195 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! top friction 199 196 zmsku = 0.5_wp * ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) … … 223 220 zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1) + (1._wp - tmask(:,:,1))*rn_hsro 224 221 ! 225 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== Compute dissipation rate ==!226 222 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !== Compute dissipation rate ==! 227 223 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) … … 233 229 234 230 IF( nn_clos == 0 ) THEN ! Mellor-Yamada 235 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )236 231 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 237 232 zup = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) … … 255 250 ! Warning : after this step, en : right hand side of the matrix 256 251 257 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )258 252 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 259 253 ! … … 333 327 ! at k=2, set de/dz=Fw 334 328 !cbr 335 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo336 329 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! zdiag zd_lw not defined/used on the halo 337 330 zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) ! Remove zd_lw from zdiag … … 355 348 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 356 349 ! ! Balance between the production and the dissipation terms 357 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )358 350 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 359 351 !!gm This means that bottom and ocean w-level above have a specified "en" value. Sure ???? … … 374 366 ! 375 367 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 376 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )377 368 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 378 369 itop = mikt(ji,jj) ! k top w-point … … 393 384 CASE ( 1 ) ! Neumman boundary condition 394 385 ! 395 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )396 386 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 397 387 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 409 399 END_2D 410 400 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 411 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )412 401 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 413 402 itop = mikt(ji,jj) ! k top w-point … … 431 420 ! ---------------------------------------------------------- 432 421 ! 433 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1434 422 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 435 423 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 436 424 END_3D 437 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1438 425 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 439 426 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 440 427 END_3D 441 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk442 428 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 443 429 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) … … 455 441 ! 456 442 CASE( 0 ) ! k-kl (Mellor-Yamada) 457 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )458 443 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 459 444 psi(ji,jj,jk) = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) … … 461 446 ! 462 447 CASE( 1 ) ! k-eps 463 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )464 448 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 465 449 psi(ji,jj,jk) = eps(ji,jj,jk) … … 467 451 ! 468 452 CASE( 2 ) ! k-w 469 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )470 453 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 471 454 psi(ji,jj,jk) = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) … … 473 456 ! 474 457 CASE( 3 ) ! generic 475 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )476 458 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 477 459 psi(ji,jj,jk) = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn … … 487 469 ! Warning : after this step, en : right hand side of the matrix 488 470 489 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )490 471 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 491 472 ! … … 560 541 ! 561 542 ! Neumann condition at k=2 562 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo563 543 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! zdiag zd_lw not defined/used on the halo 564 544 zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) ! Remove zd_lw from zdiag … … 589 569 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 590 570 ! ! Balance between the production and the dissipation terms 591 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )592 571 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 593 572 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 609 588 CASE ( 1 ) ! Neumman boundary condition 610 589 ! 611 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )612 590 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 613 591 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 638 616 ! ---------------- 639 617 ! 640 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1641 618 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 642 619 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 643 620 END_3D 644 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1645 621 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 646 622 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 647 623 END_3D 648 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk649 624 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 650 625 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) … … 657 632 ! 658 633 CASE( 0 ) ! k-kl (Mellor-Yamada) 659 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )660 634 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 661 635 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) … … 663 637 ! 664 638 CASE( 1 ) ! k-eps 665 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )666 639 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 667 640 eps(ji,jj,jk) = psi(ji,jj,jk) … … 669 642 ! 670 643 CASE( 2 ) ! k-w 671 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )672 644 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 673 645 eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) … … 678 650 zex1 = ( 1.5_wp + rmm/rnn ) 679 651 zex2 = -1._wp / rnn 680 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )681 652 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 682 653 eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 … … 687 658 ! Limit dissipation rate under stable stratification 688 659 ! -------------------------------------------------- 689 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time690 660 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time 691 661 ! limitation … … 704 674 ! 705 675 CASE ( 0 , 1 ) ! Galperin or Kantha-Clayson stability functions 706 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )707 676 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 708 677 ! zcof = l²/q² … … 722 691 ! 723 692 CASE ( 2, 3 ) ! Canuto stability functions 724 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )725 693 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 726 694 ! zcof = l²/q² … … 755 723 ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 756 724 zstm(:,:,jpk) = 0. 757 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! update bottom with good values758 725 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! update bottom with good values 759 726 zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) … … 771 738 ! later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 772 739 ! for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 773 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk )774 740 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 775 741 zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfiwm.F90
r14601 r14757 143 143 ! Set to zero the 1st and last vertical levels of appropriate variables 144 144 IF( iom_use("emix_iwm") ) THEN 145 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )146 145 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 147 146 zemx_iwm (ji,jj,1) = 0._wp ; zemx_iwm (ji,jj,jpk) = 0._wp … … 149 148 ENDIF 150 149 IF( iom_use("av_ratio") ) THEN 151 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )152 150 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 153 151 zav_ratio(ji,jj,1) = 0._wp ; zav_ratio(ji,jj,jpk) = 0._wp … … 155 153 ENDIF 156 154 IF( iom_use("av_wave") .OR. sn_cfctl%l_prtctl ) THEN 157 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )158 155 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 159 156 zav_wave (ji,jj,1) = 0._wp ; zav_wave (ji,jj,jpk) = 0._wp … … 167 164 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 168 165 ! using an exponential decay from the seafloor. 169 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! part independent of the level170 166 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! part independent of the level 171 167 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean … … 174 170 END_2D 175 171 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 176 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part177 172 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part 178 173 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization … … 195 190 CASE ( 1 ) ! Dissipation scales as N (recommended) 196 191 ! 197 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )198 192 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 199 193 zfact(ji,jj) = 0._wp 200 194 END_2D 201 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level202 195 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level 203 196 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 204 197 END_3D 205 198 ! 206 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )207 199 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 208 200 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 209 201 END_2D 210 202 ! 211 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part212 203 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part 213 204 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) … … 216 207 CASE ( 2 ) ! Dissipation scales as N^2 217 208 ! 218 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )219 209 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 220 210 zfact(ji,jj) = 0._wp 221 211 END_2D 222 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level223 212 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level 224 213 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 225 214 END_3D 226 215 ! 227 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )228 216 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 229 217 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 230 218 END_2D 231 219 ! 232 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )233 220 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 234 221 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) … … 240 227 ! !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 241 228 ! 242 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )243 229 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 244 230 zwkb(ji,jj,1) = 0._wp 245 231 END_2D 246 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )247 232 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 248 233 zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 249 234 END_3D 250 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )251 235 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 252 236 zfact(ji,jj) = zwkb(ji,jj,jpkm1) 253 237 END_2D 254 238 ! 255 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )256 239 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 257 240 IF( zfact(ji,jj) /= 0 ) zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) ) & 258 241 & * wmask(ji,jj,jk) / zfact(ji,jj) 259 242 END_3D 260 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )261 243 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 262 244 zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 263 245 END_2D 264 246 ! 265 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )266 247 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 267 248 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization: EXP coast a lot … … 273 254 END_3D 274 255 ! 275 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )276 256 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 277 257 zfact(ji,jj) = 0._wp 278 258 END_2D 279 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level280 259 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level 281 260 zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 282 261 END_3D 283 262 ! 284 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )285 263 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 286 264 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 287 265 END_2D 288 266 ! 289 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part290 267 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part 291 268 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk) & … … 296 273 !!gm this is to be replaced by just a constant value znu=1.e-6 m2/s 297 274 ! Calculate molecular kinematic viscosity 298 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )299 275 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 300 276 znu_t(ji,jj,jk) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm) & … … 302 278 & + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm) ) * tmask(ji,jj,jk) * r1_rho0 303 279 END_3D 304 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )305 280 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 306 281 znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) … … 309 284 ! 310 285 ! Calculate turbulence intensity parameter Reb 311 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )312 286 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 313 287 zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) … … 315 289 ! 316 290 ! Define internal wave-induced diffusivity 317 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )318 291 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 319 292 zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6 … … 321 294 ! 322 295 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 323 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes324 296 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 325 297 IF( zReb(ji,jj,jk) > 480.00_wp ) THEN … … 331 303 ENDIF 332 304 ! 333 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s334 305 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s 335 306 zav_wave(ji,jj,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp ) * wmask(ji,jj,jk) … … 339 310 zztmp = 0._wp 340 311 !!gm used of glosum 3D.... 341 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )342 312 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 343 313 zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj) & … … 362 332 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 363 333 ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 364 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb365 334 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb 366 335 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 … … 372 341 END_3D 373 342 CALL iom_put( "av_ratio", zav_ratio ) 374 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing375 343 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing 376 344 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) … … 380 348 ! 381 349 ELSE !* update momentum & tracer diffusivity with wave-driven mixing 382 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )383 350 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 384 351 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfmfc.F90
r14601 r14757 218 218 WHERE(zrautbm1 .NE. 0.) zfbuo(:,:) = grav * (zraupl(:,:) - zrautbm1(:,:)) / zrautbm1(:,:) 219 219 220 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )221 220 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 222 221 … … 377 376 ! 378 377 ! 379 ! [comm_cleanup] 380 IF (nn_hls.eq.1) CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 378 IF (nn_hls==1) CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 381 379 ! 382 380 END SUBROUTINE tra_mfc -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfmxl.F90
r14601 r14757 99 99 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 100 100 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 101 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) ! Mixed layer level: w-level102 101 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 ) ! Mixed layer level: w-level 103 102 ikt = mbkt(ji,jj) … … 109 108 ! w-level of the turbocline and mixing layer (iom_use) 110 109 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 111 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10112 110 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 113 111 IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline 114 112 END_3D 115 113 ! depth of the mixing and mixed layers 116 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )117 114 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 118 115 iiki = imld(ji,jj) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfphy.F90
r14601 r14757 284 284 CASE( np_TKE ) ; CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! TKE closure scheme for Kz 285 285 CASE( np_GLS ) ; CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! GLS closure scheme for Kz 286 ! [comm_cleanup] ! modified but not tested - no ref config uses this scheme287 286 CASE( np_OSM ) ; CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k ) ! OSMOSIS closure scheme for Kz 288 287 ! CASE( np_CST ) ! Constant Kz (reset avt, avm to the background value) … … 323 322 324 323 ! !* Lateral boundary conditions (sign unchanged) 325 ! [comm_cleanup] ! lbc_lnk shifted in stp 326 IF(nn_hls.eq.1) THEN 324 IF(nn_hls==1) THEN 327 325 IF( l_zdfsh2 ) THEN 328 326 CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfric.F90
r14601 r14757 156 156 ! 157 157 ! !== avm and avt = F(Richardson number) ==! 158 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri)159 158 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri) 160 159 zcfRi = 1._wp / ( 1._wp + rn_alp * MAX( 0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) ) ) … … 170 169 IF( ln_mldw ) THEN !== set a minimum value in the Ekman layer ==! 171 170 ! 172 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !* Ekman depth173 171 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 174 172 zustar = SQRT( taum(ji,jj) * r1_rho0 ) … … 176 174 zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range 177 175 END_2D 178 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer179 176 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer 180 177 IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfsh2.F90
r14601 r14757 65 65 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 66 66 IF ( cpl_sdrftx .AND. ln_stshear ) THEN ! Surface Stokes Drift available ===>>> shear + stokes drift contibution 67 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )68 67 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 69 68 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & … … 79 78 END_2D 80 79 ELSE 81 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) !* 2 x shear production at uw- and vw-points (energy conserving form)82 80 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) !* 2 x shear production at uw- and vw-points (energy conserving form) 83 81 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & … … 93 91 END_2D 94 92 ENDIF 95 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked)96 93 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 97 94 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfswm.F90
r14601 r14757 63 63 ! 64 64 zcoef = 1._wp * 0.353553_wp 65 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )66 65 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 67 66 zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdftke.F90
r14601 r14757 241 241 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 242 242 ! 243 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )244 243 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 245 244 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) … … 259 258 IF( .NOT.ln_drg_OFF ) THEN !== friction used as top/bottom boundary condition on TKE 260 259 ! 261 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! bottom friction262 260 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! bottom friction 263 261 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) … … 269 267 END_2D 270 268 IF( ln_isfcav ) THEN 271 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! top friction272 269 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! top friction 273 270 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) … … 297 294 !!gm ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 298 295 !!gm ! so we will overestimate the LC velocity.... !!gm I will do the work if !LC have an effect ! 299 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )300 296 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 301 297 !!XC zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) ) … … 305 301 ! Projection of Stokes drift in the wind stress direction 306 302 ! 307 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )308 303 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 309 304 ztaui = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) … … 312 307 zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 313 308 END_2D 314 ! [comm_cleanup] 315 IF (nn_hls.eq.1) CALL lbc_lnk ( 'zdftke', zWlc2, 'T', 1. ) 309 IF (nn_hls==1) CALL lbc_lnk ( 'zdftke', zWlc2, 'T', 1. ) 316 310 ! 317 311 ELSE ! Surface Stokes drift deduced from surface stress … … 321 315 ! ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 322 316 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) ! to convert stress in 10m wind using a constant drag 323 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )324 317 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 325 318 zWlc2(ji,jj) = zcof * taum(ji,jj) … … 338 331 ! !- compare LHS to RHS of Eq.47 339 332 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 340 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )341 333 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 ) 342 334 IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) ) imlc(ji,jj) = jk 343 335 END_3D 344 336 ! ! finite LC depth 345 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )346 337 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 347 338 zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) … … 349 340 ! 350 341 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 351 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )352 342 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 353 343 zus = SQRT( 2. * zWlc2(ji,jj) ) ! Stokes drift 354 344 zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 355 345 END_2D 356 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en357 346 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en 358 347 IF ( zus3(ji,jj) /= 0._wp ) THEN … … 376 365 ! 377 366 IF( nn_pdl == 1 ) THEN !* Prandtl number = F( Ri ) 378 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )379 367 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 380 368 ! ! local Richardson number … … 389 377 ENDIF 390 378 ! 391 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* Matrix and right hand side in en392 379 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* Matrix and right hand side in en 393 380 zcof = zfact1 * tmask(ji,jj,jk) … … 419 406 420 407 CASE ( 0 ) ! Dirichlet BC 421 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0)422 408 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0) 423 409 IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp … … 427 413 428 414 CASE ( 1 ) ! Neumann BC 429 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )430 415 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 431 416 IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp … … 442 427 ! 443 428 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 444 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1445 429 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 446 430 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) … … 450 434 ! zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 451 435 ! END_2D 452 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )453 436 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 454 437 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 455 438 END_3D 456 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk457 439 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 458 440 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 459 441 END_2D 460 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 )461 442 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 462 443 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 463 444 END_3D 464 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! set the minimum value of tke465 445 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! set the minimum value of tke 466 446 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) … … 476 456 ! 477 457 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 478 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )479 458 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 480 459 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & … … 482 461 END_3D 483 462 ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction) 484 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )485 463 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 486 464 jk = nmln(ji,jj) … … 489 467 END_2D 490 468 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 491 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )492 469 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 493 470 ztx2 = utau(ji-1,jj ) + utau(ji,jj) … … 571 548 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 572 549 #if ! defined key_si3 && ! defined key_cice 573 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! No sea-ice574 550 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! No sea-ice 575 551 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) … … 579 555 ! 580 556 CASE( 0 ) ! No scaling under sea-ice 581 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )582 557 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 583 558 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) … … 585 560 ! 586 561 CASE( 1 ) ! scaling with constant sea-ice thickness 587 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )588 562 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 589 563 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & … … 592 566 ! 593 567 CASE( 2 ) ! scaling with mean sea-ice thickness 594 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )595 568 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 596 569 #if defined key_si3 … … 605 578 ! 606 579 CASE( 3 ) ! scaling with max sea-ice thickness 607 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )608 580 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 609 581 zmaxice = MAXVAL( h_i(ji,jj,:) ) … … 615 587 #endif 616 588 ! 617 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )618 589 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 619 590 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) … … 625 596 ENDIF 626 597 ! 627 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )628 598 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 629 599 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) … … 641 611 ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 642 612 CASE ( 0 ) ! bounded by the distance to surface and bottom 643 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )644 613 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 645 614 zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk), & … … 653 622 ! 654 623 CASE ( 1 ) ! bounded by the vertical scale factor 655 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )656 624 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 657 625 zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) … … 661 629 ! 662 630 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 663 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom :664 631 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! from the surface to the bottom : 665 632 zmxlm(ji,jj,jk) = & 666 633 & MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 667 634 END_3D 668 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface :669 635 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! from the bottom to the surface : 670 636 zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) … … 674 640 ! 675 641 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 676 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : lup677 642 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! from the surface to the bottom : lup 678 643 zmxld(ji,jj,jk) = & 679 644 & MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 680 645 END_3D 681 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown682 646 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown 683 647 zmxlm(ji,jj,jk) = & 684 648 & MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 685 649 END_3D 686 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )687 650 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 688 651 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) … … 697 660 ! ! Vertical eddy viscosity and diffusivity (avm and avt) 698 661 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 699 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points700 662 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points 701 663 zsqen = SQRT( en(ji,jj,jk) ) … … 708 670 ! 709 671 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 710 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )711 672 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 712 673 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/nemogcm.F90
r14511 r14757 390 390 CALL mpp_init 391 391 392 #if ! defined key_qco && ! defined key_linssh 393 IF( nn_hls == 2 ) THEN 394 CALL ctl_stop( 'STOP', 'nemogcm : Extra-halo can not be used if key_qco is not defined' ) 395 ENDIF 396 #endif 397 #if defined key_loop_fusion 398 IF( nn_hls == 1 ) THEN 399 CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' ) 400 ENDIF 401 #endif 402 392 403 CALL halo_mng_init() 393 404 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/step.F90
r14682 r14757 168 168 CALL bn2 ( ts(:,:,:,:,Nnn), rab_n, rn2, Nnn ) ! now Brunt-Vaisala frequency 169 169 170 ! [comm_cleanup]171 IF (nn_hls.eq.2) THEN172 IF( l_zdfsh2 ) THEN173 CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, &174 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp )175 ELSE176 CALL lbc_lnk( 'stp', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp )177 ENDIF178 ENDIF179 170 ! VERTICAL PHYSICS 180 171 CALL zdf_phy( kstp, Nbb, Nnn, Nrhs ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD) … … 224 215 & CALL Agrif_Sponge_dyn ! momentum sponge 225 216 #endif 226 IF (nn_hls.eq.2) THEN227 ! [comm_cleanup] ! needed from DYN228 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_blp231 CALL lbc_lnk( 'stp', uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.)232 ENDIF233 217 CALL dyn_adv( kstp, Nbb, Nnn , uu, vv, Nrhs ) ! advection (VF or FF) ==> RHS 234 218 CALL dyn_vor( kstp, Nnn , uu, vv, Nrhs ) ! vorticity ==> RHS … … 304 288 ENDIF 305 289 #endif 306 307 ! [comm_cleanup]308 IF (nn_hls.EQ.2) THEN309 SELECT CASE ( nadv )310 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order311 CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.)312 CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.)313 CASE ( np_MUS ) ! MUSCL314 CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.)315 CASE ( np_UBS ) ! UBS316 CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.)317 CASE ( np_QCK ) ! QUICKEST318 CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.)319 CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.)320 END SELECT321 ENDIF322 290 323 291 ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) … … 355 323 !! 356 324 !!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 357 ! [comm_cleanup]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 361 325 CALL tra_atf ( kstp, Nbb, Nnn, Naa, ts ) ! time filtering of "now" tracer arrays 362 326 CALL dyn_atf ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v ) ! time filtering of "now" velocities and scale factors -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/stpmlf.F90
r14730 r14757 248 248 ENDIF 249 249 250 IF(nn_hls .eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1.0_wp, r3v(:,:,Naa), 'V', 1.0_wp)250 IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1.0_wp, r3v(:,:,Naa), 'V', 1.0_wp ) 251 251 252 252 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 275 275 IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) ! "now" ssh/h_0 ratio from filtrered ssh 276 276 ! 277 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, r3t_f, 'T', 1.0_wp )277 IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp, r3t_f, 'T', 1.0_wp ) 278 278 #if defined key_top 279 279 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 350 350 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities 351 351 352 IF( nn_hls .eq.2) CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp)352 IF( nn_hls==2) CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp) 353 353 354 354 IF(.NOT.lk_linssh) THEN … … 517 517 & , pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 518 518 ! 519 IF (nn_hls .eq.2) THEN519 IF (nn_hls==2) THEN 520 520 IF( l_zdfsh2 ) THEN 521 CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, & 522 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 523 ELSE 524 CALL lbc_lnk( 'stp_MLF', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 521 CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp) 525 522 ENDIF 526 523 ENDIF -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/SWE/stprk3.F90
r14730 r14757 172 172 ! 173 173 CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 174 ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 175 IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 174 IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 176 175 ! 177 176 ! !== Swap time levels ==! … … 239 238 ! 240 239 CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 241 ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 242 IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 240 IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 243 241 ! 244 242 ! !== Swap time levels ==! … … 304 302 ! 305 303 CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 306 ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 307 IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 304 IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 308 305 ! 309 306 ! !== Swap time levels ==! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/TRP/trcadv.F90
r14730 r14757 129 129 CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 130 130 CASE ( np_FCT ) ! FCT : 2nd / 4th order 131 IF (nn_hls .EQ.2) THEN131 IF (nn_hls==2) THEN 132 132 #if defined key_loop_fusion 133 133 CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) … … 139 139 END IF 140 140 CASE ( np_MUS ) ! MUSCL 141 IF (nn_hls .EQ.2) THEN141 IF (nn_hls==2) THEN 142 142 #if defined key_loop_fusion 143 143 CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/TRP/trcldf.F90
r14609 r14757 83 83 zahv(:,:,:) = rldf * ahtv(:,:,:) 84 84 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 85 ! [ comm_cleanup ] DO_3D( 1, 1, 1, 1, 1, jpk )86 85 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 87 86 IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN … … 103 102 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 104 103 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 105 IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1.)106 104 CALL tra_ldf_blp ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 107 105 & ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs), jptra, nldf_trc )
Note: See TracChangeset
for help on using the changeset viewer.