# 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 15033 – NEMO

# Changeset 15033

Ignore:
Timestamp:
2021-06-21T12:24:45+02:00 (3 years ago)
Message:

trunk: suppress jpim1 et jpjm1, #2699

Location:
NEMO/trunk
Files:
20 edited

### Legend:

Unmodified
Removed

 r14433 !! ** Purpose :  compute the max of the 9 points around !!---------------------------------------------------------------------- REAL(wp), DIMENSION(:,:,:)      , INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:)      , INTENT(out) ::   pmax   ! output REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array REAL(wp), DIMENSION(:,:,:), INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pmax   ! output INTEGER  ::   ji, jj, jl   ! dummy loop indices !!---------------------------------------------------------------------- DO jl = 1, jpl DO jj = Njs0-1, Nje0+1 DO ji = Nis0, Nie0 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) END DO END DO DO jj = Njs0, Nje0 DO ji = Nis0, Nie0 pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) END DO END DO DO_2D( 0, 0, 0, 0 ) pmax(ji,jj,jl) = MAX( epsi20, pice(ji-1,jj-1,jl), pice(ji,jj-1,jl), pice(ji+1,jj-1,jl),   & &                          pice(ji-1,jj  ,jl), pice(ji,jj  ,jl), pice(ji+1,jj  ,jl),   & &                          pice(ji-1,jj+1,jl), pice(ji,jj+1,jl), pice(ji+1,jj+1,jl) ) END_2D END DO END SUBROUTINE icemax3D !! ** Purpose :  compute the max of the 9 points around !!---------------------------------------------------------------------- REAL(wp), DIMENSION(:,:,:,:)    , INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:,:)    , INTENT(out) ::   pmax   ! output REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:,:), INTENT(out) ::   pmax   ! output INTEGER  ::   jlay, ji, jj, jk, jl   ! dummy loop indices !!---------------------------------------------------------------------- DO jl = 1, jpl DO jk = 1, jlay DO jj = Njs0-1, Nje0+1 DO ji = Nis0, Nie0 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) END DO END DO DO jj = Njs0, Nje0 DO ji = Nis0, Nie0 pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) END DO END DO DO_2D( 0, 0, 0, 0 ) pmax(ji,jj,jk,jl) = MAX( epsi20, pice(ji-1,jj-1,jk,jl), pice(ji,jj-1,jk,jl), pice(ji+1,jj-1,jk,jl),   & &                             pice(ji-1,jj  ,jk,jl), pice(ji,jj  ,jk,jl), pice(ji+1,jj  ,jk,jl),   & &                             pice(ji-1,jj+1,jk,jl), pice(ji,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) END_2D END DO END DO

 r14433 !                                                     !--  Laplacian in i-direction  --! DO jl = 1, jpl DO jj = 2, jpjm1         ! First derivative (gradient) DO ji = 1, jpim1 ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) END DO !                     ! Second derivative (Laplacian) DO ji = 2, jpim1 ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) END DO END DO DO_2D( 1, 0, 0, 0 )      ! First derivative (gradient) ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) END_2D DO_2D( 0, 0, 0, 0 )      ! Second derivative (Laplacian) ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) END_2D END DO CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) !                                                     !--  BiLaplacian in i-direction  --! DO jl = 1, jpl DO jj = 2, jpjm1         ! Third derivative DO ji = 1, jpim1 ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) END DO !                     ! Fourth derivative DO ji = 2, jpim1 DO_2D( 1, 0, 0, 0 )      ! Third derivative ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) END_2D DO_2D( 0, 0, 0, 0 )      ! Fourth derivative ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) END DO END DO END_2D END DO CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) !                                                     !--  BiLaplacian in j-direction  --! DO jl = 1, jpl DO_2D( 0, 0, 1, 0 )         ! First derivative DO_2D( 0, 0, 1, 0 )         ! Third derivative ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) END_2D DO_2D( 0, 0, 0, 0 )         ! Second derivative DO_2D( 0, 0, 0, 0 )         ! Fourth derivative ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) END_2D !! ** Purpose :  compute the max of the 9 points around !!---------------------------------------------------------------------- REAL(wp), DIMENSION(:,:,:)      , INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:)      , INTENT(out) ::   pmax   ! output REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array REAL(wp), DIMENSION(:,:,:), INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pmax   ! output INTEGER  ::   ji, jj, jl   ! dummy loop indices !!---------------------------------------------------------------------- DO jl = 1, jpl DO jj = Njs0-1, Nje0+1 DO ji = Nis0, Nie0 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) END DO END DO DO jj = Njs0, Nje0 DO ji = Nis0, Nie0 pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) END DO END DO DO_2D( 0, 0, 0, 0 ) pmax(ji,jj,jl) = MAX( epsi20, pice(ji-1,jj-1,jl), pice(ji,jj-1,jl), pice(ji+1,jj-1,jl),   & &                          pice(ji-1,jj  ,jl), pice(ji,jj  ,jl), pice(ji+1,jj  ,jl),   & &                          pice(ji-1,jj+1,jl), pice(ji,jj+1,jl), pice(ji+1,jj+1,jl) ) END_2D END DO END SUBROUTINE icemax3D !! ** Purpose :  compute the max of the 9 points around !!---------------------------------------------------------------------- REAL(wp), DIMENSION(:,:,:,:)    , INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:,:)    , INTENT(out) ::   pmax   ! output REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) ::   pice   ! input REAL(wp), DIMENSION(:,:,:,:), INTENT(out) ::   pmax   ! output INTEGER  ::   jlay, ji, jj, jk, jl   ! dummy loop indices !!---------------------------------------------------------------------- DO jl = 1, jpl DO jk = 1, jlay DO jj = Njs0-1, Nje0+1 DO ji = Nis0, Nie0 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) END DO END DO DO jj = Njs0, Nje0 DO ji = Nis0, Nie0 pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) END DO END DO DO_2D( 0, 0, 0, 0 ) pmax(ji,jj,jk,jl) = MAX( epsi20, pice(ji-1,jj-1,jk,jl), pice(ji,jj-1,jk,jl), pice(ji+1,jj-1,jk,jl),   & &                             pice(ji-1,jj  ,jk,jl), pice(ji,jj  ,jk,jl), pice(ji+1,jj  ,jk,jl),   & &                             pice(ji-1,jj+1,jk,jl), pice(ji,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) END_2D END DO END DO
• ## NEMO/trunk/src/OCE/CRS/crs.F90

 r14433 INTEGER  ::  narea_full, narea_crs        !: node INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition INTEGER  ::  jpim1_full, jpjm1_full       !: !!\$      INTEGER  ::  jpim1_full, jpjm1_full       !: INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc jpi    = jpi_full jpj    = jpj_full jpim1  = jpim1_full jpjm1  = jpjm1_full !!\$      jpim1  = jpim1_full !!\$      jpjm1  = jpjm1_full !!\$      jperio = nperio_full jpi    = jpi_crs jpj    = jpj_crs jpim1  = jpi_crsm1 jpjm1  = jpj_crsm1 !!\$      jpim1  = jpi_crsm1 !!\$      jpjm1  = jpj_crsm1 !!\$      jperio = nperio_crs

• ## NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90

 r14834 ! DO_2D( iij-1, iij, iij-1, iij ) !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) !                                      ! ahm * e3 * curl  (warning: computed for ji-1,jj-1) zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) !                                      ! ahm * div        (computed from 2 to jpi/jpj) !                                      ! ahm * div        (warning: computed for ji,jj) zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  &
• ## NEMO/trunk/src/OCE/DYN/dynldf_lap_blp_lf.F90

 r14834 ! DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )                           ! Horizontal slab !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) !                                      ! ahm * e3 * curl  (warning: computed for ji-1,jj-1) zcur     = ahmf(ji,jj,jk) * e3f(ji,jj,jk) * r1_e1e2f(ji,jj)               &   ! ahmf already * by fmask &       * ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & &       * ( e2v(ji,jj) * pv(ji,jj,jk) - e2v(ji-1,jj) * pv(ji-1,jj,jk)  & &       - e1u(ji-1,jj+1) * pu(ji-1,jj+1,jk) + e1u(ji-1,jj) * pu(ji-1,jj,jk) ) !                                      ! ahm * div        (computed from 2 to jpi/jpj) !                                      ! ahm * div        (warning: computed for ji,jj) zdiv     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask &     * ( e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  &

• ## NEMO/trunk/src/OCE/LBC/mpp_lnk_icb_generic.h90

 r14433 !                                           !* Cyclic east-west IF( l_Iperio ) THEN pt2d(1-kexti:     1   ,:) = pt2d(jpim1-kexti: jpim1 ,:)       ! east pt2d(1-kexti:     1   ,:) = pt2d(jpi-1-kexti: jpi-1 ,:)       ! east pt2d(  jpi  :jpi+kexti,:) = pt2d(     2     :2+kexti,:)       ! west ! !                                      ! North-South boundaries IF( l_Jperio ) THEN                         !* cyclic (only with no mpp j-split) pt2d(:,1-kextj:     1   ) = pt2d(:,jpjm1-kextj:  jpjm1)       ! north pt2d(:,1-kextj:     1   ) = pt2d(:,jpj-1-kextj:  jpj-1)       ! north pt2d(:,  jpj  :jpj+kextj) = pt2d(:,     2     :2+kextj)       ! south ELSE                                        !* closed
• ## NEMO/trunk/src/OCE/LBC/mppini.F90

 r15023 Nj_0 = Nje0 - Njs0 + 1 ! ! old indices to be removed... jpim1 = jpi-1                             ! inner domain indices jpjm1 = jpj-1                             !   "           " jpkm1 = jpk-1                             !   "           " !

 r13286 USE par_oce, ONLY : &        ! Domain parameters & jpi, & & jpj, & & jpim1 & jpj USE in_out_manager, ONLY : & ! I/O manager & lwp,    &
• ## NEMO/trunk/src/OCE/OBS/obs_sstbias.F90

 r13286 USE par_oce, ONLY : &        ! Domain parameters & jpi, & & jpj, & & jpim1 & jpj USE in_out_manager, ONLY : & ! I/O manager & lwp,    &

• ## NEMO/trunk/src/OCE/par_oce.F90

 r14976 INTEGER, PUBLIC ::   jpj   !                                                    !: second dimension INTEGER, PUBLIC ::   jpk   ! = jpkglo                                           !: third  dimension INTEGER, PUBLIC ::   jpim1 ! = jpi-1                                            !: inner domain indices INTEGER, PUBLIC ::   jpjm1 ! = jpj-1                                            !:   -     -      - INTEGER, PUBLIC ::   jpkm1 ! = jpk-1                                            !:   -     -      - INTEGER, PUBLIC ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
• ## NEMO/trunk/src/TOP/PISCES/SED/par_sed.F90

 r14086 jpi      =>   jpi   ,  & !: first  dimension of grid --> i jpj      =>   jpj   ,  & !: second dimension of grid --> j jpim1    =>   jpim1 ,  & !: jpi - 1 jpjm1    =>   jpjm1 ,  & !: jpj - 1 jpij     =>   jpij  ,  & !: jpi x jpj jp_tem   =>   jp_tem,  & !: indice of temperature
• ## NEMO/trunk/src/TOP/oce_trc.F90

 r14433 USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j USE par_oce , ONLY :   jpk      =>   jpk        !: number of levels USE par_oce , ONLY :   jpim1    =>   jpim1      !: jpi - 1 USE par_oce , ONLY :   jpjm1    =>   jpjm1      !: jpj - 1 USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1 USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj
• ## NEMO/trunk/tests/DOME/MY_SRC/usrdef_zgr.F90

 r14976 ! at u/v/f-point: averaging zht zhu(:,:) = 600_wp ; zhv(:,:) = 600_wp ; zhf(:,:) = 600_wp DO ji = 1, jpim1 zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) ) END DO DO jj = 1, jpjm1 zhv(:,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) ) END DO DO jj = 1, jpjm1 DO ji = 1, jpim1 zhf(ji,jj) = 0.25_wp * (  zht(ji,jj  ) + zht(ji+1,jj  ) & &            + zht(ji,jj+1) + zht(ji+1,jj+1) ) END DO END DO DO_2D( 0, 0, 0, 0 ) zhu(ji,jj) =  0.5_wp * ( zht(ji,jj  ) + zht(ji+1,jj  ) ) zhv(jj,jj) =  0.5_wp * ( zht(ji,jj  ) + zht(ji  ,jj+1) ) zhf(ji,jj) = 0.25_wp * ( zht(ji,jj  ) + zht(ji+1,jj  ) & &        + zht(ji,jj+1) + zht(ji+1,jj+1) ) END_2D CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1.0_wp, zhv, 'V', 1.0_wp, zhf, 'F', 1.0_wp) !
• ## NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

 r14857 ! ! at u-point: averaging zht DO ji = 1, jpim1 zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) ) END DO DO_2D( 0, 0, 0, 0 ) zhu(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji+1,jj) ) END_2D CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. )     ! boundary condition: this mask the surrouding grid-points !                                ! ==>>>  set by hand non-zero value on first/last columns & rows
• ## NEMO/trunk/tests/SWG/MY_SRC/usrdef_sbc.F90

 r14433 PUBLIC   usrdef_sbc_ice_flx   ! routine called by icestp.F90 for ice thermo !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) ztauv = - REAL( rn_tau, wp ) * SIN( rn_theta * rad )   ! N.m-2 DO jj = 1, jpj DO ji = 1, jpi ! length of the domain : 2000km x 2000km utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp) vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp) END DO END DO DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! length of the domain : 2000km x 2000km utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp) vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp) END_2D ! module of wind stress and wind speed at T-point zcoef = 1. / ( zrhoa * zcdrag ) DO jj = 2, jpjm1 DO ji = 2, jpim1 ztx = utau(ji-1,jj  ) + utau(ji,jj) zty = vtau(ji  ,jj-1) + vtau(ji,jj) zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) taum(ji,jj) = zmod wndm(ji,jj) = SQRT( zmod * zcoef ) END DO END DO DO_2D( 0, 0, 0, 0 ) ztx = utau(ji-1,jj  ) + utau(ji,jj) zty = vtau(ji  ,jj-1) + vtau(ji,jj) zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) taum(ji,jj) = zmod wndm(ji,jj) = SQRT( zmod * zcoef ) END_2D CALL lbc_lnk( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) !
• ## NEMO/trunk/tests/SWG/MY_SRC/usrdef_zgr.F90

 r14433 PUBLIC   usr_def_zgr        ! called by domzgr.F90 !! * Substitutions #  include "do_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) zxlim1 = 2010000._wp    ! 2010km ! DO jj = 1, jpj DO ji = 1, jpi DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! if T point in the 2000 km x 2000 km domain ! IF ( gphit(ji,jj) > zylim0 .AND. gphit(ji,jj) < zylim1 .AND. & IF ( gphiv(ji,jj) > zylim0 .AND. gphiv(ji,jj) < zylim1 .AND. & & glamu(ji,jj) > zxlim0 .AND. glamu(ji,jj) < zxlim1       )  THEN k_top(ji,jj) = 1    ! = ocean k_bot(ji,jj) = NINT( z2d(ji,jj) ) k_top(ji,jj) = 1    ! = ocean k_bot(ji,jj) = NINT( z2d(ji,jj) ) ELSE k_top(ji,jj) = 0    ! = land k_bot(ji,jj) = 0 k_top(ji,jj) = 0    ! = land k_bot(ji,jj) = 0 END IF END DO END DO END_2D ! mask the lonely corners DO jj = 2, jpjm1 DO ji = 2, jpim1 DO_2D( 0, 0, 0, 0 ) zcoeff = k_top(ji+1,jj) + k_top(ji,jj+1)   & +     k_top(ji-1,jj) + k_top(ji,jj-1) k_bot(ji,jj) = 0 END IF END DO END DO ! END_2D ! END SUBROUTINE zgr_msk_top_bot