Changeset 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/LBC/lbc_nfd_nogather_generic.h90
- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/lbc_nfd_nogather_generic.h90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r10425 r13463 4 4 # define F_SIZE(ptab) kfld 5 5 # if defined DIM_2d 6 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D),INTENT(inout)::ptab(f) 6 # if defined SINGLE_PRECISION 7 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp),INTENT(inout)::ptab(f) 8 # else 9 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp),INTENT(inout)::ptab(f) 10 # endif 7 11 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 8 12 # define K_SIZE(ptab) 1 … … 10 14 # endif 11 15 # if defined DIM_3d 12 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D),INTENT(inout)::ptab(f) 16 # if defined SINGLE_PRECISION 17 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp),INTENT(inout)::ptab(f) 18 # else 19 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp),INTENT(inout)::ptab(f) 20 # endif 13 21 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 14 22 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) … … 16 24 # endif 17 25 # if defined DIM_4d 18 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab(f) 26 # if defined SINGLE_PRECISION 27 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab(f) 28 # else 29 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab(f) 30 # endif 19 31 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 20 32 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 21 33 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) 22 34 # endif 23 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D),INTENT(inout)::ptab2(f) 35 # if defined SINGLE_PRECISION 36 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp),INTENT(inout)::ptab2(f) 37 # else 38 # define ARRAY2_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp),INTENT(inout)::ptab2(f) 39 # endif 24 40 # define J_SIZE(ptab2) SIZE(ptab2(1)%pt4d,2) 25 41 # define ARRAY2_IN(i,j,k,l,f) ptab2(f)%pt4d(i,j,k,l) … … 44 60 # define L_SIZE(ptab) SIZE(ptab,4) 45 61 # endif 46 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l)47 62 # define J_SIZE(ptab2) SIZE(ptab2,2) 48 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 49 # define ARRAY2_TYPE(i,j,k,l,f) REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 50 #endif 51 63 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l) 64 # if defined SINGLE_PRECISION 65 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 66 # define ARRAY2_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 67 # else 68 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 69 # define ARRAY2_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 70 # endif 71 # endif 72 # ifdef SINGLE_PRECISION 73 # define PRECISION sp 74 # else 75 # define PRECISION dp 76 # endif 52 77 SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld ) 53 78 !!---------------------------------------------------------------------- … … 57 82 !! 58 83 !!---------------------------------------------------------------------- 59 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied60 ARRAY2_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied84 ARRAY_TYPE(:,:,:,:,:) 85 ARRAY2_TYPE(:,:,:,:,:) 61 86 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 62 87 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 63 88 INTEGER, OPTIONAL, INTENT(in ) :: kfld ! number of pt3d arrays 64 89 ! 65 INTEGER :: ji, jj, jk, 66 INTEGER :: ipi, ipj, ipk, ipl, ipf 67 INTEGER :: ijt, iju, ij pj, ijpjp1, ijta, ijua, jia, startloop, endloop90 INTEGER :: ji, jj, jk, jn, ii, jl, jh, jf ! dummy loop indices 91 INTEGER :: ipi, ipj, ipk, ipl, ipf, iij, ijj ! dimension of the input array 92 INTEGER :: ijt, iju, ijta, ijua, jia, startloop, endloop 68 93 LOGICAL :: l_fast_exchanges 69 94 !!---------------------------------------------------------------------- … … 74 99 ! 75 100 ! 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 81 ! 82 ijpj = 1 ! index of first modified line 83 ijpjp1 = 2 ! index + 1 84 101 IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' ) 85 102 ! 2nd dimension determines exchange speed 86 103 IF (ipj == 1 ) THEN … … 99 116 ! 100 117 CASE ( 'T' , 'W' ) ! T-, W-point 101 IF ( nimpp /= 1 ) THEN ; startloop = 1 102 ELSE ; startloop = 2 103 ENDIF 104 ! 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) 118 IF ( nimpp /= 1 ) THEN ; startloop = 1 119 ELSE ; startloop = 1 + nn_hls 120 ENDIF 121 ! 122 DO jl = 1, ipl; DO jk = 1, ipk 123 DO jj = 1, nn_hls 124 ijj = jpj -jj +1 125 DO ji = startloop, jpi 126 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 127 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 128 END DO 109 129 END DO 110 130 END DO; END DO 111 131 IF( nimpp == 1 ) THEN 112 132 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 133 DO jj = 1, nn_hls 134 ijj = jpj -jj +1 135 DO ii = 0, nn_hls-1 136 ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf) 137 END DO 138 END DO 139 END DO; END DO 140 ENDIF 141 ! 142 IF ( .NOT. l_fast_exchanges ) THEN 143 IF( nimpp >= Ni0glo/2+2 ) THEN 119 144 startloop = 1 120 ELSEIF( nimpp+ nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1) THEN121 startloop = jpiglo/2+1 - nimpp + 1122 ELSE 123 startloop = nlci + 1124 ENDIF 125 IF( startloop <= nlci ) THEN145 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 146 startloop = Ni0glo/2+2 - nimpp + nn_hls 147 ELSE 148 startloop = jpi + 1 149 ENDIF 150 IF( startloop <= jpi ) THEN 126 151 DO jl = 1, ipl; DO jk = 1, ipk 127 DO ji = startloop, nlci128 ijt = jpiglo - ji - nimpp - nfi impp(isendto(1),jpnj) + 4152 DO ji = startloop, jpi 153 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 129 154 jia = ji + nimpp - 1 130 155 ijta = jpiglo - jia + 2 131 156 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)157 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 133 158 ELSE 134 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)159 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 135 160 ENDIF 136 161 END DO … … 138 163 ENDIF 139 164 ENDIF 140 141 165 CASE ( 'U' ) ! U-point 142 IF( nimpp + nlci - 1 /= jpiglo ) THEN143 endloop = nlci166 IF( nimpp + jpi - 1 /= jpiglo ) THEN 167 endloop = jpi 144 168 ELSE 145 endloop = nlci - 1 146 ENDIF 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) 169 endloop = jpi - nn_hls 170 ENDIF 171 DO jl = 1, ipl; DO jk = 1, ipk 172 DO jj = 1, nn_hls 173 ijj = jpj -jj +1 174 DO ji = 1, endloop 175 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 176 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 177 END DO 151 178 END DO 152 179 END DO; END DO 153 180 IF (nimpp .eq. 1) THEN 154 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 155 ENDIF 156 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 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 181 DO jj = 1, nn_hls 182 ijj = jpj -jj +1 183 DO ii = 0, nn_hls-1 184 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 185 END DO 186 END DO 187 ENDIF 188 IF((nimpp + jpi - 1) .eq. jpiglo) THEN 189 DO jj = 1, nn_hls 190 ijj = jpj -jj +1 191 DO ii = 1, nn_hls 192 ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 193 END DO 194 END DO 195 ENDIF 196 ! 197 IF ( .NOT. l_fast_exchanges ) THEN 198 IF( nimpp + jpi - 1 /= jpiglo ) THEN 199 endloop = jpi 200 ELSE 201 endloop = jpi - nn_hls 202 ENDIF 203 IF( nimpp >= Ni0glo/2+1 ) THEN 204 startloop = nn_hls 205 ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN 206 startloop = Ni0glo/2+1 - nimpp + nn_hls 170 207 ELSE 171 208 startloop = endloop + 1 … … 174 211 DO jl = 1, ipl; DO jk = 1, ipk 175 212 DO ji = startloop, endloop 176 iju = jpiglo - ji - nimpp - nfi impp(isendto(1),jpnj) + 3177 jia = ji + nimpp - 1 178 ijua = jpiglo - jia + 1 213 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 214 jia = ji + nimpp - 1 215 ijua = jpiglo - jia + 1 179 216 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)217 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl,jf) 181 218 ELSE 182 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)219 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 183 220 ENDIF 184 221 END DO … … 189 226 CASE ( 'V' ) ! V-point 190 227 IF( nimpp /= 1 ) THEN 191 startloop = 1 228 startloop = 1 192 229 ELSE 193 startloop = 2 194 ENDIF 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) 230 startloop = 1 + nn_hls 231 ENDIF 232 IF ( .NOT. l_fast_exchanges ) THEN 233 DO jl = 1, ipl; DO jk = 1, ipk 234 DO jj = 2, nn_hls+1 235 ijj = jpj -jj +1 236 DO ji = startloop, jpi 237 ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 238 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 239 END DO 240 END DO 241 END DO; END DO 242 ENDIF 243 DO jl = 1, ipl; DO jk = 1, ipk 244 DO ji = startloop, jpi 245 ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 246 ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 207 247 END DO 208 248 END DO; END DO 209 249 IF (nimpp .eq. 1) THEN 210 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf) 250 DO jj = 1, nn_hls 251 ijj = jpj-jj+1 252 DO ii = 0, nn_hls-1 253 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf) 254 END DO 255 END DO 211 256 ENDIF 212 257 CASE ( 'F' ) ! F-point 213 IF( nimpp + nlci - 1 /= jpiglo ) THEN214 endloop = nlci258 IF( nimpp + jpi - 1 /= jpiglo ) THEN 259 endloop = jpi 215 260 ELSE 216 endloop = nlci - 1 217 ENDIF 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 261 endloop = jpi - nn_hls 262 ENDIF 263 IF ( .NOT. l_fast_exchanges ) THEN 264 DO jl = 1, ipl; DO jk = 1, ipk 265 DO jj = 2, nn_hls+1 266 ijj = jpj -jj +1 267 DO ji = 1, endloop 268 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 269 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 270 END DO 271 END DO 224 272 END DO; END DO 225 273 ENDIF 226 274 DO jl = 1, ipl; DO jk = 1, ipk 227 275 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 232 IF (nimpp .eq. 1) THEN 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) 236 ENDIF 237 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 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 ! 243 END SELECT 276 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 277 ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 278 END DO 279 END DO; END DO 280 IF (nimpp .eq. 1) THEN 281 DO ii = 1, nn_hls 282 ARRAY_IN(ii,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf) 283 END DO 284 IF ( .NOT. l_fast_exchanges ) THEN 285 DO jj = 1, nn_hls 286 ijj = jpj -jj 287 DO ii = 0, nn_hls-1 288 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 289 END DO 290 END DO 291 ENDIF 292 ENDIF 293 IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN 294 DO ii = 1, nn_hls 295 ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf) 296 END DO 297 IF ( .NOT. l_fast_exchanges ) THEN 298 DO jj = 1, nn_hls 299 ijj = jpj -jj 300 DO ii = 1, nn_hls 301 ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 302 END DO 303 END DO 304 ENDIF 305 ENDIF 306 ! 307 END SELECT 244 308 ! 245 309 CASE ( 5, 6 ) ! * North fold F-point pivot … … 248 312 CASE ( 'T' , 'W' ) ! T-, W-point 249 313 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 314 DO jj = 1, nn_hls 315 ijj = jpj-jj+1 316 DO ji = 1, jpi 317 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 318 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 319 END DO 320 END DO 254 321 END DO; END DO 255 322 ! 256 323 CASE ( 'U' ) ! U-point 257 IF( nimpp + nlci - 1 /= jpiglo ) THEN258 endloop = nlci324 IF( nimpp + jpi - 1 /= jpiglo ) THEN 325 endloop = jpi 259 326 ELSE 260 endloop = nlci - 1 261 ENDIF 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 268 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 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) 327 endloop = jpi - nn_hls 328 ENDIF 329 DO jl = 1, ipl; DO jk = 1, ipk 330 DO jj = 1, nn_hls 331 ijj = jpj-jj+1 332 DO ji = 1, endloop 333 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 334 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 335 END DO 336 END DO 337 END DO; END DO 338 IF(nimpp + jpi - 1 .eq. jpiglo) THEN 339 DO jl = 1, ipl; DO jk = 1, ipk 340 DO jj = 1, nn_hls 341 ijj = jpj-jj+1 342 DO ii = 1, nn_hls 343 iij = jpi-ii+1 344 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf) 345 END DO 346 END DO 271 347 END DO; END DO 272 348 ENDIF … … 274 350 CASE ( 'V' ) ! V-point 275 351 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) 352 DO jj = 1, nn_hls 353 ijj = jpj -jj +1 354 DO ji = 1, jpi 355 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 356 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 357 END DO 279 358 END DO 280 359 END DO; END DO 281 360 282 361 IF ( .NOT. l_fast_exchanges ) THEN 283 IF( nimpp >= jpiglo/2+1) THEN362 IF( nimpp >= Ni0glo/2+2 ) THEN 284 363 startloop = 1 285 ELSEIF( nimpp+ nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1) THEN286 startloop = jpiglo/2+1 - nimpp + 1287 ELSE 288 startloop = nlci + 1289 ENDIF 290 IF( startloop <= nlci ) THEN291 DO jl = 1, ipl; DO jk = 1, ipk 292 DO ji = startloop, nlci293 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3294 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)295 END DO364 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 365 startloop = Ni0glo/2+2 - nimpp + nn_hls 366 ELSE 367 startloop = jpi + 1 368 ENDIF 369 IF( startloop <= jpi ) THEN 370 DO jl = 1, ipl; DO jk = 1, ipk 371 DO ji = startloop, jpi 372 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 373 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 374 END DO 296 375 END DO; END DO 297 376 ENDIF … … 299 378 ! 300 379 CASE ( 'F' ) ! F-point 301 IF( nimpp + nlci - 1 /= jpiglo ) THEN302 endloop = nlci380 IF( nimpp + jpi - 1 /= jpiglo ) THEN 381 endloop = jpi 303 382 ELSE 304 endloop = nlci - 1 305 ENDIF 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 312 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 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 383 endloop = jpi - nn_hls 384 ENDIF 385 DO jl = 1, ipl; DO jk = 1, ipk 386 DO jj = 1, nn_hls 387 ijj = jpj -jj +1 388 DO ji = 1, endloop 389 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 390 ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 391 END DO 392 END DO 393 END DO; END DO 394 IF((nimpp + jpi - 1) .eq. jpiglo) THEN 395 DO jl = 1, ipl; DO jk = 1, ipk 396 DO jj = 1, nn_hls 397 ijj = jpj -jj +1 398 DO ii = 1, nn_hls 399 iij = jpi -ii+1 400 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf) 401 END DO 402 END DO 403 END DO; END DO 404 ENDIF 405 ! 406 IF ( .NOT. l_fast_exchanges ) THEN 407 IF( nimpp + jpi - 1 /= jpiglo ) THEN 408 endloop = jpi 409 ELSE 410 endloop = jpi - nn_hls 411 ENDIF 412 IF( nimpp >= Ni0glo/2+2 ) THEN 413 startloop = 1 414 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 415 startloop = Ni0glo/2+2 - nimpp + nn_hls 328 416 ELSE 329 417 startloop = endloop + 1 … … 332 420 DO jl = 1, ipl; DO jk = 1, ipk 333 421 DO ji = startloop, endloop 334 iju = jpiglo - ji - nimpp - nfi impp(isendto(1),jpnj) + 2335 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)422 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 423 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 336 424 END DO 337 425 END DO; END DO … … 349 437 END DO ! End jf loop 350 438 END SUBROUTINE ROUTINE_NFD 439 #undef PRECISION 351 440 #undef ARRAY_TYPE 352 441 #undef ARRAY_IN
Note: See TracChangeset
for help on using the changeset viewer.
