# New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14538 – NEMO

# Changeset 14538

Ignore:
Timestamp:
2021-02-23T16:59:57+01:00 (3 years ago)
Message:

[comm_cleanup] - ticket #2607

Location:
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE
Files:
11 edited

Unmodified
Removed

• ## NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/LDF/ldftra.F90

 r14511 !                       ! Compute lateral diffusive coefficient at T-point IF( ln_traldf_triad ) THEN DO_3D( 0, 0, 0, 0, 1, jpk ) ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) ! Take the max of N^2 and zero then take the vertical sum ! of the square root of the resulting N^2 ( required to compute END_3D ELSE DO_3D( 0, 0, 0, 0, 1, jpk ) ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) ! Take the max of N^2 and zero then take the vertical sum ! of the square root of the resulting N^2 ( required to compute ENDIF DO_2D( 0, 0, 0, 0 ) ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) ! Rossby radius at w-point taken betwenn 2 km and  40km !                                         !==  Bound on eiv coeff.  ==! z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) DO_2D( 0, 0, 0, 0 ) ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)     ! tropical decrease zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0 CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition ! DO_2D( 0, 0, 0, 0 )                       !== aei at u- and v-points  ==! ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   & &                                    * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * wumask(ji,jj,jk) END_3D ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) END_3D DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) pw(ji,jj,jk) = pw(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )

• ## NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traatf.F90

 r14511 #endif !                                              ! local domain boundaries  (T-point, unchanged sign) CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) ! [comm_cleanup] ! lbc_lnk moved into stp ! CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) ! IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries ENDIF ! CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) ! [comm_cleanup] ! CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) ENDIF
• ## NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf.F90

 r14189 CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) ! [comm_cleanup] ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) END SELECT

• ## NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf_lap_blp.F90

 r14215 END SELECT ! CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) ! [comm_cleanup] IF (nn_hls.EQ.1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) !                                               ! Partial top/bottom cell: GRADh( zlap ) IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom

• ## NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/tramle.F90

 r14511 SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts CASE ( 0 )                                               != min of the 2 neighbour MLDs DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) ) END_2D CASE ( 1 )                                               != average of the 2 neighbour MLDs DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) END_2D CASE ( 2 )                                               != max of the 2 neighbour MLDs DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) END SELECT IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            & &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   & ! ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               & &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) !                                      !==  MLD used for MLE  ==! !                                                ! compute from the 10m density to deal with the diurnal cycle DO_2D( 1, 1, 1, 1 ) ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1) END_2D IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer END_3D zbm (:,:) = 0._wp zn2 (:,:) = 0._wp DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points zmld(ji,jj) = zmld(ji,jj) + zc SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts CASE ( 0 )                                               != min of the 2 neighbour MLDs DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) END_2D CASE ( 1 )                                               != average of the 2 neighbour MLDs DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp END_2D CASE ( 2 )                                               != max of the 2 neighbour MLDs DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) END SELECT !                                                ! convert density into buoyancy DO_2D( 1, 1, 1, 1 ) ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) END_2D ! IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & ! ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) ! IF( nn_conv == 1 ) THEN              ! No MLE in case of convection DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp ENDIF  ! end of ln_osm_mle conditional !                                      !==  structure function value at uw- and vw-points  ==! DO_2D( 1, 0, 1, 0 ) ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall) zpsi_vw(:,:,:) = 0._wp ! DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax )                ! start from 2 : surface value = 0 zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) !                                      !==  transport increased by the MLE induced transport ==! DO jk = 1, ikmax DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) END_2D DO_2D( 0, 0, 0, 0 ) ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   & &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1) ! IF (ln_osm_mle.and.ln_zdfosm) THEN DO_2D( 0, 0, 0, 0 ) ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f END_2D ELSE DO_2D( 0, 0, 0, 0 ) ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f END_2D ! ! divide by cross distance to give streamfunction with dimensions m^2/s DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, ikmax+1 ) zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj)
• ## NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/step.F90

 r14239 #endif ! [comm_cleanup] IF (nn_hls.EQ.2) THEN SELECT CASE ( nadv ) CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.) CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) CASE ( np_MUS )                                 ! MUSCL CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) CASE ( np_UBS )                                 ! UBS CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) CASE ( np_QCK )                                 ! QUICKEST CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.) CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) END SELECT ENDIF ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) DO jtile = 1, nijtile !! !!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine ! [comm_cleanup] CALL lbc_lnk( 'stp', ts(:,:,:,jp_tem,Naa), 'T', 1.0_wp, ts(:,:,:,jp_sal,Naa), 'T', 1.0_wp ) CALL tra_atf       ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 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

 r14511 #endif ! [comm_cleanup] IF (nn_hls.EQ.2) THEN SELECT CASE ( nadv ) CASE ( np_FCT )                                 ! FCT scheme : 2nd / 4th order CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.) CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) CASE ( np_MUS )                                 ! MUSCL CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) CASE ( np_UBS )                                 ! UBS CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) CASE ( np_QCK )                                 ! QUICKEST CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.) CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) END SELECT ENDIF ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) DO jtile = 1, nijtile
Note: See TracChangeset for help on using the changeset viewer.