Changeset 15033
- Timestamp:
- 2021-06-21T12:24:45+02:00 (3 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 20 edited
-
src/ICE/icedyn_adv_pra.F90 (modified) (3 diffs)
-
src/ICE/icedyn_adv_umx.F90 (modified) (6 diffs)
-
src/OCE/CRS/crs.F90 (modified) (3 diffs)
-
src/OCE/DOM/domwri.F90 (modified) (1 diff)
-
src/OCE/DYN/dynldf_lap_blp.F90 (modified) (1 diff)
-
src/OCE/DYN/dynldf_lap_blp_lf.F90 (modified) (2 diffs)
-
src/OCE/IOM/iom.F90 (modified) (2 diffs)
-
src/OCE/LBC/mpp_lnk_icb_generic.h90 (modified) (2 diffs)
-
src/OCE/LBC/mppini.F90 (modified) (1 diff)
-
src/OCE/OBS/obs_read_altbias.F90 (modified) (1 diff)
-
src/OCE/OBS/obs_sstbias.F90 (modified) (1 diff)
-
src/OCE/TRD/trdvor.F90 (modified) (11 diffs)
-
src/OCE/par_oce.F90 (modified) (1 diff)
-
src/TOP/PISCES/SED/par_sed.F90 (modified) (1 diff)
-
src/TOP/oce_trc.F90 (modified) (1 diff)
-
tests/DOME/MY_SRC/usrdef_zgr.F90 (modified) (1 diff)
-
tests/OVERFLOW/MY_SRC/usrdef_zgr.F90 (modified) (1 diff)
-
tests/SWG/MY_SRC/usrdef_sbc.F90 (modified) (2 diffs)
-
tests/SWG/MY_SRC/usrdef_zgr.F90 (modified) (4 diffs)
-
tests/WAD/MY_SRC/usrdef_zgr.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_adv_pra.F90
r14433 r15033 1168 1168 !! ** Purpose : compute the max of the 9 points around 1169 1169 !!---------------------------------------------------------------------- 1170 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pice ! input 1171 REAL(wp), DIMENSION(:,:,:) , INTENT(out) :: pmax ! output 1172 REAL(wp), DIMENSION(2:jpim1,jpj) :: zmax ! temporary array 1170 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pice ! input 1171 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pmax ! output 1173 1172 INTEGER :: ji, jj, jl ! dummy loop indices 1174 1173 !!---------------------------------------------------------------------- 1175 1174 DO jl = 1, jpl 1176 DO jj = Njs0-1, Nje0+1 1177 DO ji = Nis0, Nie0 1178 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 1179 END DO 1180 END DO 1181 DO jj = Njs0, Nje0 1182 DO ji = Nis0, Nie0 1183 pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 1184 END DO 1185 END DO 1175 DO_2D( 0, 0, 0, 0 ) 1176 pmax(ji,jj,jl) = MAX( epsi20, pice(ji-1,jj-1,jl), pice(ji,jj-1,jl), pice(ji+1,jj-1,jl), & 1177 & pice(ji-1,jj ,jl), pice(ji,jj ,jl), pice(ji+1,jj ,jl), & 1178 & pice(ji-1,jj+1,jl), pice(ji,jj+1,jl), pice(ji+1,jj+1,jl) ) 1179 END_2D 1186 1180 END DO 1187 1181 END SUBROUTINE icemax3D … … 1192 1186 !! ** Purpose : compute the max of the 9 points around 1193 1187 !!---------------------------------------------------------------------- 1194 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pice ! input 1195 REAL(wp), DIMENSION(:,:,:,:) , INTENT(out) :: pmax ! output 1196 REAL(wp), DIMENSION(2:jpim1,jpj) :: zmax ! temporary array 1188 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pice ! input 1189 REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pmax ! output 1197 1190 INTEGER :: jlay, ji, jj, jk, jl ! dummy loop indices 1198 1191 !!---------------------------------------------------------------------- … … 1200 1193 DO jl = 1, jpl 1201 1194 DO jk = 1, jlay 1202 DO jj = Njs0-1, Nje0+1 1203 DO ji = Nis0, Nie0 1204 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 1205 END DO 1206 END DO 1207 DO jj = Njs0, Nje0 1208 DO ji = Nis0, Nie0 1209 pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 1210 END DO 1211 END DO 1195 DO_2D( 0, 0, 0, 0 ) 1196 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), & 1197 & pice(ji-1,jj ,jk,jl), pice(ji,jj ,jk,jl), pice(ji+1,jj ,jk,jl), & 1198 & pice(ji-1,jj+1,jk,jl), pice(ji,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 1199 END_2D 1212 1200 END DO 1213 1201 END DO -
NEMO/trunk/src/ICE/icedyn_adv_umx.F90
r14433 r15033 867 867 ! !-- Laplacian in i-direction --! 868 868 DO jl = 1, jpl 869 DO jj = 2, jpjm1 ! First derivative (gradient) 870 DO ji = 1, jpim1 871 ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 872 END DO 873 ! ! Second derivative (Laplacian) 874 DO ji = 2, jpim1 875 ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 876 END DO 877 END DO 869 DO_2D( 1, 0, 0, 0 ) ! First derivative (gradient) 870 ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 871 END_2D 872 DO_2D( 0, 0, 0, 0 ) ! Second derivative (Laplacian) 873 ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 874 END_2D 878 875 END DO 879 876 CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) … … 881 878 ! !-- BiLaplacian in i-direction --! 882 879 DO jl = 1, jpl 883 DO jj = 2, jpjm1 ! Third derivative 884 DO ji = 1, jpim1 885 ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 886 END DO 887 ! ! Fourth derivative 888 DO ji = 2, jpim1 880 DO_2D( 1, 0, 0, 0 ) ! Third derivative 881 ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 882 END_2D 883 DO_2D( 0, 0, 0, 0 ) ! Fourth derivative 889 884 ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 890 END DO 891 END DO 885 END_2D 892 886 END DO 893 887 CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) … … 1021 1015 ! !-- BiLaplacian in j-direction --! 1022 1016 DO jl = 1, jpl 1023 DO_2D( 0, 0, 1, 0 ) ! Firstderivative1017 DO_2D( 0, 0, 1, 0 ) ! Third derivative 1024 1018 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1025 1019 END_2D 1026 DO_2D( 0, 0, 0, 0 ) ! Secondderivative1020 DO_2D( 0, 0, 0, 0 ) ! Fourth derivative 1027 1021 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1028 1022 END_2D … … 1627 1621 !! ** Purpose : compute the max of the 9 points around 1628 1622 !!---------------------------------------------------------------------- 1629 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pice ! input 1630 REAL(wp), DIMENSION(:,:,:) , INTENT(out) :: pmax ! output 1631 REAL(wp), DIMENSION(2:jpim1,jpj) :: zmax ! temporary array 1623 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pice ! input 1624 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pmax ! output 1632 1625 INTEGER :: ji, jj, jl ! dummy loop indices 1633 1626 !!---------------------------------------------------------------------- 1634 1627 DO jl = 1, jpl 1635 DO jj = Njs0-1, Nje0+1 1636 DO ji = Nis0, Nie0 1637 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 1638 END DO 1639 END DO 1640 DO jj = Njs0, Nje0 1641 DO ji = Nis0, Nie0 1642 pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 1643 END DO 1644 END DO 1628 DO_2D( 0, 0, 0, 0 ) 1629 pmax(ji,jj,jl) = MAX( epsi20, pice(ji-1,jj-1,jl), pice(ji,jj-1,jl), pice(ji+1,jj-1,jl), & 1630 & pice(ji-1,jj ,jl), pice(ji,jj ,jl), pice(ji+1,jj ,jl), & 1631 & pice(ji-1,jj+1,jl), pice(ji,jj+1,jl), pice(ji+1,jj+1,jl) ) 1632 END_2D 1645 1633 END DO 1646 1634 END SUBROUTINE icemax3D … … 1651 1639 !! ** Purpose : compute the max of the 9 points around 1652 1640 !!---------------------------------------------------------------------- 1653 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pice ! input 1654 REAL(wp), DIMENSION(:,:,:,:) , INTENT(out) :: pmax ! output 1655 REAL(wp), DIMENSION(2:jpim1,jpj) :: zmax ! temporary array 1641 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pice ! input 1642 REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pmax ! output 1656 1643 INTEGER :: jlay, ji, jj, jk, jl ! dummy loop indices 1657 1644 !!---------------------------------------------------------------------- … … 1659 1646 DO jl = 1, jpl 1660 1647 DO jk = 1, jlay 1661 DO jj = Njs0-1, Nje0+1 1662 DO ji = Nis0, Nie0 1663 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 1664 END DO 1665 END DO 1666 DO jj = Njs0, Nje0 1667 DO ji = Nis0, Nie0 1668 pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 1669 END DO 1670 END DO 1648 DO_2D( 0, 0, 0, 0 ) 1649 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), & 1650 & pice(ji-1,jj ,jk,jl), pice(ji,jj ,jk,jl), pice(ji+1,jj ,jk,jl), & 1651 & pice(ji-1,jj+1,jk,jl), pice(ji,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 1652 END_2D 1671 1653 END DO 1672 1654 END DO -
NEMO/trunk/src/OCE/CRS/crs.F90
r14433 r15033 43 43 INTEGER :: narea_full, narea_crs !: node 44 44 INTEGER :: jpnij_full, jpnij_crs !: =jpni*jpnj, the pe decomposition 45 INTEGER :: jpim1_full, jpjm1_full !:45 !!$ INTEGER :: jpim1_full, jpjm1_full !: 46 46 INTEGER :: nimpp_full, njmpp_full !: global position of point (1,1) of subdomain on parent grid 47 47 INTEGER :: nimpp_crs, njmpp_crs !: set to 1,1 for now . Valid only for monoproc … … 247 247 jpi = jpi_full 248 248 jpj = jpj_full 249 jpim1 = jpim1_full250 jpjm1 = jpjm1_full249 !!$ jpim1 = jpim1_full 250 !!$ jpjm1 = jpjm1_full 251 251 !!$ jperio = nperio_full 252 252 … … 286 286 jpi = jpi_crs 287 287 jpj = jpj_crs 288 jpim1 = jpi_crsm1289 jpjm1 = jpj_crsm1288 !!$ jpim1 = jpi_crsm1 289 !!$ jpjm1 = jpj_crsm1 290 290 !!$ jperio = nperio_crs 291 291 -
NEMO/trunk/src/OCE/DOM/domwri.F90
r14433 r15033 200 200 zr1(:) = 0._wp 201 201 ! 202 DO ji = 2, jpim1 203 DO jj = 2, jpjm1 204 DO jk = 1, jpkm1 205 !!gm remark: dk(gdepw) = e3t ===>>> possible simplification of the following calculation.... 206 !! especially since it is gde3w which is used to compute the pressure gradient 207 !! furthermore, I think gdept_0 should be used below instead of w point in the numerator 208 !! so that the ratio is computed at the same point (i.e. uw and vw) .... 209 zr1(1) = ABS( ( gdepw_0(ji ,jj,jk )-gdepw_0(ji-1,jj,jk ) & 210 & +gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) ) & 211 & / ( gdepw_0(ji ,jj,jk )+gdepw_0(ji-1,jj,jk ) & 212 & -gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall ) ) * umask(ji-1,jj,jk) 213 zr1(2) = ABS( ( gdepw_0(ji+1,jj,jk )-gdepw_0(ji ,jj,jk ) & 214 & +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) ) & 215 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) & 216 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk) 217 zr1(3) = ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) & 218 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) & 219 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) & 220 & -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) + rsmall ) ) * vmask(ji,jj ,jk) 221 zr1(4) = ABS( ( gdepw_0(ji,jj ,jk )-gdepw_0(ji,jj-1,jk ) & 222 & +gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) ) & 223 & / ( gdepw_0(ji,jj ,jk )+gdepw_0(ji,jj-1,jk ) & 224 & -gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall ) ) * vmask(ji,jj-1,jk) 225 zrxmax = MAXVAL( zr1(1:4) ) 226 zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax ) 227 END DO 228 END DO 229 END DO 202 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 203 !!gm remark: dk(gdepw) = e3t ===>>> possible simplification of the following calculation.... 204 !! especially since it is gde3w which is used to compute the pressure gradient 205 !! furthermore, I think gdept_0 should be used below instead of w point in the numerator 206 !! so that the ratio is computed at the same point (i.e. uw and vw) .... 207 zr1(1) = ABS( ( gdepw_0(ji ,jj,jk )-gdepw_0(ji-1,jj,jk ) & 208 & +gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) ) & 209 & / ( gdepw_0(ji ,jj,jk )+gdepw_0(ji-1,jj,jk ) & 210 & -gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall ) ) * umask(ji-1,jj,jk) 211 zr1(2) = ABS( ( gdepw_0(ji+1,jj,jk )-gdepw_0(ji ,jj,jk ) & 212 & +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) ) & 213 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) & 214 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk) 215 zr1(3) = ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) & 216 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) & 217 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) & 218 & -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) + rsmall ) ) * vmask(ji,jj ,jk) 219 zr1(4) = ABS( ( gdepw_0(ji,jj ,jk )-gdepw_0(ji,jj-1,jk ) & 220 & +gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) ) & 221 & / ( gdepw_0(ji,jj ,jk )+gdepw_0(ji,jj-1,jk ) & 222 & -gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall ) ) * vmask(ji,jj-1,jk) 223 zrxmax = MAXVAL( zr1(1:4) ) 224 zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax ) 225 END_3D 230 226 CALL lbc_lnk( 'domwri', zx1, 'T', 1.0_wp ) 231 227 ! -
NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90
r14834 r15033 114 114 ! 115 115 DO_2D( iij-1, iij, iij-1, iij ) 116 ! ! ahm * e3 * curl ( computed from 1 to jpim1/jpjm1)116 ! ! ahm * e3 * curl (warning: computed for ji-1,jj-1) 117 117 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 118 118 & * ( e2v(ji ,jj-1) * pv(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk) & 119 119 & - e1u(ji-1,jj ) * pu(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk) ) 120 ! ! ahm * div ( computed from 2 to jpi/jpj)120 ! ! ahm * div (warning: computed for ji,jj) 121 121 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb) & ! ahmt already * by tmask 122 122 & * ( 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 r15033 101 101 ! 102 102 DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 ) ! Horizontal slab 103 ! ! ahm * e3 * curl ( computed from 1 to jpim1/jpjm1)103 ! ! ahm * e3 * curl (warning: computed for ji-1,jj-1) 104 104 zcur = ahmf(ji,jj,jk) * e3f(ji,jj,jk) * r1_e1e2f(ji,jj) & ! ahmf already * by fmask 105 105 & * ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & … … 111 111 & * ( e2v(ji,jj) * pv(ji,jj,jk) - e2v(ji-1,jj) * pv(ji-1,jj,jk) & 112 112 & - e1u(ji-1,jj+1) * pu(ji-1,jj+1,jk) + e1u(ji-1,jj) * pu(ji-1,jj,jk) ) 113 ! ! ahm * div ( computed from 2 to jpi/jpj)113 ! ! ahm * div (warning: computed for ji,jj) 114 114 zdiv = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb) & ! ahmt already * by tmask 115 115 & * ( 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/IOM/iom.F90
r15023 r15033 2316 2316 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2317 2317 ! 2318 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zmask2318 REAL(wp), DIMENSION(A2D(0),jpk) :: zmask 2319 2319 INTEGER :: jn 2320 2320 INTEGER, DIMENSION(nijtile) :: ini, inj, idb … … 2357 2357 ! mask land points, keep values on coast line -> specific mask for U, V and W points 2358 2358 SELECT CASE ( cdgrd ) 2359 CASE('T') ; zmask( : , : ,:) = tmask(:,:,:) 2360 CASE('U') ; zmask(2:jpim1, : ,:) = tmask(2:jpim1, : ,:) + tmask(3:jpi , : ,:) 2361 CASE('V') ; zmask( : ,2:jpjm1,:) = tmask( : ,2:jpjm1,:) + tmask( : ,3:jpj,:) 2362 CASE('F') ; zmask(2:jpim1,2:jpjm1,:) = tmask(2:jpim1,2:jpjm1,:) + tmask(2:jpim1,3:jpj,:) & 2363 & + tmask(3:jpi ,2:jpjm1,:) + tmask(3:jpi ,3:jpj,:) 2364 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 2359 CASE('T') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:) 2360 CASE('U') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:) + tmask(Nis0+1:Nie0+1, Njs0 :Nje0 ,:) 2361 CASE('V') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:) + tmask(Nis0 :Nie0 , Njs0+1:Nje0+1,:) 2362 CASE('F') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:) + tmask(Nis0 :Nie0 , Njs0+1:Nje0+1,:) & 2363 & + tmask(Nis0+1:Nie0+1, Njs0:Nje0,:) + tmask(Nis0+1:Nie0+1, Njs0+1:Nje0+1,:) 2364 CASE('W') ; zmask(:,:,2:jpk) = tmask(Nis0:Nie0, Njs0:Nje0,1:jpkm1) + tmask(Nis0:Nie0, Njs0:Nje0,2:jpk) 2365 zmask(:,:,1 ) = tmask(Nis0:Nie0, Njs0:Nje0,1) 2365 2366 END SELECT 2366 2367 ! 2367 CALL iom_set_domain_attr( "grid_"//cdgrd , mask=RESHAPE(zmask( Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0 /)) /= 0. )2368 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D" , mask=RESHAPE(zmask( Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. )2369 CALL iom_set_domain_attr( "grid_"//cdgrd//"_inner" , mask=RESHAPE(zmask( Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0 /)) /= 0. )2370 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D_inner", mask=RESHAPE(zmask( Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. )2368 CALL iom_set_domain_attr( "grid_"//cdgrd , mask=RESHAPE(zmask(:,:,1),(/Ni_0*Nj_0 /)) /= 0. ) 2369 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D" , mask=RESHAPE(zmask(:,:,:),(/Ni_0,Nj_0,jpk/)) /= 0. ) 2370 CALL iom_set_domain_attr( "grid_"//cdgrd//"_inner" , mask=RESHAPE(zmask(:,:,1),(/Ni_0*Nj_0 /)) /= 0. ) 2371 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D_inner", mask=RESHAPE(zmask(:,:,:),(/Ni_0,Nj_0,jpk/)) /= 0. ) 2371 2372 ENDIF 2372 2373 ! -
NEMO/trunk/src/OCE/LBC/mpp_lnk_icb_generic.h90
r14433 r15033 56 56 ! !* Cyclic east-west 57 57 IF( l_Iperio ) THEN 58 pt2d(1-kexti: 1 ,:) = pt2d(jpi m1-kexti: jpim1 ,:) ! east58 pt2d(1-kexti: 1 ,:) = pt2d(jpi-1-kexti: jpi-1 ,:) ! east 59 59 pt2d( jpi :jpi+kexti,:) = pt2d( 2 :2+kexti,:) ! west 60 60 ! … … 70 70 ! ! North-South boundaries 71 71 IF( l_Jperio ) THEN !* cyclic (only with no mpp j-split) 72 pt2d(:,1-kextj: 1 ) = pt2d(:,jpj m1-kextj: jpjm1) ! north72 pt2d(:,1-kextj: 1 ) = pt2d(:,jpj-1-kextj: jpj-1) ! north 73 73 pt2d(:, jpj :jpj+kextj) = pt2d(:, 2 :2+kextj) ! south 74 74 ELSE !* closed -
NEMO/trunk/src/OCE/LBC/mppini.F90
r15023 r15033 1338 1338 Nj_0 = Nje0 - Njs0 + 1 1339 1339 ! 1340 ! old indices to be removed...1341 jpim1 = jpi-1 ! inner domain indices1342 jpjm1 = jpj-1 ! " "1343 1340 jpkm1 = jpk-1 ! " " 1344 1341 ! -
NEMO/trunk/src/OCE/OBS/obs_read_altbias.F90
r13286 r15033 16 16 USE par_oce, ONLY : & ! Domain parameters 17 17 & jpi, & 18 & jpj, & 19 & jpim1 18 & jpj 20 19 USE in_out_manager, ONLY : & ! I/O manager 21 20 & lwp, & -
NEMO/trunk/src/OCE/OBS/obs_sstbias.F90
r13286 r15033 14 14 USE par_oce, ONLY : & ! Domain parameters 15 15 & jpi, & 16 & jpj, & 17 & jpim1 16 & jpj 18 17 USE in_out_manager, ONLY : & ! I/O manager 19 18 & lwp, & -
NEMO/trunk/src/OCE/TRD/trdvor.F90
r14433 r15033 95 95 !!---------------------------------------------------------------------- 96 96 97 CALL lbc_lnk( 'trdvor', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp ) ! lateral boundary condition 98 97 99 SELECT CASE( ktrd ) 98 100 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm ) ! Hydrostatique Pressure Gradient … … 104 106 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm ) ! Surface Pressure Grad. 105 107 CASE( jpdyn_zdf ) ! Vertical Diffusion 106 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 107 DO_2D( 0, 0, 0, 0 ) ! wind stress trends 108 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! wind stress trends 108 109 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 ) 109 110 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 ) 110 111 END_2D 111 !112 112 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm ) ! zdf trend including surf./bot. stresses 113 113 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm ) ! surface wind stress … … 142 142 !! vortrd (,, 9) = Beta V 143 143 !! vortrd (,,10) = forcing term 144 !! 144 !! vortrd (,,11) = bottom friction term 145 145 !! rotot(,) : total cumulative trends over nn_write-1 time steps 146 146 !! vor_avrtot(,) : first membre of vrticity equation … … 149 149 !! trends output in netCDF format using ioipsl 150 150 !!---------------------------------------------------------------------- 151 INTEGER , INTENT(in 152 INTEGER , INTENT(in 153 REAL(wp), DIMENSION(jpi,jpj), INTENT(in out) :: putrdvor ! u vorticity trend154 REAL(wp), DIMENSION(jpi,jpj), INTENT(in out) :: pvtrdvor ! v vorticity trend151 INTEGER , INTENT(in) :: ktrd ! ocean trend index 152 INTEGER , INTENT(in) :: Kmm ! time level index 153 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: putrdvor ! u vorticity trend 154 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvtrdvor ! v vorticity trend 155 155 ! 156 156 INTEGER :: ji, jj ! dummy loop indices … … 159 159 !!---------------------------------------------------------------------- 160 160 161 !162 163 zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp ! Initialisation164 CALL lbc_lnk( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) ! lateral boundary condition165 166 167 161 ! ===================================== 168 162 ! I vertical integration of 2D trends … … 172 166 ! 173 167 CASE( jpvor_bfr ) ! bottom friction 174 DO_2D( 0, 0, 0, 0)168 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 175 169 ikbu = mbkv(ji,jj) 176 170 ikbv = mbkv(ji,jj) … … 190 184 191 185 ! Curl 192 DO ji = 1, jpim1 193 DO jj = 1, jpjm1 194 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 195 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 196 & / ( e1f(ji,jj) * e2f(ji,jj) ) 197 END DO 198 END DO 199 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) ! Surface mask 186 DO_2D( 0, 0, 0, 0 ) 187 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 188 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 189 & / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 190 END_2D 200 191 201 192 IF( ndebug /= 0 ) THEN … … 235 226 !!---------------------------------------------------------------------- 236 227 ! 237 INTEGER , INTENT(in 238 INTEGER , INTENT(in 239 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in out) :: putrdvor ! u vorticity trend240 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in out) :: pvtrdvor ! v vorticity trend228 INTEGER , INTENT(in) :: ktrd ! ocean trend index 229 INTEGER , INTENT(in) :: Kmm ! time level index 230 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: putrdvor ! u vorticity trend 231 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pvtrdvor ! v vorticity trend 241 232 ! 242 233 INTEGER :: ji, jj, jk ! dummy loop indices 243 REAL(wp), DIMENSION(jpi,jpj) :: zubet , zvbet ! Beta.V244 234 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 245 235 !!---------------------------------------------------------------------- 246 247 ! Initialization248 zubet (:,:) = 0._wp249 zvbet (:,:) = 0._wp250 zudpvor(:,:) = 0._wp251 zvdpvor(:,:) = 0._wp252 ! ! lateral boundary condition on input momentum trends253 CALL lbc_lnk( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp )254 236 255 237 ! ===================================== … … 265 247 ! as Beta.V term need intergration, not average 266 248 IF( ktrd == jpvor_pvo ) THEN 267 zubet(:,:) = zudpvor(:,:) 268 zvbet(:,:) = zvdpvor(:,:) 269 DO ji = 1, jpim1 270 DO jj = 1, jpjm1 271 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 272 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) & 273 & / ( e1f(ji,jj) * e2f(ji,jj) ) 274 END DO 275 END DO 276 ! Average of the Curl and Surface mask 277 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 249 DO_2D( 0, 0, 0, 0 ) 250 vortrd(ji,jj,jpvor_bev) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 251 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 252 & / ( e1f(ji,jj) * e2f(ji,jj) ) * r1_hu(ji,jj,Kmm) * fmask(ji,jj,1) 253 END_2D 278 254 ENDIF 279 255 ! … … 283 259 ! 284 260 ! Curl 285 DO ji=1,jpim1 286 DO jj=1,jpjm1 287 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 288 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 289 & / ( e1f(ji,jj) * e2f(ji,jj) ) 290 END DO 291 END DO 292 ! Surface mask 293 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 261 DO_2D( 0, 0, 0, 0 ) 262 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 263 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 264 & / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 265 END_2D 294 266 295 267 IF( ndebug /= 0 ) THEN … … 346 318 347 319 ! Curl 348 DO ji = 1, jpim1 349 DO jj = 1, jpjm1 350 vor_avr(ji,jj) = ( ( zvv(ji+1,jj) - zvv(ji,jj) ) & 351 & - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) & 352 & / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 353 END DO 354 END DO 320 DO_2D( 0, 0, 0, 0 ) 321 vor_avr(ji,jj) = ( ( zvv(ji+1,jj) - zvv(ji,jj) ) & 322 & - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) & 323 & / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 324 END_2D 355 325 356 326 ! ================================= -
NEMO/trunk/src/OCE/par_oce.F90
r14976 r15033 58 58 INTEGER, PUBLIC :: jpj ! !: second dimension 59 59 INTEGER, PUBLIC :: jpk ! = jpkglo !: third dimension 60 INTEGER, PUBLIC :: jpim1 ! = jpi-1 !: inner domain indices61 INTEGER, PUBLIC :: jpjm1 ! = jpj-1 !: - - -62 60 INTEGER, PUBLIC :: jpkm1 ! = jpk-1 !: - - - 63 61 INTEGER, PUBLIC :: jpij ! = jpi*jpj !: jpi x jpj -
NEMO/trunk/src/TOP/PISCES/SED/par_sed.F90
r14086 r15033 14 14 jpi => jpi , & !: first dimension of grid --> i 15 15 jpj => jpj , & !: second dimension of grid --> j 16 jpim1 => jpim1 , & !: jpi - 117 jpjm1 => jpjm1 , & !: jpj - 118 16 jpij => jpij , & !: jpi x jpj 19 17 jp_tem => jp_tem, & !: indice of temperature -
NEMO/trunk/src/TOP/oce_trc.F90
r14433 r15033 12 12 USE par_oce , ONLY : jpj => jpj !: second dimension of grid --> j 13 13 USE par_oce , ONLY : jpk => jpk !: number of levels 14 USE par_oce , ONLY : jpim1 => jpim1 !: jpi - 115 USE par_oce , ONLY : jpjm1 => jpjm1 !: jpj - 116 14 USE par_oce , ONLY : jpkm1 => jpkm1 !: jpk - 1 17 15 USE par_oce , ONLY : jpij => jpij !: jpi x jpj -
NEMO/trunk/tests/DOME/MY_SRC/usrdef_zgr.F90
r14976 r15033 86 86 ! at u/v/f-point: averaging zht 87 87 zhu(:,:) = 600_wp ; zhv(:,:) = 600_wp ; zhf(:,:) = 600_wp 88 DO ji = 1, jpim1 89 zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) ) 90 END DO 91 DO jj = 1, jpjm1 92 zhv(:,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) ) 93 END DO 94 DO jj = 1, jpjm1 95 DO ji = 1, jpim1 96 zhf(ji,jj) = 0.25_wp * ( zht(ji,jj ) + zht(ji+1,jj ) & 97 & + zht(ji,jj+1) + zht(ji+1,jj+1) ) 98 END DO 99 END DO 88 DO_2D( 0, 0, 0, 0 ) 89 zhu(ji,jj) = 0.5_wp * ( zht(ji,jj ) + zht(ji+1,jj ) ) 90 zhv(jj,jj) = 0.5_wp * ( zht(ji,jj ) + zht(ji ,jj+1) ) 91 zhf(ji,jj) = 0.25_wp * ( zht(ji,jj ) + zht(ji+1,jj ) & 92 & + zht(ji,jj+1) + zht(ji+1,jj+1) ) 93 END_2D 100 94 CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1.0_wp, zhv, 'V', 1.0_wp, zhf, 'F', 1.0_wp) 101 95 ! -
NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
r14857 r15033 90 90 ! 91 91 ! at u-point: averaging zht 92 DO ji = 1, jpim193 zhu(ji, :) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) )94 END DO92 DO_2D( 0, 0, 0, 0 ) 93 zhu(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji+1,jj) ) 94 END_2D 95 95 CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points 96 96 ! ! ==>>> set by hand non-zero value on first/last columns & rows -
NEMO/trunk/tests/SWG/MY_SRC/usrdef_sbc.F90
r14433 r15033 32 32 PUBLIC usrdef_sbc_ice_flx ! routine called by icestp.F90 for ice thermo 33 33 34 !! * Substitutions 35 # include "do_loop_substitute.h90" 34 36 !!---------------------------------------------------------------------- 35 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 84 86 ztauv = - REAL( rn_tau, wp ) * SIN( rn_theta * rad ) ! N.m-2 85 87 86 DO jj = 1, jpj 87 DO ji = 1, jpi 88 ! length of the domain : 2000km x 2000km 89 utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp) 90 vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp) 91 END DO 92 END DO 93 88 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 89 ! length of the domain : 2000km x 2000km 90 utau(ji,jj) = - ztauu * COS( rpi * gphiu(ji,jj) / 2000000._wp) 91 vtau(ji,jj) = - ztauv * COS( rpi * gphiv(ji,jj) / 2000000._wp) 92 END_2D 93 94 94 ! module of wind stress and wind speed at T-point 95 95 zcoef = 1. / ( zrhoa * zcdrag ) 96 DO jj = 2, jpjm1 97 DO ji = 2, jpim1 98 ztx = utau(ji-1,jj ) + utau(ji,jj) 99 zty = vtau(ji ,jj-1) + vtau(ji,jj) 100 zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 101 taum(ji,jj) = zmod 102 wndm(ji,jj) = SQRT( zmod * zcoef ) 103 END DO 104 END DO 105 96 DO_2D( 0, 0, 0, 0 ) 97 ztx = utau(ji-1,jj ) + utau(ji,jj) 98 zty = vtau(ji ,jj-1) + vtau(ji,jj) 99 zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 100 taum(ji,jj) = zmod 101 wndm(ji,jj) = SQRT( zmod * zcoef ) 102 END_2D 106 103 CALL lbc_lnk( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) 107 104 ! -
NEMO/trunk/tests/SWG/MY_SRC/usrdef_zgr.F90
r14433 r15033 31 31 PUBLIC usr_def_zgr ! called by domzgr.F90 32 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 197 199 zxlim1 = 2010000._wp ! 2010km 198 200 ! 199 DO jj = 1, jpj 200 DO ji = 1, jpi 201 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 201 202 ! if T point in the 2000 km x 2000 km domain 202 203 ! IF ( gphit(ji,jj) > zylim0 .AND. gphit(ji,jj) < zylim1 .AND. & … … 205 206 IF ( gphiv(ji,jj) > zylim0 .AND. gphiv(ji,jj) < zylim1 .AND. & 206 207 & glamu(ji,jj) > zxlim0 .AND. glamu(ji,jj) < zxlim1 ) THEN 207 k_top(ji,jj) = 1 ! = ocean208 k_bot(ji,jj) = NINT( z2d(ji,jj) )208 k_top(ji,jj) = 1 ! = ocean 209 k_bot(ji,jj) = NINT( z2d(ji,jj) ) 209 210 ELSE 210 k_top(ji,jj) = 0 ! = land211 k_bot(ji,jj) = 0211 k_top(ji,jj) = 0 ! = land 212 k_bot(ji,jj) = 0 212 213 END IF 213 END DO 214 END DO 214 END_2D 215 215 ! mask the lonely corners 216 DO jj = 2, jpjm1 217 DO ji = 2, jpim1 216 DO_2D( 0, 0, 0, 0 ) 218 217 zcoeff = k_top(ji+1,jj) + k_top(ji,jj+1) & 219 218 + k_top(ji-1,jj) + k_top(ji,jj-1) … … 222 221 k_bot(ji,jj) = 0 223 222 END IF 224 END DO 225 END DO 226 ! 223 END_2D 227 224 ! 228 225 END SUBROUTINE zgr_msk_top_bot -
NEMO/trunk/tests/WAD/MY_SRC/usrdef_zgr.F90
r14433 r15033 230 230 231 231 ! at u-point: averaging zht 232 DO ji = 1, jpim1233 zhu(ji, :) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) )234 END DO232 DO_2D( 0, 0, 0, 0 ) 233 zhu(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji+1,jj) ) 234 END_2D 235 235 CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrounding grid-points 236 236 ! ! ==>>> set by hand non-zero value on first/last columns & rows
Note: See TracChangeset
for help on using the changeset viewer.
