Changeset 10425 for NEMO/trunk/src/OCE/LBC/lbc_nfd_nogather_generic.h90
- Timestamp:
- 2018-12-19T22:54:16+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r10068 r10425 8 8 # define K_SIZE(ptab) 1 9 9 # define L_SIZE(ptab) 1 10 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_2D),INTENT(inout)::ptab2(f)11 # define ARRAY2_IN(i,j,k,l,f) ptab2(f)%pt2d(i,j)12 10 # endif 13 11 # if defined DIM_3d … … 16 14 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) 17 15 # define L_SIZE(ptab) 1 18 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_3D),INTENT(inout)::ptab2(f)19 # define ARRAY2_IN(i,j,k,l,f) ptab2(f)%pt3d(i,j,k)20 16 # endif 21 17 # if defined DIM_4d … … 24 20 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 25 21 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) 26 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab2(f) 27 # define ARRAY2_IN(i,j,k,l,f) ptab2(f)%pt4d(i,j,k,l) 28 # endif 22 # endif 23 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab2(f) 24 # define J_SIZE(ptab2) SIZE(ptab2(1)%pt4d,2) 25 # define ARRAY2_IN(i,j,k,l,f) ptab2(f)%pt4d(i,j,k,l) 29 26 #else 30 27 ! !== IN: ptab is an array ==! … … 36 33 # define K_SIZE(ptab) 1 37 34 # define L_SIZE(ptab) 1 38 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j)39 35 # endif 40 36 # if defined DIM_3d … … 42 38 # define K_SIZE(ptab) SIZE(ptab,3) 43 39 # define L_SIZE(ptab) 1 44 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k)45 40 # endif 46 41 # if defined DIM_4d … … 48 43 # define K_SIZE(ptab) SIZE(ptab,3) 49 44 # define L_SIZE(ptab) SIZE(ptab,4) 50 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l) 51 # endif 45 # endif 46 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l) 47 # define J_SIZE(ptab2) SIZE(ptab2,2) 52 48 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 53 49 # define ARRAY2_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) … … 69 65 INTEGER :: ji, jj, jk, jl, jh, jf ! dummy loop indices 70 66 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 71 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 67 INTEGER :: ijt, iju, ijpj, ijpjp1, ijta, ijua, jia, startloop, endloop 68 LOGICAL :: l_fast_exchanges 72 69 !!---------------------------------------------------------------------- 73 ipk = K_SIZE(ptab) ! 3rd dimension 70 ipj = J_SIZE(ptab2) ! 2nd dimension of input array 71 ipk = K_SIZE(ptab) ! 3rd dimension of output array 74 72 ipl = L_SIZE(ptab) ! 4th - 75 73 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 76 74 ! 75 ! Security check for further developments 76 IF ( ipf > 1 ) THEN 77 write(6,*) 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation' 78 write(6,*) 'You should not be there...' 79 STOP 80 ENDIF 77 81 ! 78 SELECT CASE ( jpni ) 79 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 80 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 81 END SELECT 82 ijpjm1 = ijpj-1 83 ! 82 ijpj = 1 ! index of first modified line 83 ijpjp1 = 2 ! index + 1 84 85 ! 2nd dimension determines exchange speed 86 IF (ipj == 1 ) THEN 87 l_fast_exchanges = .TRUE. 88 ELSE 89 l_fast_exchanges = .FALSE. 90 ENDIF 84 91 ! 85 92 DO jf = 1, ipf ! Loop over the number of arrays to be processed … … 96 103 ENDIF 97 104 ! 98 DO ji = startloop, nlci 99 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 100 ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 101 END DO 105 DO jl = 1, ipl; DO jk = 1, ipk 106 DO ji = startloop, nlci 107 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 108 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 109 END DO 110 END DO; END DO 102 111 IF( nimpp == 1 ) THEN 103 ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-2,:,:,jf) 104 ENDIF 105 ! 106 IF( nimpp >= jpiglo/2+1 ) THEN 107 startloop = 1 108 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 109 startloop = jpiglo/2+1 - nimpp + 1 110 ELSE 111 startloop = nlci + 1 112 ENDIF 113 IF( startloop <= nlci ) THEN 114 DO ji = startloop, nlci 115 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 116 jia = ji + nimpp - 1 117 ijta = jpiglo - jia + 2 118 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 119 ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,ijpjm1,:,:,jf) 120 ELSE 121 ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf) 122 ENDIF 123 END DO 124 ENDIF 125 ! 112 DO jl = 1, ipl; DO jk = 1, ipk 113 ARRAY_IN(1,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-2,jk,jl,jf) 114 END DO; END DO 115 ENDIF 116 ! 117 IF ( .NOT. l_fast_exchanges ) THEN 118 IF( nimpp >= jpiglo/2+1 ) THEN 119 startloop = 1 120 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 121 startloop = jpiglo/2+1 - nimpp + 1 122 ELSE 123 startloop = nlci + 1 124 ENDIF 125 IF( startloop <= nlci ) THEN 126 DO jl = 1, ipl; DO jk = 1, ipk 127 DO ji = startloop, nlci 128 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 129 jia = ji + nimpp - 1 130 ijta = jpiglo - jia + 2 131 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 132 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-1,jk,jl,jf) 133 ELSE 134 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 135 ENDIF 136 END DO 137 END DO; END DO 138 ENDIF 139 ENDIF 140 126 141 CASE ( 'U' ) ! U-point 127 142 IF( nimpp + nlci - 1 /= jpiglo ) THEN … … 130 145 endloop = nlci - 1 131 146 ENDIF 132 DO ji = 1, endloop 133 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 134 ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf) 135 END DO 147 DO jl = 1, ipl; DO jk = 1, ipk 148 DO ji = 1, endloop 149 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 150 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 151 END DO 152 END DO; END DO 136 153 IF (nimpp .eq. 1) THEN 137 ARRAY_IN( 1 ,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ijpj-2,:,:,jf)154 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 138 155 ENDIF 139 156 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 140 ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf) 141 ENDIF 142 ! 143 IF( nimpp + nlci - 1 /= jpiglo ) THEN 144 endloop = nlci 145 ELSE 146 endloop = nlci - 1 147 ENDIF 148 IF( nimpp >= jpiglo/2 ) THEN 149 startloop = 1 150 ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 151 startloop = jpiglo/2 - nimpp + 1 152 ELSE 153 startloop = endloop + 1 154 ENDIF 155 IF( startloop <= endloop ) THEN 156 DO ji = startloop, endloop 157 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 158 jia = ji + nimpp - 1 159 ijua = jpiglo - jia + 1 160 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 161 ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,ijpjm1,:,:,jf) 162 ELSE 163 ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf) 164 ENDIF 165 END DO 157 ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 158 ENDIF 159 ! 160 IF ( .NOT. l_fast_exchanges ) THEN 161 IF( nimpp + nlci - 1 /= jpiglo ) THEN 162 endloop = nlci 163 ELSE 164 endloop = nlci - 1 165 ENDIF 166 IF( nimpp >= jpiglo/2 ) THEN 167 startloop = 1 168 ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 169 startloop = jpiglo/2 - nimpp + 1 170 ELSE 171 startloop = endloop + 1 172 ENDIF 173 IF( startloop <= endloop ) THEN 174 DO jl = 1, ipl; DO jk = 1, ipk 175 DO ji = startloop, endloop 176 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 177 jia = ji + nimpp - 1 178 ijua = jpiglo - jia + 1 179 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 180 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-1,jk,jl,jf) 181 ELSE 182 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 183 ENDIF 184 END DO 185 END DO; END DO 186 ENDIF 166 187 ENDIF 167 188 ! … … 172 193 startloop = 2 173 194 ENDIF 174 DO ji = startloop, nlci 175 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 176 ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 177 ARRAY_IN(ji,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-3,:,:,jf) 178 END DO 195 IF ( .NOT. l_fast_exchanges ) THEN 196 DO jl = 1, ipl; DO jk = 1, ipk 197 DO ji = startloop, nlci 198 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 199 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 200 END DO 201 END DO; END DO 202 ENDIF 203 DO jl = 1, ipl; DO jk = 1, ipk 204 DO ji = startloop, nlci 205 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 206 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 207 END DO 208 END DO; END DO 179 209 IF (nimpp .eq. 1) THEN 180 ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-3,:,:,jf)210 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf) 181 211 ENDIF 182 212 CASE ( 'F' ) ! F-point … … 186 216 endloop = nlci - 1 187 217 ENDIF 188 DO ji = 1, endloop 189 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 190 ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf) 191 ARRAY_IN(ji,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-3,:,:,jf) 192 END DO 218 IF ( .NOT. l_fast_exchanges ) THEN 219 DO jl = 1, ipl; DO jk = 1, ipk 220 DO ji = 1, endloop 221 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 222 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 223 END DO 224 END DO; END DO 225 ENDIF 226 DO jl = 1, ipl; DO jk = 1, ipk 227 DO ji = 1, endloop 228 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 229 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 230 END DO 231 END DO; END DO 193 232 IF (nimpp .eq. 1) THEN 194 ARRAY_IN( 1 ,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ijpj-3,:,:,jf) 195 ARRAY_IN( 1 ,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ijpj-2,:,:,jf) 233 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-3,:,:,jf) 234 IF ( .NOT. l_fast_exchanges ) & 235 ARRAY_IN(1,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 196 236 ENDIF 197 237 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 198 ARRAY_IN(nlci,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-3,:,:,jf) 199 ARRAY_IN(nlci,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf) 200 ENDIF 201 ! 202 CASE ( 'I' ) ! ice U-V point (I-point) 203 IF( nimpp /= 1 ) THEN 204 startloop = 1 205 ELSE 206 startloop = 3 207 ARRAY_IN(2,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(3,ijpjm1,:,:,jf) 208 ENDIF 209 DO ji = startloop, nlci 210 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 211 ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf) 212 END DO 238 ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-3,:,:,jf) 239 IF ( .NOT. l_fast_exchanges ) & 240 ARRAY_IN(nlci,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 241 ENDIF 242 ! 213 243 END SELECT 214 244 ! … … 217 247 SELECT CASE ( NAT_IN(jf) ) 218 248 CASE ( 'T' , 'W' ) ! T-, W-point 219 DO ji = 1, nlci 220 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 221 ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-1,:,:,jf) 222 END DO 249 DO jl = 1, ipl; DO jk = 1, ipk 250 DO ji = 1, nlci 251 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 252 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 253 END DO 254 END DO; END DO 223 255 ! 224 256 CASE ( 'U' ) ! U-point … … 228 260 endloop = nlci - 1 229 261 ENDIF 230 DO ji = 1, endloop 231 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 232 ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,:,:,jf) 233 END DO 262 DO jl = 1, ipl; DO jk = 1, ipk 263 DO ji = 1, endloop 264 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 265 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 266 END DO 267 END DO; END DO 234 268 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 235 ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-1,:,:,jf) 269 DO jl = 1, ipl; DO jk = 1, ipk 270 ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf) 271 END DO; END DO 236 272 ENDIF 237 273 ! 238 274 CASE ( 'V' ) ! V-point 239 DO ji = 1, nlci 240 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 241 ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf) 242 END DO 243 ! 244 IF( nimpp >= jpiglo/2+1 ) THEN 245 startloop = 1 246 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 247 startloop = jpiglo/2+1 - nimpp + 1 248 ELSE 249 startloop = nlci + 1 250 ENDIF 251 IF( startloop <= nlci ) THEN 252 DO ji = startloop, nlci 253 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 254 ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf) 255 END DO 275 DO jl = 1, ipl; DO jk = 1, ipk 276 DO ji = 1, nlci 277 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 278 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 279 END DO 280 END DO; END DO 281 282 IF ( .NOT. l_fast_exchanges ) THEN 283 IF( nimpp >= jpiglo/2+1 ) THEN 284 startloop = 1 285 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 286 startloop = jpiglo/2+1 - nimpp + 1 287 ELSE 288 startloop = nlci + 1 289 ENDIF 290 IF( startloop <= nlci ) THEN 291 DO jl = 1, ipl; DO jk = 1, ipk 292 DO ji = startloop, nlci 293 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 294 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 295 END DO 296 END DO; END DO 297 ENDIF 256 298 ENDIF 257 299 ! … … 262 304 endloop = nlci - 1 263 305 ENDIF 264 DO ji = 1, endloop 265 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 266 ARRAY_IN(ji,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf) 267 END DO 306 DO jl = 1, ipl; DO jk = 1, ipk 307 DO ji = 1, endloop 308 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 309 ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 310 END DO 311 END DO; END DO 268 312 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 269 ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-2,:,:,jf) 270 ENDIF 271 ! 272 IF( nimpp + nlci - 1 /= jpiglo ) THEN 273 endloop = nlci 274 ELSE 275 endloop = nlci - 1 276 ENDIF 277 IF( nimpp >= jpiglo/2+1 ) THEN 278 startloop = 1 279 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 280 startloop = jpiglo/2+1 - nimpp + 1 281 ELSE 282 startloop = endloop + 1 283 ENDIF 284 IF( startloop <= endloop ) THEN 285 DO ji = startloop, endloop 286 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 287 ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf) 288 END DO 289 ENDIF 290 ! 291 CASE ( 'I' ) ! ice U-V point (I-point) 292 IF( nimpp /= 1 ) THEN 293 startloop = 1 294 ELSE 295 startloop = 2 296 ENDIF 297 IF( nimpp + nlci - 1 /= jpiglo ) THEN 298 endloop = nlci 299 ELSE 300 endloop = nlci - 1 301 ENDIF 302 DO ji = startloop , endloop 303 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 304 ARRAY_IN(ji,ijpj,:,:,jf) = 0.5 * (ARRAY_IN(ji,ijpjm1,:,:,jf) + SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)) 305 END DO 313 DO jl = 1, ipl; DO jk = 1, ipk 314 ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-2,jk,jl,jf) 315 END DO; END DO 316 ENDIF 317 ! 318 IF ( .NOT. l_fast_exchanges ) THEN 319 IF( nimpp + nlci - 1 /= jpiglo ) THEN 320 endloop = nlci 321 ELSE 322 endloop = nlci - 1 323 ENDIF 324 IF( nimpp >= jpiglo/2+1 ) THEN 325 startloop = 1 326 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 327 startloop = jpiglo/2+1 - nimpp + 1 328 ELSE 329 startloop = endloop + 1 330 ENDIF 331 IF( startloop <= endloop ) THEN 332 DO jl = 1, ipl; DO jk = 1, ipk 333 DO ji = startloop, endloop 334 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 335 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 336 END DO 337 END DO; END DO 338 ENDIF 339 ENDIF 306 340 ! 307 341 END SELECT … … 309 343 CASE DEFAULT ! * closed : the code probably never go through 310 344 ! 311 SELECT CASE ( NAT_IN(jf)) 312 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 313 ARRAY_IN(:, 1 ,:,:,jf) = 0._wp 314 ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 315 CASE ( 'F' ) ! F-point 316 ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 317 CASE ( 'I' ) ! ice U-V point 318 ARRAY_IN(:, 1 ,:,:,jf) = 0._wp 319 ARRAY_IN(:,ijpj,:,:,jf) = 0._wp 320 END SELECT 345 WRITE(*,*) 'lbc_nfd_nogather_generic: You should not have seen this print! error?', npolj 321 346 ! 322 347 END SELECT ! npolj … … 328 353 #undef NAT_IN 329 354 #undef SGN_IN 355 #undef J_SIZE 330 356 #undef K_SIZE 331 357 #undef L_SIZE
Note: See TracChangeset
for help on using the changeset viewer.
