Changeset 13174
- Timestamp:
- 2020-06-29T17:28:55+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_generic.h90
r12807 r13174 6 6 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D),INTENT(inout)::ptab(f) 7 7 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 8 # define J_SIZE(ptab) SIZE(ptab(1)%pt2d,2) 8 9 # define K_SIZE(ptab) 1 9 10 # define L_SIZE(ptab) 1 … … 12 13 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D),INTENT(inout)::ptab(f) 13 14 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 15 # define J_SIZE(ptab) SIZE(ptab(1)%pt3d,2) 14 16 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) 15 17 # define L_SIZE(ptab) 1 … … 18 20 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab(f) 19 21 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 22 # define J_SIZE(ptab) SIZE(ptab(1)%pt4d,2) 20 23 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 21 24 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) … … 28 31 # if defined DIM_2d 29 32 # define ARRAY_IN(i,j,k,l,f) ptab(i,j) 33 # define J_SIZE(ptab) SIZE(ptab,2) 30 34 # define K_SIZE(ptab) 1 31 35 # define L_SIZE(ptab) 1 … … 33 37 # if defined DIM_3d 34 38 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k) 39 # define J_SIZE(ptab) SIZE(ptab,2) 35 40 # define K_SIZE(ptab) SIZE(ptab,3) 36 41 # define L_SIZE(ptab) 1 … … 38 43 # if defined DIM_4d 39 44 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k,l) 45 # define J_SIZE(ptab) SIZE(ptab,2) 40 46 # define K_SIZE(ptab) SIZE(ptab,3) 41 47 # define L_SIZE(ptab) SIZE(ptab,4) … … 54 60 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 55 61 ! 56 INTEGER :: ji, jj, jk, jl, jh,jf ! dummy loop indices57 INTEGER :: ipi, ipj, ipk, ipl,ipf ! dimension of the input array58 INTEGER :: i jt, iju, ipjm162 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices 63 INTEGER :: ipj, ipk, ipl, ipf ! dimension of the input array 64 INTEGER :: ii1, ii2, ij1, ij2 59 65 !!---------------------------------------------------------------------- 60 66 ! 61 ipk = K_SIZE(ptab) ! 3rd dimension 67 ipj = J_SIZE(ptab) ! 2nd dimension 68 ipk = K_SIZE(ptab) ! 3rd - 62 69 ipl = L_SIZE(ptab) ! 4th - 63 70 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 64 !65 !66 SELECT CASE ( jpni )67 CASE ( 1 ) ; ipj = jpj ! 1 proc only along the i-direction68 CASE DEFAULT ; ipj = 4 ! several proc along the i-direction69 END SELECT70 ipjm1 = ipj-171 72 71 ! 73 72 DO jf = 1, ipf ! Loop on the number of arrays to be treated … … 79 78 SELECT CASE ( NAT_IN(jf) ) 80 79 CASE ( 'T' , 'W' ) ! T-, W-point 81 DO ji = 2, jpiglo 82 ijt = jpiglo-ji+2 83 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2,:,:,jf) 84 END DO 85 ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-2,:,:,jf) 86 DO ji = jpiglo/2+1, jpiglo 87 ijt = jpiglo-ji+2 88 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf) 89 END DO 80 DO jl = 1, ipl; DO jk = 1, ipk 81 ! 82 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 83 DO jj = 1, nn_hls 84 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 85 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 86 ! 87 DO ji = 1, nn_hls ! first nn_hls points 88 ii1 = ji ! ends at: nn_hls 89 ii2 = 2*nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 90 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 91 END DO 92 DO ji = 1, 1 ! point nn_hls+1 93 ii1 = nn_hls + ji 94 ii2 = ii1 95 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 96 END DO 97 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 98 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 99 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 100 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 101 END DO 102 DO ji = 1, 1 ! point jpiglo - nn_hls + 1 103 ii1 = jpiglo - nn_hls + ji 104 ii2 = nn_hls + ji 105 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 106 END DO 107 DO ji = 1, nn_hls-1 ! last nn_hls-1 points 108 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 109 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 110 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 111 END DO 112 END DO 113 ! 114 ! line number ipj-nn_hls : right half 115 DO jj = 1, 1 116 ij1 = ipj - nn_hls 117 ij2 = ij1 ! same line 118 ! 119 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 120 ii1 = jpiglo/2 + ji + 1 ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls 121 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2 122 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 123 END DO 124 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) 125 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 126 ii1 = ji ! ends at: nn_hls 127 ii2 = 2*nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 128 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 129 END DO 130 ! ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity 131 END DO 132 ! 133 END DO; END DO 90 134 CASE ( 'U' ) ! U-point 91 DO ji = 1, jpiglo-1 92 iju = jpiglo-ji+1 93 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2,:,:,jf) 94 END DO 95 ARRAY_IN( 1 ,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-2,:,:,jf) 96 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf) 97 DO ji = jpiglo/2, jpiglo-1 98 iju = jpiglo-ji+1 99 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf) 100 END DO 135 DO jl = 1, ipl; DO jk = 1, ipk 136 ! 137 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 138 DO jj = 1, nn_hls 139 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 140 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 141 ! 142 DO ji = 1, nn_hls ! first nn_hls points 143 ii1 = ji ! ends at: nn_hls 144 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 145 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 146 END DO 147 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 148 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 149 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 150 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 151 END DO 152 DO ji = 1, nn_hls ! last nn_hls points 153 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 154 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 155 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 156 END DO 157 END DO 158 ! 159 ! line number ipj-nn_hls : right half 160 DO jj = 1, 1 161 ij1 = ipj - nn_hls 162 ij2 = ij1 ! same line 163 ! 164 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 165 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 166 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 167 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 168 END DO 169 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) 170 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 171 ii1 = ji ! ends at: nn_hls 172 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 173 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 174 END DO 175 ! ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity 176 END DO 177 ! 178 END DO; END DO 101 179 CASE ( 'V' ) ! V-point 102 DO ji = 2, jpiglo 103 ijt = jpiglo-ji+2 104 ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2,:,:,jf) 105 ARRAY_IN(ji,ipj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-3,:,:,jf) 106 END DO 107 ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-3,:,:,jf) 180 DO jl = 1, ipl; DO jk = 1, ipk 181 ! 182 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full 183 DO jj = 1, nn_hls+1 184 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls 185 ij2 = ipj - 2*nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1 186 ! 187 DO ji = 1, nn_hls ! first nn_hls points 188 ii1 = ji ! ends at: nn_hls 189 ii2 = 2*nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 190 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 191 END DO 192 DO ji = 1, 1 ! point nn_hls+1 193 ii1 = nn_hls + ji 194 ii2 = ii1 195 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 196 END DO 197 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 198 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 199 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 200 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 201 END DO 202 DO ji = 1, 1 ! point jpiglo - nn_hls + 1 203 ii1 = jpiglo - nn_hls + ji 204 ii2 = nn_hls + ji 205 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 206 END DO 207 DO ji = 1, nn_hls-1 ! last nn_hls-1 points 208 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 209 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 210 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 211 END DO 212 END DO 213 ! 214 END DO; END DO 108 215 CASE ( 'F' ) ! F-point 109 DO ji = 1, jpiglo-1 110 iju = jpiglo-ji+1 111 ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2,:,:,jf) 112 ARRAY_IN(ji,ipj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-3,:,:,jf) 113 END DO 114 ARRAY_IN( 1 ,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-3,:,:,jf) 115 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf) 116 END SELECT 216 DO jl = 1, ipl; DO jk = 1, ipk 217 ! 218 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full 219 DO jj = 1, nn_hls+1 220 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls 221 ij2 = ipj - 2*nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1 222 ! 223 DO ji = 1, nn_hls ! first nn_hls points 224 ii1 = ji ! ends at: nn_hls 225 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 226 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 227 END DO 228 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 229 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 230 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 231 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 232 END DO 233 DO ji = 1, nn_hls ! last nn_hls points 234 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 235 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 236 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 237 END DO 238 END DO 239 ! 240 END DO; END DO 241 END SELECT ! NAT_IN(jf) 117 242 ! 118 243 CASE ( 5 , 6 ) ! * North fold F-point pivot … … 120 245 SELECT CASE ( NAT_IN(jf) ) 121 246 CASE ( 'T' , 'W' ) ! T-, W-point 122 DO ji = 1, jpiglo 123 ijt = jpiglo-ji+1 124 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-1,:,:,jf) 125 END DO 247 DO jl = 1, ipl; DO jk = 1, ipk 248 ! 249 ! first: line number ipj-nn_hls : 3 points 250 DO jj = 1, 1 251 ij1 = ipj - nn_hls 252 ij2 = ij1 ! same line 253 ! 254 DO ji = 1, 1 ! points from jpiglo/2+1 255 ii1 = jpiglo/2 + ji 256 ii2 = jpiglo/2 - ji + 1 257 ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign... 258 END DO 259 DO ji = 1, 1 ! points jpiglo - nn_hls 260 ii1 = jpiglo - nn_hls + ji - 1 261 ii2 = nn_hls + ji 262 ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign... 263 END DO 264 DO ji = 1, 1 ! point nn_hls: redo it just in case (if e-w periodocity already done) 265 ! ! as we just changed point jpiglo - nn_hls 266 ii1 = nn_hls + ji - 1 267 ii2 = nn_hls + ji 268 ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign... 269 END DO 270 END DO 271 ! 272 ! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full 273 DO jj = 1, nn_hls 274 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls 275 ij2 = ipj - 2*nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls 276 ! 277 DO ji = 1, nn_hls ! first nn_hls points 278 ii1 = ji ! ends at: nn_hls 279 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 280 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 281 END DO 282 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 283 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 284 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 285 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 286 END DO 287 DO ji = 1, nn_hls ! last nn_hls points 288 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 289 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 290 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 291 END DO 292 END DO 293 ! 294 END DO; END DO 126 295 CASE ( 'U' ) ! U-point 127 DO ji = 1, jpiglo-1 128 iju = jpiglo-ji 129 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-1,:,:,jf) 130 END DO 131 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-1,:,:,jf) 296 DO jl = 1, ipl; DO jk = 1, ipk 297 ! 298 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 299 DO jj = 1, nn_hls 300 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls 301 ij2 = ipj - 2*nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls 302 ! 303 DO ji = 1, nn_hls-1 ! first nn_hls-1 points 304 ii1 = ji ! ends at: nn_hls-1 305 ii2 = 2*nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 306 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 307 END DO 308 DO ji = 1, 1 ! point nn_hls 309 ii1 = nn_hls + ji - 1 310 ii2 = jpiglo - ii1 311 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 312 END DO 313 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls) 314 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 315 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 316 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 317 END DO 318 DO ji = 1, 1 ! point jpiglo - nn_hls 319 ii1 = jpiglo - nn_hls + ji - 1 320 ii2 = ii1 321 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 322 END DO 323 DO ji = 1, nn_hls ! last nn_hls points 324 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 325 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 326 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 327 END DO 328 END DO 329 ! 330 END DO; END DO 132 331 CASE ( 'V' ) ! V-point 133 DO ji = 1, jpiglo 134 ijt = jpiglo-ji+1 135 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2,:,:,jf) 136 END DO 137 DO ji = jpiglo/2+1, jpiglo 138 ijt = jpiglo-ji+1 139 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf) 140 END DO 332 DO jl = 1, ipl; DO jk = 1, ipk 333 ! 334 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 335 DO jj = 1, nn_hls 336 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 337 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 338 ! 339 DO ji = 1, nn_hls ! first nn_hls points 340 ii1 = ji ! ends at: nn_hls 341 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 342 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 343 END DO 344 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 345 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 346 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 347 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 348 END DO 349 DO ji = 1, nn_hls ! last nn_hls points 350 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 351 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 352 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 353 END DO 354 END DO 355 ! 356 ! line number ipj-nn_hls : right half 357 DO jj = 1, 1 358 ij1 = ipj - nn_hls 359 ij2 = ij1 ! same line 360 ! 361 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 362 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 363 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 364 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 365 END DO 366 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) 367 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 368 ii1 = ji ! ends at: nn_hls 369 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 370 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 371 END DO 372 ! ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity 373 END DO 374 ! 375 END DO; END DO 141 376 CASE ( 'F' ) ! F-point 142 DO ji = 1, jpiglo-1 143 iju = jpiglo-ji 144 ARRAY_IN(ji,ipj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2,:,:,jf) 145 END DO 146 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-2,:,:,jf) 147 DO ji = jpiglo/2+1, jpiglo-1 148 iju = jpiglo-ji 149 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf) 150 END DO 151 END SELECT 377 DO jl = 1, ipl; DO jk = 1, ipk 378 ! 379 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 380 DO jj = 1, nn_hls 381 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 382 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 383 ! 384 DO ji = 1, nn_hls-1 ! first nn_hls-1 points 385 ii1 = ji ! ends at: nn_hls-1 386 ii2 = 2*nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 387 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 388 END DO 389 DO ji = 1, 1 ! point nn_hls 390 ii1 = nn_hls + ji - 1 391 ii2 = jpiglo - ii1 392 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 393 END DO 394 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls) 395 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 396 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 397 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 398 END DO 399 DO ji = 1, 1 ! point jpiglo - nn_hls 400 ii1 = jpiglo - nn_hls + ji - 1 401 ii2 = ii1 402 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 403 END DO 404 DO ji = 1, nn_hls ! last nn_hls points 405 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 406 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 407 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 408 END DO 409 END DO 410 ! 411 ! line number ipj-nn_hls : right half 412 DO jj = 1, 1 413 ij1 = ipj - nn_hls 414 ij2 = ij1 ! same line 415 ! 416 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+1 to jpiglo - nn_hls-1 (note: Ni0glo = jpiglo - 2*nn_hls) 417 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 418 ii2 = jpiglo/2 - ji ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1 419 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 420 END DO 421 DO ji = 1, nn_hls-1 ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done) 422 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1 423 ii1 = ji ! ends at: nn_hls 424 ii2 = 2*nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 425 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 426 END DO 427 ! ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity 428 END DO 429 ! 430 END DO; END DO 431 END SELECT ! NAT_IN(jf) 152 432 ! 153 CASE DEFAULT ! * closed : the code probably never go through 154 ! 155 SELECT CASE ( NAT_IN(jf) ) 156 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 157 ARRAY_IN(:, 1 ,:,:,jf) = 0._wp 158 ARRAY_IN(:,ipj,:,:,jf) = 0._wp 159 CASE ( 'F' ) ! F-point 160 ARRAY_IN(:,ipj,:,:,jf) = 0._wp 161 END SELECT 162 ! 163 END SELECT ! npolj 433 END SELECT ! npolj 164 434 ! 165 END DO 435 END DO ! ipf 166 436 ! 167 437 END SUBROUTINE ROUTINE_NFD … … 171 441 #undef NAT_IN 172 442 #undef SGN_IN 443 #undef J_SIZE 173 444 #undef K_SIZE 174 445 #undef L_SIZE -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90
r13130 r13174 176 176 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 177 177 ! 178 nn_hls = MAX(1, nn_hls) ! nn_hls must be > 0 178 179 IF(lwp) THEN 179 180 WRITE(numout,*) ' Namelist nammpp' … … 1282 1283 !!---------------------------------------------------------------------- 1283 1284 ! 1284 IF( nn_hls == 1 ) THEN !* halo size of 1 1285 ! 1286 Nis0 = 2 ; Nis1 = 1 ; Nis1nxt2 = Nis0 ; Nis2 = Nis1 1287 Njs0 = 2 ; Njs1 = 1 ; Njs1nxt2 = Njs0 ; Njs2 = Njs1 1288 ! 1289 Nie0 = jpi-1 ; Nie1 = jpi ; Nie1nxt2 = Nie0 ; Nie2 = Nie1 1290 Nje0 = jpj-1 ; Nje1 = jpj ; Nje1nxt2 = Nje0 ; Nje2 = Nje1 1291 ! 1292 ELSEIF( nn_hls == 2 ) THEN !* halo size of 2 1293 ! 1294 Nis0 = 3 ; Nis1 = 2 ; Nis1nxt2 = Nis1 ; Nis2 = 1 1295 Njs0 = 3 ; Njs1 = 2 ; Njs1nxt2 = Njs1 ; Njs2 = 1 1296 ! 1297 Nie0 = jpi-2 ; Nie1 = jpi-1 ; Nie1nxt2 = Nie1 ; Nie2 = jpi 1298 Nje0 = jpj-2 ; Nje1 = jpj-1 ; Nje1nxt2 = Nje1 ; Nje2 = jpj 1299 ! 1300 ELSE !* unexpected halo size 1301 CALL ctl_stop( 'STOP', 'ini_mpp: wrong value of halo size : nn_hls= 1 or 2 only !') 1285 Nis0 = 1+nn_hls ; Nis1 = Nis0-1 ; Nis2 = MAX( 1, Nis0-2) 1286 Njs0 = 1+nn_hls ; Njs1 = Njs0-1 ; Njs2 = MAX( 1, Njs0-2) 1287 ! 1288 Nie0 = jpi-nn_hls ; Nie1 = Nie0+1 ; Nie2 = MIN(jpi, Nie0+2) 1289 Nje0 = jpj-nn_hls ; Nje1 = Nje0+1 ; Nje2 = MIN(jpj, Nje0+2) 1290 ! 1291 IF( nn_hls == 1 ) THEN !* halo size of 1 1292 ! 1293 Nis1nxt2 = Nis0 ; Njs1nxt2 = Njs0 1294 Nie1nxt2 = Nie0 ; Nje1nxt2 = Nje0 1295 ! 1296 ELSE !* larger halo size... 1297 ! 1298 Nis1nxt2 = Nis1 ; Njs1nxt2 = Njs1 1299 Nie1nxt2 = Nie1 ; Nje1nxt2 = Nje1 1300 ! 1302 1301 ENDIF 1303 1302 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca025_like
r12989 r13174 19 19 nn_ksize = 75 ! total number of point in k-direction 20 20 nn_perio = 4 ! periodicity 21 nn_hls = 2 ! halo dimension22 21 / 23 22 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca12_like
r12989 r13174 19 19 nn_ksize = 75 ! total number of point in k-direction 20 20 nn_perio = 4 ! periodicity 21 nn_hls = 2 ! halo dimension22 21 / 23 22 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca1_like
r12989 r13174 19 19 nn_ksize = 75 ! total number of point in k-direction 20 20 nn_perio = 6 ! periodicity 21 nn_hls = 2 ! halo dimension22 21 / 23 22 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/MY_SRC/usrdef_zgr.F90
r12989 r13174 191 191 ! 192 192 z2d(:,:) = REAL( jpkm1 , wp ) ! flat bottom 193 IF( .NOT. (nbondj == 1 .OR. nbondj == 0 .OR. l_Jperio) ) & 194 z2d(mi0( 1 ):mi1(jpiglo),mj0(Njs0):mj1( Njs0 )) = 0._wp ! line number Njs0 at 0 195 IF( .NOT. (nbondi == 1 .OR. nbondi == 0 .OR. l_Iperio) ) & 196 z2d(mi0(Nis0):mi1( Nis0 ),mj0( 1 ):mj1(jpjglo)) = 0._wp ! column number Nis0 at 0 197 ! 198 IF( jperio == 3 .OR. jperio ==4 ) THEN ! add a small island in the upper corners to avoid model instabilities... 199 z2d(mi0( 1):mi1(Nis0+1),mj0(jpjglo-nn_hls-1):mj1(jpjglo)) = 0. 200 z2d(mi0(jpiglo-nn_hls-1):mi1(jpiglo),mj0(jpjglo-nn_hls-1):mj1(jpjglo)) = 0. 201 ENDIF 193 ! 194 ! 195 ! BENCH should work without these 2 small islands on the 2 poles of the folding... 196 ! -> Comment out these lines if instabilities are too large... 197 ! 198 199 !!$ IF( jperio == 3 .OR. jperio == 4 ) THEN ! add a small island in the upper corners to avoid model instabilities... 200 !!$ z2d(mi0( nn_hls):mi1( nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 201 !!$ z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 202 !!$ z2d(mi0(jpiglo/2 ):mi1( jpiglo/2 +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 203 !!$ ENDIF 204 !!$ ! 205 !!$ IF( jperio == 5 .OR. jperio == 6 ) THEN ! add a small island in the upper corners to avoid model instabilities... 206 !!$ z2d(mi0( nn_hls):mi1( nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 207 !!$ z2d(mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 208 !!$ z2d(mi0(jpiglo/2 ):mi1(jpiglo/2 +1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 209 !!$ ENDIF 210 202 211 ! 203 212 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed)
Note: See TracChangeset
for help on using the changeset viewer.