- Timestamp:
- 2021-03-23T17:55:26+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 16 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynspg_ts.F90
r14574 r14631 730 730 IF (ln_bt_fw) THEN 731 731 IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 732 DO_2D( 1, 1, 1, 1)732 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 733 733 zun_save = un_adv(ji,jj) 734 734 zvn_save = vn_adv(ji,jj) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LDF/ldfslp.F90
r14576 r14631 558 558 CALL lbc_lnk( 'ldfslp', wslp2, 'W', 1.0_wp ) ! lateral boundary confition on wslp2 only ==>>> gm : necessary ? to be checked 559 559 ! 560 ! [comm_cleanup] - this comm have to be deleted !!!!!561 IF (nn_hls.eq.2) THEN562 CALL lbc_lnk( 'ldfslp', triadi(:,:,:,:,0), 'U', 1.0_wp, triadi(:,:,:,:,1), 'U', 1.0_wp )563 CALL lbc_lnk( 'ldfslp', triadj(:,:,:,:,0), 'V', 1.0_wp, triadj(:,:,:,:,1), 'V', 1.0_wp )564 CALL lbc_lnk( 'ldfslp', triadi_g(:,:,:,:,0), 'U', 1.0_wp, triadi_g(:,:,:,:,1), 'U', 1.0_wp )565 CALL lbc_lnk( 'ldfslp', triadj_g(:,:,:,:,0), 'V', 1.0_wp, triadj_g(:,:,:,:,1), 'V', 1.0_wp )566 END IF567 568 560 IF( ln_timing ) CALL timing_stop('ldf_slp_triad') 569 561 ! -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90
r14576 r14631 734 734 INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices 735 735 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 736 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components [m3/s] 737 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pv ! out: 3 ocean transport components [m3/s] 738 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the eiv [m3/s] 736 ! TEMP: [tiling] Can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 737 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu ! in : 3 ocean transport components [m3/s] 738 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pv ! out: 3 ocean transport components [m3/s] 739 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pw ! increased by the eiv [m3/s] 739 740 !! 740 741 INTEGER :: ji, jj, jk ! dummy loop indices … … 765 766 ! 766 767 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 767 DO_3D ( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )768 DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 768 769 pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 769 770 pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 770 771 END_3D 771 772 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 772 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )773 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 773 774 pw(ji,jj,jk) = pw(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj ,jk) & 774 & 775 & + zpsi_vw(ji,jj,jk) - zpsi_vw(ji ,jj-1,jk) ) 775 776 END_3D 776 777 ! … … 791 792 !! 792 793 !!---------------------------------------------------------------------- 793 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in out) :: psi_uw, psi_vw ! streamfunction [m3/s]794 INTEGER , INTENT(in ) :: Kmm! ocean time level indices794 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in) :: psi_uw, psi_vw ! streamfunction [m3/s] 795 INTEGER , INTENT(in) :: Kmm ! ocean time level indices 795 796 ! 796 797 INTEGER :: ji, jj, jk ! dummy loop indices -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv.F90
r14576 r14631 93 93 ! 94 94 INTEGER :: ji, jj, jk ! dummy loop index 95 ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) if using XIOS (subdomain support)95 ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 96 96 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww ! 3D workspace 97 97 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 98 ! TEMP: [tiling] This change not necessary after extra haloes development 98 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk calls removed from tra_adv_*) 99 99 LOGICAL :: lskip 100 100 !!---------------------------------------------------------------------- … … 104 104 lskip = .FALSE. 105 105 106 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)106 ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk calls removed from tra_adv_*) 107 107 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 108 108 ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 109 109 ENDIF 110 110 111 ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia)112 IF( nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4) .OR. ln_ldfeiv_dia) THEN111 ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk calls removed from tra_adv_*) 112 IF( nadv == np_FCT .OR. (nn_hls == 1 .AND. (nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4))) ) THEN 113 113 IF( ln_tile ) THEN 114 114 IF( ntile == 1 ) THEN … … 121 121 IF( .NOT. lskip ) THEN 122 122 ! !== effective transport ==! 123 ! TODO: [tiling] NOT TESTED- requires waves 123 124 IF( ln_wave .AND. ln_sdw ) THEN 124 DO_3D ( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )125 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 125 126 zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) ) 126 127 zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) ) … … 128 129 END_3D 129 130 ELSE 130 DO_3D ( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )131 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 131 132 zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) ! eulerian transport only 132 133 zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) … … 135 136 ENDIF 136 137 ! 138 ! TODO: [tiling] NOT TESTED- requires ztilde 137 139 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 138 DO_3D ( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )140 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 139 141 zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk) 140 142 zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk) … … 142 144 ENDIF 143 145 ! 144 DO_2D ( nn_hls, nn_hls, nn_hls, nn_hls )146 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 145 147 zuu(ji,jj,jpk) = 0._wp ! no transport trough the bottom 146 148 zvv(ji,jj,jpk) = 0._wp … … 148 150 END_2D 149 151 ! 150 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)151 152 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 152 & CALL ldf_eiv_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), & 153 & 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary) 154 ! 155 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), & 156 & 'TRA', Kmm ) ! add the mle transport (if necessary) 157 ! 158 ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 153 & CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary) 154 ! 155 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm ) ! add the mle transport (if necessary) 156 ! 157 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk calls removed from tra_adv_*) 159 158 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 160 159 CALL iom_put( "uocetr_eff", zuu ) ! output effective transport … … 163 162 ENDIF 164 163 ! 165 166 ! TEMP: [tiling] This c hange not necessary if using XIOS (subdomain support)164 !!gm ??? 165 ! TEMP: [tiling] This copy-in not necessary after extra haloes development (lbc_lnk calls removed from tra_adv_*) 167 166 CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) ) ! diagnose the effective MSF 168 167 !!gm ??? 169 168 ! 170 169 … … 230 229 ENDIF 231 230 232 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia)231 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk calls removed from tra_adv_*) 233 232 IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE., cstr='traadv' ) 234 233 ENDIF … … 237 236 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 238 237 239 ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)238 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk calls removed from tra_adv_*) 240 239 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only for the full domain 241 240 DEALLOCATE( zuu, zvv, zww ) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90
r14574 r14631 71 71 INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme) 72 72 INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme) 73 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)73 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 74 74 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 75 75 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90
r14574 r14631 81 81 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 82 82 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 83 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)83 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 84 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 136 136 ! If adaptive vertical advection, check if it is needed on this PE at this time 137 137 IF( ln_zad_Aimp ) THEN 138 IF( MAXVAL( ABS( wi(A2D( nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE.138 IF( MAXVAL( ABS( wi(A2D(1),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 139 139 END IF 140 140 ! If active adaptive vertical advection, build tridiagonal matrix -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90
r14574 r14631 81 81 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 82 82 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 83 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)83 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 84 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_qck.F90
r14574 r14631 91 91 INTEGER , INTENT(in ) :: kjpt ! number of tracers 92 92 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 93 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)93 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 94 94 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 95 95 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 129 129 INTEGER , INTENT(in ) :: kjpt ! number of tracers 130 130 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 131 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)131 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 132 132 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU ! i-velocity components 133 133 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation … … 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', zf c(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions151 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 152 152 153 153 ! … … 214 214 INTEGER , INTENT(in ) :: kjpt ! number of tracers 215 215 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 216 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)216 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 217 217 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pV ! j-velocity components 218 218 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation … … 229 229 zfd(:,:,:) = 0.0 ; zwy(:,:,:) = 0.0 230 230 ! 231 DO jk = 1, jpkm1 232 ! 233 !--- Computation of the ustream and downstream value of the tracer and the mask 234 DO_2D( 0, 0, nn_hls-1, nn_hls-1 ) 235 ! Upstream in the x-direction for the tracer 236 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 237 ! Downstream in the x-direction for the tracer 238 zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 239 END_2D 240 END DO 231 !--- Computation of the ustream and downstream value of the tracer and the mask 232 DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 233 ! Upstream in the x-direction for the tracer 234 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 235 ! Downstream in the x-direction for the tracer 236 zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 237 END_3D 238 241 239 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 242 240 241 ! Correct zfd on northfold after lbc_lnk; see #2640 242 IF( nn_hls == 1 .AND. l_IdoNFold .AND. ntej == Nje0 ) THEN 243 DO jk = 1, jpkm1 244 WHERE( tmask_i(ntsi:ntei,ntej:jpj) == 0._wp ) zfd(ntsi:ntei,ntej:jpj,jk) = zfc(ntsi:ntei,ntej:jpj,jk) 245 END DO 246 ENDIF 243 247 ! 244 248 ! Horizontal advective fluxes … … 306 310 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 307 311 INTEGER , INTENT(in ) :: kjpt ! number of tracers 308 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)312 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 309 313 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pW ! vertical velocity 310 314 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation … … 365 369 !---------------------------------------------------------------------- 366 370 ! 367 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )371 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 368 372 zc = puc(ji,jj,jk) ! Courant number 369 373 zcurv = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_ubs.F90
r14574 r14631 92 92 INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers 93 93 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 94 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)94 ! TEMP: [tiling] This can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 95 95 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 96 96 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90
r14576 r14631 17 17 USE oce ! ocean dynamics and tracers 18 18 USE dom_oce ! ocean space and time domain 19 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)19 ! TEMP: [tiling] This change not necessary after lbc_lnks removed from tra_ldf_blp and zps_hde* 20 20 USE domtile 21 21 USE phycst ! physical constants … … 58 58 !! 59 59 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 60 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)60 ! TEMP: [tiling] This change not necessary after lbc_lnks removed from tra_ldf_blp and zps_hde* 61 61 LOGICAL :: lskip 62 62 !!---------------------------------------------------------------------- … … 72 72 ENDIF 73 73 74 ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)75 IF( n ldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it) THEN74 ! TEMP: [tiling] These changes not necessary after lbc_lnks removed from tra_ldf_blp and zps_hde* 75 IF( nn_hls == 1 .AND. (nldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it) ) THEN 76 76 IF( ln_tile ) THEN 77 77 IF( ntile == 1 ) THEN … … 105 105 ENDIF 106 106 107 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)107 ! TEMP: [tiling] This change not necessary after lbc_lnks removed from tra_ldf_blp and zps_hde* 108 108 IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE., cstr='traldf' ) 109 109 ENDIF -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_iso.F90
r14576 r14631 132 132 INTEGER :: ji, jj, jk, jn ! dummy loop indices 133 133 INTEGER :: ikt 134 INTEGER :: ierr ! local integer 134 ! NOTE: [halo1-halo2] 135 INTEGER :: ierr, iij ! local integer 135 136 REAL(wp) :: zmsku, zahu_w, zabe1, zcof1, zcoef3 ! local scalars 136 137 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - … … 148 149 ! 149 150 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 150 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )151 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 151 152 akz (ji,jj,jk) = 0._wp 152 153 ah_wslp2(ji,jj,jk) = 0._wp … … 162 163 ENDIF 163 164 ! 165 ! NOTE: [halo1-halo2] 166 ! Define pt_rhs halo points for multi-point haloes in bilaplacian case 167 IF( nldf_tra == np_blp_i .AND. kpass == 1 ) THEN ; iij = nn_hls 168 ELSE ; iij = 1 169 ENDIF 170 164 171 ! 165 172 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 174 181 ! 175 182 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 176 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )183 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 177 184 ! 178 185 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 181 188 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 182 189 ! 183 zahu_w = ( pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk) & 184 & + pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk) ) * zmsku 185 zahv_w = ( pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk) & 186 & + pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk) ) * zmskv 190 ! NOTE: [halo1-halo2] 191 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 192 zahu_w = ( (pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk)) & 193 & + (pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk)) ) * zmsku 194 zahv_w = ( (pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk)) & 195 & + (pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk)) ) * zmskv 187 196 ! 188 197 ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & … … 192 201 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 193 202 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 194 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 195 akz(ji,jj,jk) = 0.25_wp * ( & 196 & ( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & 197 & + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) ) & 198 & + ( pahv(ji,jj ,jk) + pahv(ji,jj ,jk-1) ) / ( e2v(ji,jj ) * e2v(ji,jj ) ) & 199 & + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) ) 203 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 204 ! NOTE: [halo1-halo2] 205 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 206 akz(ji,jj,jk) = 0.25_wp * ( & 207 & (( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & 208 & + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )) & 209 & + (( pahv(ji,jj ,jk) + pahv(ji,jj ,jk-1) ) / ( e2v(ji,jj ) * e2v(ji,jj ) ) & 210 & + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )) ) 200 211 END_3D 201 212 ! 202 213 IF( ln_traldf_blp ) THEN ! bilaplacian operator 203 214 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 204 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )215 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 205 216 akz(ji,jj,jk) = 16._wp & 206 217 & * ah_wslp2 (ji,jj,jk) & … … 211 222 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 212 223 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 213 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )224 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 214 225 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 215 226 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 220 231 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 221 232 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 222 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )233 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 223 234 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 224 235 END_3D … … 233 244 !! I - masked horizontal derivative 234 245 !!---------------------------------------------------------------------- 235 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 236 zdit (ntsi-nn_hls,:,:) = 0._wp ; zdit (ntei+nn_hls,:,:) = 0._wp 237 zdjt (ntsi-nn_hls,:,:) = 0._wp ; zdjt (ntei+nn_hls,:,:) = 0._wp 238 !!end 246 zdit(:,:,:) = 0._wp 247 zdjt(:,:,:) = 0._wp 239 248 240 249 ! Horizontal tracer gradient 241 250 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 242 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 251 ! NOTE: [halo1-halo2] 252 DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 ) 243 253 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 244 254 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) … … 246 256 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 247 257 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! bottom correction (partial bottom cell) 248 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! bottom correction (partial bottom cell) 258 ! NOTE: [halo1-halo2] 259 DO_2D( iij, iij-1, iij, iij-1 ) ! bottom correction (partial bottom cell) 249 260 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 250 261 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) … … 252 263 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 253 264 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 254 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 265 ! NOTE: [halo1-halo2] 266 DO_2D( iij, iij-1, iij, iij-1 ) 255 267 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 256 268 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) … … 266 278 ! 267 279 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 268 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 280 ! NOTE: [halo1-halo2] 281 DO_2D( iij, iij, iij, iij ) 269 282 ! !== Vertical tracer gradient 270 283 zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) ! level jk+1 … … 276 289 ! 277 290 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) !== Horizontal fluxes 278 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) !== Horizontal fluxes 291 ! NOTE: [halo1-halo2] 292 DO_2D( iij, iij-1, iij, iij-1 ) !== Horizontal fluxes 279 293 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 280 294 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 289 303 zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 290 304 ! 291 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 292 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 293 & + zdk1t(ji+1,jj) + zdkt (ji,jj) ) ) * umask(ji,jj,jk) 294 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 295 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 296 & + zdk1t(ji,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,jk) 305 ! NOTE: [halo1-halo2] 306 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 307 zftu(ji,jj,jk) = ( zabe1 * zdit(ji,jj,jk) & 308 & + zcof1 * ( (zdkt (ji+1,jj) + zdk1t(ji,jj)) & 309 & + (zdk1t(ji+1,jj) + zdkt (ji,jj)) ) ) * umask(ji,jj,jk) 310 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 311 & + zcof2 * ( (zdkt (ji,jj+1) + zdk1t(ji,jj)) & 312 & + (zdk1t(ji,jj+1) + zdkt (ji,jj)) ) ) * vmask(ji,jj,jk) 297 313 END_2D 298 314 ! 299 315 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !== horizontal divergence and add to pta 300 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== horizontal divergence and add to pta 316 ! NOTE: [halo1-halo2] 317 DO_2D( iij-1, iij-1, iij-1, iij-1 ) !== horizontal divergence and add to pta 318 ! NOTE: [halo1-halo2] 319 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 301 320 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 302 & + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) )&303 & 321 & + zsign * ( (zftu(ji,jj,jk) - zftu(ji-1,jj,jk)) + & 322 & (zftv(ji,jj,jk) - zftv(ji,jj-1,jk)) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 304 323 END_2D 305 324 END DO ! End of slab … … 315 334 316 335 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 317 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 336 ! NOTE: [halo1-halo2] 337 DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 318 338 ! 319 339 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 330 350 zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 331 351 ! 332 ztfw(ji,jj,jk) = zcoef3 * ( zdit(ji ,jj ,jk-1) + zdit(ji-1,jj ,jk) & 333 & + zdit(ji-1,jj ,jk-1) + zdit(ji ,jj ,jk) ) & 334 & + zcoef4 * ( zdjt(ji ,jj ,jk-1) + zdjt(ji ,jj-1,jk) & 335 & + zdjt(ji ,jj-1,jk-1) + zdjt(ji ,jj ,jk) ) 352 ! NOTE: [halo1-halo2] 353 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 354 ztfw(ji,jj,jk) = zcoef3 * ( (zdit(ji ,jj ,jk-1) + zdit(ji-1,jj ,jk)) & 355 & + (zdit(ji-1,jj ,jk-1) + zdit(ji ,jj ,jk)) ) & 356 & + zcoef4 * ( (zdjt(ji ,jj ,jk-1) + zdjt(ji ,jj-1,jk)) & 357 & + (zdjt(ji ,jj-1,jk-1) + zdjt(ji ,jj ,jk)) ) 336 358 END_3D 337 359 ! !== add the vertical 33 flux ==! 338 360 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 339 361 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 340 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 362 ! NOTE: [halo1-halo2] 363 DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 341 364 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 342 365 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & … … 348 371 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 349 372 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 350 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 373 ! NOTE: [halo1-halo2] 374 DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 351 375 ztfw(ji,jj,jk) = & 352 376 & ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & … … 354 378 END_3D 355 379 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 356 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )357 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )380 ! NOTE: [halo1-halo2] 381 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 358 382 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 359 383 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & … … 364 388 ! 365 389 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 366 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 390 ! NOTE: [halo1-halo2] 391 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 367 392 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) & 368 393 & / e3t(ji,jj,jk,Kmm) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90
r14576 r14631 103 103 ! 104 104 INTEGER :: ji, jj, jk, jn ! dummy loop indices 105 ! NOTE: [halo1-halo2] 106 INTEGER :: iij 105 107 REAL(wp) :: zsign ! local scalars 106 108 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: ztu, ztv, zaheeu, zaheev … … 121 123 ENDIF 122 124 ! 125 ! NOTE: [halo1-halo2] 126 ! Define pt_rhs halo points for multi-point haloes in bilaplacian case 127 IF( nldf_tra == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls 128 ELSE ; iij = 1 129 ENDIF 130 123 131 ! !== Initialization of metric arrays used for all tracers ==! 124 132 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 126 134 ENDIF 127 135 128 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) !== First derivative (gradient) ==! 136 ! NOTE: [halo1-halo2] 137 DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 ) !== First derivative (gradient) ==! 129 138 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) !!gm * umask(ji,jj,jk) pah masked! 130 139 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) !!gm * vmask(ji,jj,jk) … … 135 144 ! ! =========== ! 136 145 ! 137 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) !== First derivative (gradient) ==! 146 ! NOTE: [halo1-halo2] 147 DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 ) !== First derivative (gradient) ==! 138 148 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) 139 149 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 140 150 END_3D 141 151 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 142 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! bottom 152 ! NOTE: [halo1-halo2] 153 DO_2D( iij, iij-1, iij, iij-1 ) ! bottom 143 154 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 144 155 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 145 156 END_2D 146 157 IF( ln_isfcav ) THEN ! top in ocean cavities only 147 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 158 ! NOTE: [halo1-halo2] 159 DO_2D( iij, iij-1, iij, iij-1 ) 148 160 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 149 161 IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) … … 152 164 ENDIF 153 165 ! 154 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !== Second derivative (divergence) added to the general tracer trends ==! 155 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 156 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 166 ! NOTE: [halo1-halo2] 167 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) !== Second derivative (divergence) added to the general tracer trends ==! 168 ! NOTE: [halo1-halo2] 169 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 170 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( (ztu(ji,jj,jk) - ztu(ji-1,jj,jk)) & 171 & + (ztv(ji,jj,jk) - ztv(ji,jj-1,jk)) ) & 157 172 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 158 173 END_3D … … 229 244 END SELECT 230 245 ! 231 ! [comm_cleanup] 246 ! [comm_cleanup] 232 247 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 233 248 ! ! Partial top/bottom cell: GRADh( zlap ) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_triad.F90
r14576 r14631 13 13 USE oce ! ocean dynamics and active tracers 14 14 USE dom_oce ! ocean space and time domain 15 ! TEMP: [tiling] This change not necessary if XIOS has subdomain support16 USE domtile17 15 USE domutl, ONLY : is_tile 18 16 USE phycst ! physical constants … … 111 109 INTEGER :: ji, jj, jk, jn ! dummy loop indices 112 110 INTEGER :: ip,jp,kp ! dummy loop indices 113 INTEGER :: ierr ! local integer 111 ! NOTE: [halo1-halo2] 112 INTEGER :: ierr, iij ! local integer 114 113 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 115 114 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - … … 119 118 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 120 119 REAL(wp) :: zah, zah_slp, zaei_slp 121 REAL(wp), DIMENSION(A2D(nn_hls),0:1) :: zdkt3d ! vertical tracer gradient at 2 levels 122 REAL(wp), DIMENSION(A2D(nn_hls) ) :: z2d ! 2D workspace 123 REAL(wp), DIMENSION(A2D(nn_hls) ,jpk) :: zdit, zdjt, zftu, zftv, ztfw ! 3D - 124 ! TEMP: [tiling] This can be A2D(nn_hls) if XIOS has subdomain support 125 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 120 REAL(wp), DIMENSION(A2D(nn_hls),0:1) :: zdkt3d ! vertical tracer gradient at 2 levels 121 REAL(wp), DIMENSION(A2D(nn_hls) ) :: z2d ! 2D workspace 122 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zdit, zdjt, zpsi_uw, zpsi_vw ! 3D - 123 ! NOTE: [halo1-halo2] 124 REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: zftu, zftv 125 REAL(wp), DIMENSION(A2D(nn_hls),jpk,2,2) :: ztfw 126 126 !!---------------------------------------------------------------------- 127 127 ! … … 142 142 ENDIF 143 143 ! 144 ! NOTE: [halo1-halo2] 145 ! Define pt_rhs halo points for multi-point haloes in bilaplacian case 146 IF( nldf_tra == np_blp_it .AND. kpass == 1 ) THEN ; iij = nn_hls 147 ELSE ; iij = 1 148 ENDIF 149 150 ! 144 151 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) 145 152 ELSE ; zsign = -1._wp … … 153 160 ! 154 161 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 155 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )162 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 156 163 akz (ji,jj,jk) = 0._wp 157 164 ah_wslp2(ji,jj,jk) = 0._wp 158 165 END_3D 166 ! 167 ! NOTE: [halo1-halo2] 168 zftu(:,:,:,:) = 0._wp 169 zftv(:,:,:,:) = 0._wp 159 170 ! 160 171 DO ip = 0, 1 ! i-k triads … … 169 180 zslope2 = zslope_skew + ( gdept(ji-ip+1,jj,jk,Kmm) - gdept(ji-ip,jj,jk,Kmm) ) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 170 181 zslope2 = zslope2 *zslope2 171 ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2 172 akz (ji,jj,jk+kp) = akz (ji,jj,jk+kp) + zah * r1_e1u(ji-ip,jj) & 173 & * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 182 ! NOTE: [halo1-halo2] 183 zftu(ji,jj,jk+kp,ip+1) = zftu(ji,jj,jk+kp,ip+1) + & 184 & zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2 185 zftv(ji,jj,jk+kp,ip+1) = zftv(ji,jj,jk+kp,ip+1) + & 186 & zah * r1_e1u(ji-ip,jj) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 174 187 ! 175 188 END_3D 176 189 END DO 177 190 END DO 191 ! 192 ! NOTE: [halo1-halo2] Use DO_3D instead of DO_3D_OVR 193 ! ip loop contributions added here to ensure consistent floating point arithmetic for different nn_hls 194 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 195 ah_wslp2(ji,jj,jk) = ah_wslp2(ji,jj,jk) + (zftu(ji,jj,jk,1) + zftu(ji,jj,jk,2)) 196 akz (ji,jj,jk) = akz (ji,jj,jk) + (zftv(ji,jj,jk,1) + zftv(ji,jj,jk,2)) 197 END_3D 198 ! 199 ! NOTE: [halo1-halo2] 200 zftu(:,:,:,:) = 0._wp 201 zftv(:,:,:,:) = 0._wp 178 202 ! 179 203 DO jp = 0, 1 ! j-k triads … … 189 213 zslope2 = zslope_skew + ( gdept(ji,jj-jp+1,jk,Kmm) - gdept(ji,jj-jp,jk,Kmm) ) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 190 214 zslope2 = zslope2 * zslope2 191 ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2 192 akz (ji,jj,jk+kp) = akz (ji,jj,jk+kp) + zah * r1_e2v(ji,jj-jp) & 193 & * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 215 ! NOTE: [halo1-halo2] 216 zftu(ji,jj,jk+kp,jp+1) = zftu(ji,jj,jk+kp,jp+1) + & 217 & zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2 218 zftv(ji,jj,jk+kp,jp+1) = zftv(ji,jj,jk+kp,jp+1) + & 219 & zah * r1_e2v(ji,jj-jp) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 194 220 ! 195 221 END_3D … … 197 223 END DO 198 224 ! 225 ! NOTE: [halo1-halo2] Use DO_3D instead of DO_3D_OVR 226 ! jp loop contributions added here to ensure consistent floating point arithmetic for different nn_hls 227 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 228 ah_wslp2(ji,jj,jk) = ah_wslp2(ji,jj,jk) + (zftu(ji,jj,jk,1) + zftu(ji,jj,jk,2)) 229 akz (ji,jj,jk) = akz (ji,jj,jk) + (zftv(ji,jj,jk,1) + zftv(ji,jj,jk,2)) 230 END_3D 231 ! 199 232 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 200 233 ! 201 234 IF( ln_traldf_blp ) THEN ! bilaplacian operator 202 235 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 203 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )236 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 204 237 akz(ji,jj,jk) = 16._wp & 205 238 & * ah_wslp2 (ji,jj,jk) & … … 210 243 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 211 244 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 212 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )245 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 213 246 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 214 247 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 219 252 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 220 253 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 221 DO_3D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )254 DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 222 255 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 223 256 END_3D 224 257 ENDIF 225 258 ! 226 ! TEMP: [tiling] These changes not necessary if XIOS has subdomain support 227 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only for the full domain 228 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 229 IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE., cstr='traldf_triad' ) 230 231 zpsi_uw(:,:,:) = 0._wp 232 zpsi_vw(:,:,:) = 0._wp 233 234 DO jp = 0, 1 235 DO kp = 0, 1 236 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 237 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 238 zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 239 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) 240 zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 241 & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp) 242 END_3D 243 END DO 259 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 260 zpsi_uw(:,:,:) = 0._wp 261 zpsi_vw(:,:,:) = 0._wp 262 263 DO jp = 0, 1 264 DO kp = 0, 1 265 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 266 zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 267 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) 268 zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 269 & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp) 270 END_3D 244 271 END DO 245 CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 246 247 IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE., cstr='traldf_triad' ) 248 ENDIF 272 END DO 273 CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 249 274 ENDIF 250 275 ! … … 256 281 ! Zero fluxes for each tracer 257 282 !!gm this should probably be done outside the jn loop 258 ztfw(:,:,:) = 0._wp 259 zftu(:,:,:) = 0._wp 260 zftv(:,:,:) = 0._wp 283 ! NOTE: [halo1-halo2] 284 ztfw(:,:,:,:,:) = 0._wp 285 zftu(:,:,:,:) = 0._wp 286 zftv(:,:,:,:) = 0._wp 261 287 ! 262 288 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== before lateral T & S gradients at T-level jk ==! 263 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 289 ! NOTE: [halo1-halo2] 290 DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 ) 264 291 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 265 292 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) … … 267 294 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 268 295 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! bottom level 269 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 296 ! NOTE: [halo1-halo2] 297 DO_2D( iij, iij-1, iij, iij-1 ) 270 298 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 271 299 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) … … 273 301 IF( ln_isfcav ) THEN ! top level (ocean cavities only) 274 302 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 275 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 303 ! NOTE: [halo1-halo2] 304 DO_2D( iij, iij-1, iij, iij-1 ) 276 305 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 277 306 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) … … 287 316 ! !== Vertical tracer gradient at level jk and jk+1 288 317 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 289 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 318 ! NOTE: [halo1-halo2] 319 DO_2D( iij, iij, iij, iij ) 290 320 zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 291 321 END_2D … … 295 325 ELSE 296 326 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 297 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 327 ! NOTE: [halo1-halo2] 328 DO_2D( iij, iij, iij, iij ) 298 329 zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 299 330 END_2D … … 306 337 DO kp = 0, 1 307 338 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 308 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 339 ! NOTE: [halo1-halo2] 340 DO_2D( iij, iij-1, iij, iij-1 ) 309 341 ze1ur = r1_e1u(ji,jj) 310 342 zdxt = zdit(ji,jj,jk) * ze1ur … … 319 351 zah_slp = zah * zslope_iso 320 352 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew 321 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 322 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt * zbu * ze3wr 353 ! NOTE: [halo1-halo2] 354 zftu(ji ,jj,jk,ip+1 ) = zftu(ji ,jj,jk,ip+1 ) - & 355 & ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 356 ztfw(ji,jj,jk+kp,ip+1,1) = ztfw(ji,jj,jk+kp,ip+1,1) - & 357 & (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 323 358 END_2D 324 359 END DO … … 328 363 DO kp = 0, 1 329 364 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 330 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 365 ! NOTE: [halo1-halo2] 366 DO_2D( iij, iij-1, iij, iij-1 ) 331 367 ze2vr = r1_e2v(ji,jj) 332 368 zdyt = zdjt(ji,jj,jk) * ze2vr … … 340 376 zah_slp = zah * zslope_iso 341 377 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew 342 zftv(ji,jj ,jk ) = zftv(ji,jj ,jk ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 343 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt * zbv * ze3wr 378 ! NOTE: [halo1-halo2] 379 zftv(ji,jj ,jk,jp+1 ) = zftv(ji,jj ,jk,jp+1 ) - & 380 & ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 381 ztfw(ji,jj,jk+kp,jp+1,2) = ztfw(ji,jj,jk+kp,jp+1,2) - & 382 & (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 344 383 END_2D 345 384 END DO … … 351 390 DO kp = 0, 1 352 391 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 353 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 392 ! NOTE: [halo1-halo2] 393 DO_2D( iij, iij-1, iij, iij-1 ) 354 394 ze1ur = r1_e1u(ji,jj) 355 395 zdxt = zdit(ji,jj,jk) * ze1ur … … 364 404 zah_slp = zah * zslope_iso 365 405 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew ! aeit(ji+ip,jj,jk)*zslope_skew 366 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 367 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 406 ! NOTE: [halo1-halo2] 407 zftu(ji ,jj,jk,ip+1 ) = zftu(ji ,jj,jk,ip+1 ) - & 408 & ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 409 ztfw(ji,jj,jk+kp,ip+1,1) = ztfw(ji,jj,jk+kp,ip+1,1) - & 410 & (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 368 411 END_2D 369 412 END DO … … 373 416 DO kp = 0, 1 374 417 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 375 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 418 ! NOTE: [halo1-halo2] 419 DO_2D( iij, iij-1, iij, iij-1 ) 376 420 ze2vr = r1_e2v(ji,jj) 377 421 zdyt = zdjt(ji,jj,jk) * ze2vr … … 385 429 zah_slp = zah * zslope_iso 386 430 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew ! aeit(ji,jj+jp,jk)*zslope_skew 387 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 388 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 431 ! NOTE: [halo1-halo2] 432 zftv(ji,jj,jk, jp+1 ) = zftv(ji,jj,jk, jp+1 ) - & 433 & ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 434 ztfw(ji,jj,jk+kp,jp+1,2) = ztfw(ji,jj,jk+kp,jp+1,2) - & 435 & (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 389 436 END_2D 390 437 END DO 391 438 END DO 392 439 ENDIF 440 ! NOTE: [halo1-halo2] 441 ! ip and jp loop contributions added here to ensure consistent floating point arithmetic for different nn_hls 442 DO_2D( iij, iij-1, iij, iij-1 ) 443 zftu(ji,jj,jk,1) = zftu(ji,jj,jk,1) + zftu(ji,jj,jk,2) 444 zftv(ji,jj,jk,1) = zftv(ji,jj,jk,1) + zftv(ji,jj,jk,2) 445 END_2D 446 DO_2D( iij-1, iij-1, iij-1, iij-1 ) 447 ztfw(ji,jj,jk,1,1) = (ztfw(ji,jj,jk,1,1) + ztfw(ji-1,jj,jk,2,1)) + & 448 & (ztfw(ji,jj,jk,1,2) + ztfw(ji,jj-1,jk,2,2)) 449 END_2D 393 450 ! !== horizontal divergence and add to the general trend ==! 394 451 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 395 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 452 ! NOTE: [halo1-halo2] 453 DO_2D( iij-1, iij-1, iij-1, iij-1 ) 454 ! NOTE: [halo1-halo2] 455 ! Extra brackets required to ensure consistent floating point arithmetic for different nn_hls for bilaplacian 396 456 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 397 & + zsign * ( zftu(ji-1,jj ,jk) - zftu(ji,jj,jk) &398 & + zftv(ji,jj-1,jk) - zftv(ji,jj,jk) ) &399 & 457 & + zsign * ( (zftu(ji-1,jj,jk,1) - zftu(ji,jj,jk,1)) & 458 & + (zftv(ji,jj-1,jk,1) - zftv(ji,jj,jk,1)) ) & 459 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 400 460 END_2D 401 461 ! … … 405 465 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 406 466 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 407 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 408 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 467 ! NOTE: [halo1-halo2] 468 DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 469 ztfw(ji,jj,jk,1,1) = ztfw(ji,jj,jk,1,1) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 409 470 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 410 471 & * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) … … 414 475 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 415 476 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 416 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 417 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 477 ! NOTE: [halo1-halo2] 478 DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 479 ztfw(ji,jj,jk,1,1) = ztfw(ji,jj,jk,1,1) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 418 480 & * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 419 481 END_3D 420 482 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 421 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 )422 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )423 ztfw(ji,jj,jk ) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) &483 ! NOTE: [halo1-halo2] 484 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 485 ztfw(ji,jj,jk,1,1) = ztfw(ji,jj,jk,1,1) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 424 486 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & 425 487 & + akz (ji,jj,jk) * ( pt2(ji,jj,jk-1,jn) - pt2(ji,jj,jk,jn) ) ) … … 429 491 ! 430 492 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 431 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )432 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) &433 & + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) &493 ! NOTE: [halo1-halo2] 494 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) 495 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( ztfw(ji,jj,jk+1,1,1) - ztfw(ji,jj,jk,1,1) ) & 434 496 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 435 497 END_3D … … 439 501 ! 440 502 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 441 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:) ) 503 ! NOTE: [halo1-halo2] 504 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:,1) ) 442 505 ! ! Diffusive heat transports 443 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:), zftv(:,:,:) ) 506 ! NOTE: [halo1-halo2] 507 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:,1), zftv(:,:,:,1) ) 444 508 ! 445 509 ENDIF !== end pass selection ==! -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90
r14607 r14631 87 87 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 88 88 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 89 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components 90 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pv ! out: same 3 transport components 91 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the MLE induced transport 89 ! TEMP: [tiling] Can be A2D(nn_hls) after extra haloes development (lbc_lnk calls removed from tra_adv_*) 90 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu ! in : 3 ocean transport components 91 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pv ! out: same 3 transport components 92 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pw ! increased by the MLE induced transport 92 93 ! 93 94 INTEGER :: ji, jj, jk ! dummy loop indices … … 268 269 DO jk = 1, ikmax 269 270 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! CAUTION pu,pv must be defined at row/column i=1 / j=1 270 DO_2D ( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )271 DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 271 272 pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 272 273 pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 273 274 END_2D 274 275 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 275 DO_2D ( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )276 DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 276 277 pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk) & 277 278 & + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1) … … 282 283 ! 283 284 IF (ln_osm_mle.and.ln_zdfosm) THEN 284 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 285 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 285 DO_2D( 0, 0, 0, 0 ) 286 286 zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 287 287 END_2D 288 288 ELSE 289 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 290 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 289 DO_2D( 0, 0, 0, 0 ) 291 290 zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 292 291 END_2D … … 386 385 r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 387 386 ! 387 ! Specifically, dbdx_mle, dbdy_mle and mld_prof need to be defined for nn_hls = 2 388 IF( nn_hls == 2 .AND. ln_osm_mle .AND. ln_zdfosm ) THEN 389 CALL ctl_stop('nn_hls = 2 cannot be used with ln_mle = ln_osm_mle = ln_zdfosm = T (zdfosm not updated for nn_hls = 2)') 390 ENDIF 388 391 ENDIF 389 392 ! -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/tranpc.F90
r14537 r14631 17 17 USE oce ! ocean dynamics and active tracers 18 18 USE dom_oce ! ocean space and time domain 19 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed)20 USE domtile21 19 USE phycst ! physical constants 22 20 USE zdf_oce ! ocean vertical physics -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/zpshde.F90
r14574 r14631 124 124 ! 125 125 IF( ln_timing ) CALL timing_start( 'zps_hde') 126 IF (nn_hls.EQ.2) THEN127 CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp)128 IF(PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp)129 END IF130 126 ! 131 127 pgtu(:,:,:) = 0._wp ; zti (:,:,:) = 0._wp ; zhi (:,:) = 0._wp … … 134 130 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 135 131 ! 136 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level 132 ! NOTE: [tiling] increase lower bounds for tra_ldf_blp* calculation 133 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! Gradient of density at the last level 137 134 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 138 135 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 … … 307 304 IF( ln_timing ) CALL timing_start( 'zps_hde_isf') 308 305 ! 309 IF (nn_hls.EQ.2) THEN310 CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp)311 IF (PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp)312 END IF313 314 306 pgtu (:,:,:) = 0._wp ; pgtv (:,:,:) =0._wp 315 307 pgtui(:,:,:) = 0._wp ; pgtvi(:,:,:) =0._wp … … 319 311 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 320 312 ! 321 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 313 ! NOTE: [tiling] increase lower bounds for tra_ldf_blp* calculation 314 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 322 315 323 316 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points … … 408 401 ! 409 402 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 410 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 403 ! NOTE: [tiling] increase lower bounds for tra_ldf_blp* calculation 404 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 411 405 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 412 406 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
Note: See TracChangeset
for help on using the changeset viewer.