Changeset 12719
- Timestamp:
- 2020-04-08T17:45:31+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/halo_mng.F90
r12586 r12719 27 27 INTEGER :: jpimax_1, jpjmax_1 28 28 INTEGER :: nlci_1, nlcj_1 29 INTEGER :: jplbi_1, jplbj_1 29 INTEGER :: nldi_1, nldj_1 30 INTEGER :: nlei_1, nlej_1 30 31 CONTAINS 31 32 … … 38 39 nlcj_1 = nlcj 39 40 40 jplbi_1 = 1 41 jplbj_1 = 1 42 43 jplbi = 1 44 jplbj = 1 41 nldi_1 = nldi 42 nldj_1 = nldj 45 43 46 jpimax_1 = jpimax 47 jpjmax_1 = jpjmax 44 nlei_1 = nlei 45 nlej_1 = nlej 46 47 jpimax_1 = jpimax 48 jpjmax_1 = jpjmax 48 49 49 50 END SUBROUTINE halo_mng_init … … 54 55 55 56 nn_hls = khls 56 jpi = jpi_1 + khls -157 jpj = jpj_1 + khls -158 57 59 nlci = nlci_1 + khls -1 60 nlcj = nlcj_1 + khls -1 58 jpi = jpi_1 + 2*khls -2 59 jpj = jpj_1 + 2*khls -2 60 61 nlci = nlci_1 + 2*khls -2 62 nlcj = nlcj_1 + 2*khls -2 61 63 62 jplbi = jplbi_1 - khls +1 63 jplbj = jplbj_1 - khls +1 64 65 jpimax = jpimax_1 + khls -1 66 jpjmax = jpjmax_1 + khls -1 64 jpimax = jpimax_1 + 2*khls -2 65 jpjmax = jpjmax_1 + 2*khls -2 66 67 nldi = nldi_1 + khls - 1 68 nldj = nldj_1 + khls - 1 69 70 nlei = nlei_1 + khls - 1 71 nlej = nlej_1 + khls - 1 67 72 68 73 END SUBROUTINE halo_mng_set … … 76 81 REAL(wp), POINTER, DIMENSION(:,:) :: zpta 77 82 INTEGER :: offset 78 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j83 INTEGER :: pta_size_i, pta_size_j 79 84 80 85 pta_size_i = SIZE(pta,1) 81 86 pta_size_j = SIZE(pta,2) 82 exp_size_i = jpi - jplbi + 183 exp_size_j = jpj - jplbj + 184 87 85 88 ! check if the current size of pta is equal to the current expected dimension 86 IF (pta_size_i .ne. exp_size_i) THEN87 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj))88 offset = (exp_size_i - pta_size_i) / 289 IF (pta_size_i .ne. jpi) THEN 90 ALLOCATE (zpta(jpi, jpj)) 91 offset = abs((jpi - pta_size_i) / 2) 89 92 90 IF (pta_size_i .lt. exp_size_i) THEN91 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1) = pta93 IF (pta_size_i .lt. jpi) THEN 94 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta 92 95 ELSE 93 zpta = pta( jplbi : jpi, jplbj :jpj)96 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj) 94 97 END IF 95 98 CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) … … 108 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta 109 112 INTEGER :: offset 110 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j113 INTEGER :: pta_size_i, pta_size_j 111 114 112 115 pta_size_i = SIZE(pta,1) 113 116 pta_size_j = SIZE(pta,2) 114 exp_size_i = jpi - jplbi + 1115 exp_size_j = jpj - jplbj + 1116 117 117 118 ! check if the current size of pta is equal to the current expected dimension 118 IF (pta_size_i .ne. exp_size_i) THEN119 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj, jpk))120 offset = (exp_size_i - pta_size_i) / 2119 IF (pta_size_i .ne. jpi) THEN 120 ALLOCATE (zpta(jpi, jpj, jpk)) 121 offset = abs((jpi - pta_size_i) / 2) 121 122 122 IF (pta_size_i .lt. exp_size_i) THEN123 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :) = pta123 IF (pta_size_i .lt. jpi) THEN 124 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta 124 125 ELSE 125 zpta = pta( jplbi : jpi, jplbj :jpj, :)126 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :) 126 127 END IF 127 128 CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) … … 141 142 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta 142 143 INTEGER :: offset 143 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j144 INTEGER :: pta_size_i, pta_size_j 144 145 145 146 pta_size_i = SIZE(pta,1) 146 147 pta_size_j = SIZE(pta,2) 147 exp_size_i = jpi - jplbi + 1148 exp_size_j = jpj - jplbj + 1149 148 150 149 ! check if the current size of pta is equal to the current expected dimension 151 IF (pta_size_i .ne. exp_size_i) THEN152 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj, jpk, jpt))153 offset = (exp_size_i - pta_size_i) / 2150 IF (pta_size_i .ne. jpi) THEN 151 ALLOCATE (zpta(jpi, jpj, jpk, jpt)) 152 offset = abs((jpi - pta_size_i) / 2) 154 153 155 IF (pta_size_i .lt. exp_size_i) THEN156 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :) = pta154 IF (pta_size_i .lt. jpi) THEN 155 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta 157 156 ELSE 158 zpta = pta( jplbi : jpi, jplbj :jpj, :, :)157 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :) 159 158 END IF 160 159 CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval) … … 175 174 REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta 176 175 INTEGER :: offset 177 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j176 INTEGER :: pta_size_i, pta_size_j 178 177 179 178 pta_size_i = SIZE(pta,1) 180 179 pta_size_j = SIZE(pta,2) 181 exp_size_i = jpi - jplbi + 1182 exp_size_j = jpj - jplbj + 1183 180 184 181 ! check if the current size of pta is equal to the current expected dimension 185 IF (pta_size_i .ne. exp_size_i) THEN186 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj, jpk, kjpt, jpt))187 offset = (exp_size_i - pta_size_i) / 2182 IF (pta_size_i .ne. jpi) THEN 183 ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt)) 184 offset = abs((jpi - pta_size_i) / 2) 188 185 189 IF (pta_size_i .lt. exp_size_i) THEN190 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :, :) = pta186 IF (pta_size_i .lt. jpi) THEN 187 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta 191 188 ELSE 192 zpta = pta( jplbi : jpi, jplbj :jpj, :, :, :)189 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :) 193 190 END IF 194 191 CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r12601 r12719 57 57 !! 58 58 !!---------------------------------------------------------------------- 59 ARRAY_TYPE( 1-nn_hls+1:,1-nn_hls+1:,:,:,:)60 ARRAY2_TYPE( 1-nn_hls+1:,:,:,:,:)59 ARRAY_TYPE(:,:,:,:,:) 60 ARRAY2_TYPE(:,:,:,:,:) 61 61 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 62 62 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary … … 91 91 ! 92 92 CASE ( 'T' , 'W' ) ! T-, W-point 93 IF ( nimpp - nn_hls+1 /= 1 ) THEN ; startloop = 1 - nn_hls + 194 ELSE ; startloop = 293 IF ( nimpp /= 1 ) THEN ; startloop = 1 94 ELSE ; startloop = 1 + nn_hls 95 95 ENDIF 96 96 ! 97 97 DO jl = 1, ipl; DO jk = 1, ipk 98 98 DO jj = 1, nn_hls 99 ijj = nlcj -jj +1 100 DO ji = startloop, nlci 101 ijt = jpiglo - (ji + nimpp-nn_hls+1 ) - nfiimpp(isendto(1),jpnj) + 4 102 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 103 END DO 104 END DO 105 END DO; END DO 106 IF( nimpp == 1 ) THEN 107 DO jl = 1, ipl; DO jk = 1, ipk 108 DO jj = 1, nn_hls 99 109 ijj = nlcj -jj +1 100 DO ji = startloop, nlci 101 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 102 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 103 END DO 104 END DO 105 END DO; END DO 106 IF( nimpp - nn_hls+1 == 1 ) THEN 107 DO jl = 1, ipl; DO jk = 1, ipk 108 DO jj = 1, nn_hls 109 ijj = nlcj -jj +1 110 DO ii = 1, nn_hls 111 ARRAY_IN(1-ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,jk,jl,jf) 112 END DO 113 END DO 110 DO ii = 0, nn_hls-1 111 ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,nlcj-2*nn_hls+jj-1,jk,jl,jf) 112 END DO 113 END DO 114 114 END DO; END DO 115 115 ENDIF 116 116 ! 117 117 IF ( .NOT. l_fast_exchanges ) THEN 118 IF( nimpp - nn_hls +1>= jpiglo/2+1 ) THEN119 startloop = 1 - nn_hls +1120 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp - nn_hls +1< jpiglo/2+1 ) THEN118 IF( nimpp >= jpiglo/2+1 ) THEN 119 startloop = 1 120 ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 121 121 startloop = jpiglo/2+1 - nimpp + nn_hls 122 122 ELSE … … 126 126 DO jl = 1, ipl; DO jk = 1, ipk 127 127 DO ji = startloop, nlci 128 ijt = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 4129 jia = ji + nimpp - 1128 ijt = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 129 jia = ji + nimpp -nn_hls 130 130 ijta = jpiglo - jia + 2 131 131 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 132 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+ 1,nlcj-nn_hls,jk,jl,jf)132 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf) 133 133 ELSE 134 134 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) … … 139 139 ENDIF 140 140 CASE ( 'U' ) ! U-point 141 IF( nimpp + nlci - nn_hls/= jpiglo ) THEN141 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 142 142 endloop = nlci 143 143 ELSE … … 145 145 ENDIF 146 146 DO jl = 1, ipl; DO jk = 1, ipk 147 148 149 DO ji = 1-nn_hls+1, endloop150 iju = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 3151 152 153 END DO 154 END DO; END DO 155 IF (nimpp - nn_hls+1.eq. 1) THEN156 157 158 DO ii = 1, nn_hls159 ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls+jj-1,:,:,jf)160 161 162 ENDIF 163 IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN164 165 166 167 168 169 170 ENDIF 171 ! 172 IF ( .NOT. l_fast_exchanges ) THEN 173 IF( nimpp + nlci - nn_hls/= jpiglo ) THEN147 DO jj = 1, nn_hls 148 ijj = nlcj -jj +1 149 DO ji = 1, endloop 150 iju = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 3 151 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 152 END DO 153 END DO 154 END DO; END DO 155 IF (nimpp .eq. 1) THEN 156 DO jj = 1, nn_hls 157 ijj = nlcj -jj +1 158 DO ii = 0, nn_hls-1 159 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls+jj-1,:,:,jf) 160 END DO 161 END DO 162 ENDIF 163 IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN 164 DO jj = 1, nn_hls 165 ijj = nlcj -jj +1 166 DO ii = 1, nn_hls 167 ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 168 END DO 169 END DO 170 ENDIF 171 ! 172 IF ( .NOT. l_fast_exchanges ) THEN 173 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 174 174 endloop = nlci 175 175 ELSE 176 176 endloop = nlci - nn_hls 177 177 ENDIF 178 IF( nimpp - nn_hls+1>= jpiglo/2 ) THEN179 startloop = 1 - nn_hls + 1180 ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp - nn_hls+1< jpiglo/2 ) ) THEN181 startloop = jpiglo/2 - nimpp + nn_hls178 IF( nimpp >= jpiglo/2 ) THEN 179 startloop = 1 180 ELSEIF( ( nimpp + nlci - 2*nn_hls+1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 181 startloop = jpiglo/2 - (nimpp -nn_hls+1) +1 182 182 ELSE 183 183 startloop = endloop + 1 … … 186 186 DO jl = 1, ipl; DO jk = 1, ipk 187 187 DO ji = startloop, endloop 188 iju = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 3189 jia = ji + nimpp - 1188 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 189 jia = ji + nimpp -nn_hls 190 190 ijua = jpiglo - jia + 1 191 191 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 192 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+ 1,nlcj-nn_hls,jk,jl,jf)192 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf) 193 193 ELSE 194 194 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) … … 200 200 ! 201 201 CASE ( 'V' ) ! V-point 202 IF( nimpp - nn_hls+1/= 1 ) THEN203 startloop = 1 - nn_hls + 1202 IF( nimpp /= 1 ) THEN 203 startloop = 1 204 204 ELSE 205 startloop = 2206 ENDIF 207 IF ( .NOT. l_fast_exchanges ) THEN 208 DO jl = 1, ipl; DO jk = 1, ipk 209 210 205 startloop = 1 + nn_hls 206 ENDIF 207 IF ( .NOT. l_fast_exchanges ) THEN 208 DO jl = 1, ipl; DO jk = 1, ipk 209 DO jj = 2, nn_hls+1 210 ijj = nlcj -jj +1 211 211 DO ji = startloop, nlci 212 ijt=jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 4213 212 ijt=jpiglo - (ji +nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 213 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 214 214 END DO 215 215 END DO … … 218 218 DO jl = 1, ipl; DO jk = 1, ipk 219 219 DO ji = startloop, nlci 220 ijt=jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 4220 ijt=jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 221 221 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 222 222 END DO 223 223 END DO; END DO 224 IF (nimpp - nn_hls+1.eq. 1) THEN225 226 227 DO ii = 1, nn_hls228 ARRAY_IN(1-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,:,:,jf)229 230 224 IF (nimpp .eq. 1) THEN 225 DO jj = 1, nn_hls 226 ijj = nlcj-jj+1 227 DO ii = 0, nn_hls-1 228 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,nlcj-2*nn_hls+jj-1,:,:,jf) 229 END DO 230 END DO 231 231 ENDIF 232 232 CASE ( 'F' ) ! F-point 233 IF( nimpp + nlci - nn_hls/= jpiglo ) THEN233 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 234 234 endloop = nlci 235 235 ELSE … … 238 238 IF ( .NOT. l_fast_exchanges ) THEN 239 239 DO jl = 1, ipl; DO jk = 1, ipk 240 241 242 DO ji = 1 - nn_hls +1, endloop243 iju = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 3244 240 DO jj = 2, nn_hls+1 241 ijj = nlcj -jj +1 242 DO ji = 1, endloop 243 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 244 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 245 245 END DO 246 246 END DO … … 248 248 ENDIF 249 249 DO jl = 1, ipl; DO jk = 1, ipk 250 DO ji = 1 - nn_hls +1, endloop251 iju = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 3250 DO ji = 1, endloop 251 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 252 252 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 253 253 END DO 254 254 END DO; END DO 255 IF (nimpp - nn_hls+1.eq. 1) THEN256 257 ARRAY_IN(2-ii,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls-1,:,:,jf)258 259 260 261 262 263 ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls+jj-1,:,:,jf)264 265 266 255 IF (nimpp .eq. 1) THEN 256 DO ii = 1, nn_hls 257 ARRAY_IN(ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls-1,:,:,jf) 258 END DO 259 IF ( .NOT. l_fast_exchanges ) THEN 260 DO jj = 1, nn_hls 261 ijj = nlcj -jj 262 DO ii = 1, nn_hls 263 ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls+jj-1,:,:,jf) 264 END DO 265 END DO 266 ENDIF 267 267 ENDIF 268 IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN269 270 271 272 273 274 275 276 277 278 279 268 IF((nimpp + nlci - 2*nn_hls+1 ) .eq. jpiglo) THEN 269 DO ii = 1, nn_hls 270 ARRAY_IN(nlci-ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls-1,:,:,jf) 271 END DO 272 IF ( .NOT. l_fast_exchanges ) THEN 273 DO jj = 1, nn_hls 274 ijj = nlcj -jj 275 DO ii = 1, nn_hls 276 ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 277 END DO 278 END DO 279 ENDIF 280 280 ENDIF 281 281 ! … … 290 290 ijj = nlcj-jj+1 291 291 DO ji = 1, nlci 292 ijt = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 3292 ijt = jpiglo - ( ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 293 293 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 294 294 END DO … … 297 297 ! 298 298 CASE ( 'U' ) ! U-point 299 IF( nimpp + nlci - nn_hls/= jpiglo ) THEN299 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 300 300 endloop = nlci 301 301 ELSE … … 306 306 ijj = nlcj-jj+1 307 307 DO ji = 1, endloop 308 iju = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 2308 iju = jpiglo- (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 309 309 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 310 310 END DO 311 311 END DO 312 312 END DO; END DO 313 IF( (nimpp + nlci - nn_hls).eq. jpiglo) THEN313 IF(nimpp + nlci - 2*nn_hls+1 .eq. jpiglo) THEN 314 314 DO jl = 1, ipl; DO jk = 1, ipk 315 315 DO jj = 1, nn_hls … … 325 325 CASE ( 'V' ) ! V-point 326 326 DO jl = 1, ipl; DO jk = 1, ipk 327 DO ji = 1, nlci 328 DO jj = 1, nn_hls329 ijj = nlcj -jj +1 330 ijt = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 3327 DO jj = 1, nn_hls 328 ijj = nlcj -jj +1 329 DO ji = 1, nlci 330 ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 331 331 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 332 332 END DO … … 335 335 336 336 IF ( .NOT. l_fast_exchanges ) THEN 337 IF( nimpp -nn_hls+1>= jpiglo/2+1 ) THEN338 startloop = 1 -nn_hls+1339 ELSEIF( nimpp+nlci- 1 >= jpiglo/2+1 .AND. nimpp - nn_hls+1< jpiglo/2+1 ) THEN337 IF( nimpp >= jpiglo/2+1 ) THEN 338 startloop = 1 339 ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 340 340 startloop = jpiglo/2+1 - nimpp + nn_hls 341 341 ELSE … … 345 345 DO jl = 1, ipl; DO jk = 1, ipk 346 346 DO ji = startloop, nlci 347 ijt = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 3347 ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 348 348 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 349 349 END DO … … 353 353 ! 354 354 CASE ( 'F' ) ! F-point 355 IF( nimpp + nlci - nn_hls/= jpiglo ) THEN355 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 356 356 endloop = nlci 357 357 ELSE … … 362 362 ijj = nlcj -jj +1 363 363 DO ji = 1, endloop 364 iju = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 2364 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 365 365 ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 366 366 END DO 367 367 END DO 368 368 END DO; END DO 369 IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN369 IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN 370 370 DO jl = 1, ipl; DO jk = 1, ipk 371 371 DO jj = 1, nn_hls … … 380 380 ! 381 381 IF ( .NOT. l_fast_exchanges ) THEN 382 IF( nimpp + nlci - nn_hls/= jpiglo ) THEN382 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 383 383 endloop = nlci 384 384 ELSE 385 385 endloop = nlci - nn_hls 386 386 ENDIF 387 IF( nimpp - nn_hls+1>= jpiglo/2+1 ) THEN388 startloop = 1 - nn_hls+1389 ELSEIF( nimpp+nlci- 1 >= jpiglo/2+1 .AND. nimpp - nn_hls+1< jpiglo/2+1 ) THEN387 IF( nimpp >= jpiglo/2+1 ) THEN 388 startloop = 1 389 ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 390 390 startloop = jpiglo/2+1 - nimpp + nn_hls 391 391 ELSE … … 395 395 DO jl = 1, ipl; DO jk = 1, ipk 396 396 DO ji = startloop, endloop 397 iju = jpiglo - ji - nimpp- nfiimpp(isendto(1),jpnj) + 2397 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 398 398 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 399 399 END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90
r12586 r12719 51 51 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn , kfillmode, pfillval, lsend, lrecv ) 52 52 #endif 53 ARRAY_TYPE( 1-nn_hls+1:,1-nn_hls+1:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied53 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied 54 54 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 55 55 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points … … 142 142 ! -------------------------------------------------- ! 143 143 ! 144 145 144 ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 146 isize = nn_hls * ( jpj + nn_hls - 1 )* ipk * ipl * ipf145 isize = nn_hls * jpj * ipk * ipl * ipf 147 146 ! 148 147 ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 149 IF( llsend_we ) ALLOCATE( zsnd_we(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )150 IF( llsend_ea ) ALLOCATE( zsnd_ea(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )151 IF( llrecv_we ) ALLOCATE( zrcv_we(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )152 IF( llrecv_ea ) ALLOCATE( zrcv_ea(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )148 IF( llsend_we ) ALLOCATE( zsnd_we(nn_hls,jpj,ipk,ipl,ipf) ) 149 IF( llsend_ea ) ALLOCATE( zsnd_ea(nn_hls,jpj,ipk,ipl,ipf) ) 150 IF( llrecv_we ) ALLOCATE( zrcv_we(nn_hls,jpj,ipk,ipl,ipf) ) 151 IF( llrecv_ea ) ALLOCATE( zrcv_ea(nn_hls,jpj,ipk,ipl,ipf) ) 153 152 ! 154 153 IF( llsend_we ) THEN ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 155 ishift = 1156 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls154 ishift = nn_hls 155 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 157 156 zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! nn_hls + 1 -> 2*nn_hls 158 157 END DO ; END DO ; END DO ; END DO ; END DO 159 158 ENDIF 160 159 ! 161 IF( llsend_ea) THEN ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI162 ishift = jpi - 163 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls160 IF(llsend_ea ) THEN ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 161 ishift = jpi - 2 * nn_hls 162 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 164 163 zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! jpi - 2*nn_hls + 1 -> jpi - nn_hls 165 164 END DO ; END DO ; END DO ; END DO ; END DO … … 169 168 ! 170 169 ! non-blocking send of the western/eastern side using local temporary arrays 171 IF( llsend_we ) CALL mppsend( 1, zsnd_we(1,1 -nn_hls+1,1,1,1), isize, nowe, ireq_we )172 IF( llsend_ea ) CALL mppsend( 2, zsnd_ea(1,1 -nn_hls+1,1,1,1), isize, noea, ireq_ea )170 IF( llsend_we ) CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 171 IF( llsend_ea ) CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 173 172 ! blocking receive of the western/eastern halo in local temporary arrays 174 IF( llrecv_we ) CALL mpprecv( 2, zrcv_we(1,1 -nn_hls+1,1,1,1), isize, nowe )175 IF( llrecv_ea ) CALL mpprecv( 1, zrcv_ea(1,1 -nn_hls+1,1,1,1), isize, noea )173 IF( llrecv_we ) CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 174 IF( llrecv_ea ) CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 176 175 ! 177 176 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 188 187 CASE ( jpfillnothing ) ! no filling 189 188 CASE ( jpfillmpi ) ! use data received by MPI 190 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls191 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf) ! 1 -> nn_hls189 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 190 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf) ! 1 -> nn_hls 192 191 END DO; END DO ; END DO ; END DO ; END DO 193 192 CASE ( jpfillperio ) ! use east-weast periodicity 194 193 ishift2 = jpi - 2 * nn_hls 195 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls196 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)194 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 195 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 197 196 END DO; END DO ; END DO ; END DO ; END DO 198 197 CASE ( jpfillcopy ) ! filling with inner domain values 199 198 DO jf = 1, ipf ! number of arrays to be treated 200 199 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 201 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls202 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(1+ji,jj,jk,jl,jf)200 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 201 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 203 202 END DO ; END DO ; END DO ; END DO 204 203 ENDIF … … 207 206 DO jf = 1, ipf ! number of arrays to be treated 208 207 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 209 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls210 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = zland208 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 209 ARRAY_IN(ji,jj,jk,jl,jf) = zland 211 210 END DO; END DO ; END DO ; END DO 212 211 ENDIF … … 220 219 CASE ( jpfillnothing ) ! no filling 221 220 CASE ( jpfillmpi ) ! use data received by MPI 222 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls221 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 223 222 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf) ! jpi - nn_hls + 1 -> jpi 224 223 END DO ; END DO ; END DO ; END DO ; END DO 225 224 CASE ( jpfillperio ) ! use east-weast periodicity 226 ishift2 = 1227 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls225 ishift2 = nn_hls 226 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 228 227 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 229 228 END DO ; END DO ; END DO ; END DO ; END DO 230 229 CASE ( jpfillcopy ) ! filling with inner domain values 231 ishift2 = jpi - 2*nn_hls 232 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1-nn_hls+1, jpj ; DO ji = 1, nn_hls 233 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 230 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 231 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 234 232 END DO ; END DO ; END DO ; END DO ; END DO 235 233 CASE ( jpfillcst ) ! filling with constant value 236 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls234 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 237 235 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 238 236 END DO; END DO ; END DO ; END DO ; END DO … … 260 258 ! ---------------------------------------------------- ! 261 259 ! 262 IF( llsend_so ) ALLOCATE( zsnd_so( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )263 IF( llsend_no ) ALLOCATE( zsnd_no( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )264 IF( llrecv_so ) ALLOCATE( zrcv_so( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )265 IF( llrecv_no ) ALLOCATE( zrcv_no( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )266 ! 267 isize = ( jpi + nn_hls - 1 )* nn_hls * ipk * ipl * ipf260 IF( llsend_so ) ALLOCATE( zsnd_so(jpi,nn_hls,ipk,ipl,ipf) ) 261 IF( llsend_no ) ALLOCATE( zsnd_no(jpi,nn_hls,ipk,ipl,ipf) ) 262 IF( llrecv_so ) ALLOCATE( zrcv_so(jpi,nn_hls,ipk,ipl,ipf) ) 263 IF( llrecv_no ) ALLOCATE( zrcv_no(jpi,nn_hls,ipk,ipl,ipf) ) 264 ! 265 isize = jpi * nn_hls * ipk * ipl * ipf 268 266 269 267 ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 270 268 IF( llsend_so ) THEN ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 271 ishift = 1272 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi269 ishift = nn_hls 270 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 273 271 zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! nn_hls+1 -> 2*nn_hls 274 272 END DO ; END DO ; END DO ; END DO ; END DO … … 277 275 IF( llsend_no ) THEN ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 278 276 ishift = jpj - 2 * nn_hls 279 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi277 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 280 278 zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! jpj-2*nn_hls+1 -> jpj-nn_hls 281 279 END DO ; END DO ; END DO ; END DO ; END DO … … 285 283 ! 286 284 ! non-blocking send of the southern/northern side 287 IF( llsend_so ) CALL mppsend( 3, zsnd_so(1 -nn_hls+1,1,1,1,1), isize, noso, ireq_so )288 IF( llsend_no ) CALL mppsend( 4, zsnd_no(1 -nn_hls+1,1,1,1,1), isize, nono, ireq_no )285 IF( llsend_so ) CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 286 IF( llsend_no ) CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 289 287 ! blocking receive of the southern/northern halo 290 IF( llrecv_so ) CALL mpprecv( 4, zrcv_so(1 -nn_hls+1,1,1,1,1), isize, noso )291 IF( llrecv_no ) CALL mpprecv( 3, zrcv_no(1 -nn_hls+1,1,1,1,1), isize, nono )288 IF( llrecv_so ) CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 289 IF( llrecv_no ) CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 292 290 ! 293 291 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 303 301 CASE ( jpfillnothing ) ! no filling 304 302 CASE ( jpfillmpi ) ! use data received by MPI 305 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi306 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf) ! 1 -> nn_hls303 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 304 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf) ! 1 -> nn_hls 307 305 END DO; END DO ; END DO ; END DO ; END DO 308 306 CASE ( jpfillperio ) ! use north-south periodicity 309 307 ishift2 = jpj - 2 * nn_hls 310 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi311 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)308 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 309 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 312 310 END DO; END DO ; END DO ; END DO ; END DO 313 311 CASE ( jpfillcopy ) ! filling with inner domain values 314 312 DO jf = 1, ipf ! number of arrays to be treated 315 313 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 316 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi317 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,1+jj,jk,jl,jf)314 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 315 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 318 316 END DO ; END DO ; END DO ; END DO 319 317 ENDIF … … 322 320 DO jf = 1, ipf ! number of arrays to be treated 323 321 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 324 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi325 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = zland322 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 323 ARRAY_IN(ji,jj,jk,jl,jf) = zland 326 324 END DO; END DO ; END DO ; END DO 327 325 ENDIF … … 335 333 CASE ( jpfillnothing ) ! no filling 336 334 CASE ( jpfillmpi ) ! use data received by MPI 337 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi335 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 338 336 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf) ! jpj-nn_hls+1 -> jpj 339 337 END DO ; END DO ; END DO ; END DO ; END DO 340 338 CASE ( jpfillperio ) ! use north-south periodicity 341 ishift2 = 1342 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi339 ishift2 = nn_hls 340 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 343 341 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 344 342 END DO; END DO ; END DO ; END DO ; END DO 345 343 CASE ( jpfillcopy ) ! filling with inner domain values 346 ishift2 = jpj - 2*nn_hls 347 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1-nn_hls+1, jpi 348 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 344 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 345 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 349 346 END DO; END DO ; END DO ; END DO ; END DO 350 347 CASE ( jpfillcst ) ! filling with constant value 351 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi348 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 352 349 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 353 350 END DO; END DO ; END DO ; END DO ; END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90
r12586 r12719 48 48 SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld ) 49 49 !!---------------------------------------------------------------------- 50 ARRAY_TYPE( 1-nn_hls+1:,1-nn_hls+1:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied50 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied 51 51 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 52 52 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary … … 80 80 ALLOCATE(ipj_s(ipf)) 81 81 82 ijpj = 2 + nn_hls -1 ! Max 2nd dimension of message transfers (last two j-line only)83 ipj_s(:) = 1 + nn_hls - 82 ijpj = 2 + nn_hls -1 ! Max 2nd dimension of message transfers (last two j-line only) 83 ipj_s(:) = 1 + nn_hls -1 ! Real 2nd dimension of message transfers (depending on perf requirement) 84 84 ! by default, only one line is exchanged 85 85 … … 98 98 IF ( l_full_nf_update .OR. & ! if coupling fields 99 99 ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) & ! at first time step, if not restart 100 ipj_s(:) = 2 + nn_hls - 1100 ipj_s(:) = 2 + nn_hls -1 101 101 102 102 ! Index of modifying lines in input … … 110 110 ! 111 111 CASE ( 'T' , 'W' ,'U' ) ! T-, U-, W-point 112 113 114 112 DO ji = 1, nn_hls+1 113 jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 114 ENDDO 115 115 CASE ( 'V' , 'F' ) ! V-, F-point 116 117 118 116 DO ji = 1, nn_hls+1 117 jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2 118 ENDDO 119 119 END SELECT 120 120 ! … … 123 123 ! 124 124 CASE ( 'T' , 'W' ,'U' ) ! T-, U-, W-point 125 126 jj_s(jf,ji) = nlcj - 2*nn_hls + ji 127 128 125 DO ji = 1, nn_hls 126 jj_s(jf,ji) = nlcj - 2*nn_hls + ji 127 ENDDO 128 ipj_s(jf) = nn_hls ! need only one line anyway 129 129 CASE ( 'V' , 'F' ) ! V-, F-point 130 131 132 130 DO ji = 1, nn_hls+1 131 jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 132 ENDDO 133 133 END SELECT 134 134 ! … … 139 139 ipf_j = sum (ipj_s(:)) ! Total number of lines to be exchanged 140 140 ! 141 ALLOCATE( znorthloc( 1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) )141 ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) ) 142 142 ! 143 143 js = 0 … … 147 147 DO jl = 1, ipl 148 148 DO jk = 1, ipk 149 znorthloc(1 -nn_hls+1:jpi,js,jk,jl,1) = ARRAY_IN(1-nn_hls+1:jpi,jj_s(jf,jj),jk,jl,jf)149 znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf) 150 150 END DO 151 151 END DO … … 153 153 END DO 154 154 ! 155 ibuffsize = (jpimax + nn_hls -1)* ipf_j * ipk * ipl156 ! 157 ALLOCATE( zfoldwk( 1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) )158 ALLOCATE( ztabr( 1-nn_hls+1:(jpi+nn_hls-1)*jpmaxngh-nn_hls+1,ijpj,ipk,ipl,ipf) )155 ibuffsize = jpimax * ipf_j * ipk * ipl 156 ! 157 ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) ) 158 ALLOCATE( ztabr(jpimax*jpmaxngh,ijpj,ipk,ipl,ipf) ) 159 159 ! when some processors of the north fold are suppressed, 160 160 ! values of ztab* arrays corresponding to these suppressed domain won't be defined … … 177 177 iilb = nimppt(iproc+1) 178 178 ilci = nlcit (iproc+1) 179 ildi = nldit (iproc+1) 180 ilei = nleit (iproc+1) 181 IF( iilb == 1 ) ildi = 1! e-w boundary already done -> force to take 1st column182 IF( iilb + ilci - 1 == jpiglo ) ilei = ilci! e-w boundary already done -> force to take last column179 ildi = nldit (iproc+1) + nn_hls-1 180 ilei = nleit (iproc+1) + nn_hls-1 181 IF( iilb == 1 ) ildi = nn_hls ! e-w boundary already done -> force to take 1st column 182 IF( iilb + ilci - 1 == jpiglo ) ilei = nlei+1 ! e-w boundary already done -> force to take last column 183 183 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 184 184 ENDIF … … 191 191 DO jk = 1, ipk 192 192 DO ji = ildi, ilei 193 ztabr(iilb +ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1)193 ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1) 194 194 END DO 195 195 END DO … … 201 201 DO jk = 1, ipk 202 202 DO ji = ildi, ilei 203 ztabr(iilb +ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf)203 ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf) 204 204 END DO 205 205 END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_mus.F90
r12601 r12719 83 83 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 84 84 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 85 REAL(wp), POINTER, DIMENSION(:,:,: ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components86 REAL(wp), POINTER, DIMENSION(:,:,:,:,:) 85 REAL(wp), POINTER, DIMENSION(:,:,:) , INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 86 REAL(wp), POINTER, DIMENSION(:,:,:,:,:) , INTENT(inout) :: pt ! tracers and RHS of tracer equation 87 87 ! 88 88 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 96 96 CALL halo_mng_set(jphls) 97 97 98 ALLOCATE(zwx(jp lbi:jpi,jplbj:jpj,jpk))99 ALLOCATE(zwy(jp lbi:jpi,jplbj:jpj,jpk))100 ALLOCATE(zslpx(jp lbi:jpi,jplbj:jpj,jpk))101 ALLOCATE(zslpy(jp lbi:jpi,jplbj:jpj,jpk))98 ALLOCATE(zwx(jpi,jpj,jpk)) 99 ALLOCATE(zwy(jpi,jpj,jpk)) 100 ALLOCATE(zslpx(jpi,jpj,jpk)) 101 ALLOCATE(zslpy(jpi,jpj,jpk)) 102 102 103 103 CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) … … 105 105 CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 106 106 CALL halo_mng_resize(tmask,'T', 1._wp) 107 CALL halo_mng_resize(wmask, 108 CALL halo_mng_resize(umask, 109 CALL halo_mng_resize(vmask, 107 CALL halo_mng_resize(wmask,'W', 1._wp) 108 CALL halo_mng_resize(umask,'U', 1._wp) 109 CALL halo_mng_resize(vmask,'V', 1._wp) 110 110 CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 111 111 CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 112 112 CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 113 CALL halo_mng_resize(e3u, 114 CALL halo_mng_resize(e3v, 115 CALL halo_mng_resize(e3w, 113 CALL halo_mng_resize(e3u,'U', 1._wp, fillval=1._wp, fjpt=Kmm ) 114 CALL halo_mng_resize(e3v,'V', 1._wp, fillval=1._wp, fjpt=Kmm) 115 CALL halo_mng_resize(e3w,'W', 1._wp, fillval=1._wp, fjpt=Kmm) 116 116 CALL halo_mng_resize(pU, 'U', -1._wp) 117 117 CALL halo_mng_resize(pV, 'V', -1._wp) 118 118 CALL halo_mng_resize(pW, 'W', 1._wp) 119 ! 120 IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp)121 IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 122 IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 119 ! 120 IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 121 IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk,'T', 1._wp) 122 IF( ld_msc_ups) CALL halo_mng_resize(upsmsk,'T', 1._wp) 123 123 124 124 IF( kt == kit000 ) THEN … … 131 131 ! Upstream / MUSCL scheme indicator 132 132 ! 133 ALLOCATE( xind(jp lbi:jpi,jplbj:jpj,jpk), STAT=ierr )133 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 134 134 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 135 135 ! 136 136 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 137 ALLOCATE( upsmsk(jp lbi:jpi,jplbj:jpj), STAT=ierr )137 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 138 138 upsmsk(:,:) = 0._wp ! not upstream by default 139 139 ! … … 146 146 ! 147 147 ENDIF 148 148 ! 149 149 l_trd = .FALSE. 150 150 l_hst = .FALSE. … … 162 162 zwx(:,:,jpk) = 0._wp ! bottom values 163 163 zwy(:,:,jpk) = 0._wp 164 DO_3D_ 20_20( 1, jpkm1 )164 DO_3D_10_10( 1, jpkm1 ) 165 165 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 166 166 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 167 167 END_3D 168 ! 168 ! lateral boundary conditions (changed sign) 169 !CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) 169 170 ! !-- Slopes of tracer 170 171 zslpx(:,:,jpk) = 0._wp ! bottom values 171 172 zslpy(:,:,jpk) = 0._wp 172 DO_3D_ 31_31( 1, jpkm1 )173 DO_3D_01_01( 1, jpkm1 ) 173 174 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 174 175 & * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 177 178 END_3D 178 179 ! 179 DO_3D_ 31_31( 1, jpkm1 )180 DO_3D_01_01( 1, jpkm1 ) 180 181 zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 181 182 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 186 187 END_3D 187 188 ! 188 DO_3D_ 30_30( 1, jpkm1 )189 DO_3D_00_00( 1, jpkm1 ) 189 190 ! MUSCL fluxes 190 191 z0u = SIGN( 0.5, pU(ji,jj,jk) ) … … 202 203 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 203 204 END_3D 204 ! 205 DO_3D_30_30( 1, jpkm1 ) 205 !CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 206 ! 207 DO_3D_00_00( 1, jpkm1 ) 206 208 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 207 209 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & … … 228 230 ! !-- Slopes of tracer 229 231 zslpx(:,:,1) = 0._wp ! surface values 230 DO_3D_ 21_21( 2, jpkm1 )232 DO_3D_11_11( 2, jpkm1 ) 231 233 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) ) & 232 234 & * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) 233 235 END_3D 234 DO_3D_ 21_21( 2, jpkm1 )236 DO_3D_11_11( 2, jpkm1 ) 235 237 zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji,jj,jk ) ), & 236 238 & 2.*ABS( zwx (ji,jj,jk+1) ), & 237 239 & 2.*ABS( zwx (ji,jj,jk ) ) ) 238 240 END_3D 239 DO_3D_ 30_30( 1, jpk-2 )241 DO_3D_00_00( 1, jpk-2 ) 240 242 z0w = SIGN( 0.5, pW(ji,jj,jk+1) ) 241 243 zalpha = 0.5 + z0w … … 247 249 IF( ln_linssh ) THEN ! top values, linear free surface only 248 250 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 249 DO_2D_ 21_21251 DO_2D_11_11 250 252 zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 251 253 END_2D … … 255 257 ENDIF 256 258 ! 257 DO_3D_ 30_30( 1, jpkm1 )259 DO_3D_00_00( 1, jpkm1 ) 258 260 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 259 261 END_3D … … 262 264 ! 263 265 END DO ! end of tracer loop 264 ! 266 265 267 DEALLOCATE(zwx,zwy) 266 268 DEALLOCATE(zslpx,zslpy) 267 269 268 270 CALL halo_mng_set(1) 269 271 ! 270 272 CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 271 273 CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 272 274 CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 273 CALL halo_mng_resize(pt, 274 CALL halo_mng_resize(pt, 275 CALL halo_mng_resize(pt,'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 276 CALL halo_mng_resize(pt,'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 275 277 CALL halo_mng_resize(tmask,'T', 1._wp) 276 CALL halo_mng_resize(wmask, 277 CALL halo_mng_resize(umask, 278 CALL halo_mng_resize(vmask, 278 CALL halo_mng_resize(wmask,'W', 1._wp) 279 CALL halo_mng_resize(umask,'U', 1._wp) 280 CALL halo_mng_resize(vmask,'V', 1._wp) 279 281 CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 280 CALL halo_mng_resize(e3u, 281 CALL halo_mng_resize(e3v, 282 CALL halo_mng_resize(e3w, 283 CALL halo_mng_resize(pU, 284 CALL halo_mng_resize(pV, 285 CALL halo_mng_resize(pW, 282 CALL halo_mng_resize(e3u,'U', 1._wp, fillval=1._wp, fjpt=Kmm) 283 CALL halo_mng_resize(e3v,'V', 1._wp, fillval=1._wp, fjpt=Kmm) 284 CALL halo_mng_resize(e3w,'W', 1._wp, fillval=1._wp, fjpt=Kmm) 285 CALL halo_mng_resize(pU,'U', 1._wp) 286 CALL halo_mng_resize(pV,'V', 1._wp) 287 CALL halo_mng_resize(pW,'W', 1._wp) 286 288 287 289 IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 288 290 IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 289 291 IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 290 291 292 END SUBROUTINE tra_adv_mus 292 293 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/do_loop_substitute.h90
r12586 r12719 59 59 #define __kIsm1_ 1 60 60 #define __kJsm1_ 1 61 #62 #define __kIsmh_ jplbi63 #define __kJsmh_ jplbj64 #define __kIsmhp1_ jplbi+165 #define __kJsmhp1_ jplbj+166 61 67 62 #define __kIe_ jpi-1 … … 83 78 #define DO_2D_10_10 DO jj = __kJsm1_, __kJe_ ; DO ji = __kIsm1_, __kIe_ 84 79 #define DO_2D_10_11 DO jj = __kJsm1_, __kJe_ ; DO ji = __kIsm1_, __kIep1_ 85 #86 #define DO_2D_20_20 DO jj = __kJsmh_, __kJe_ ; DO ji = __kIsmh_, __kIe_87 #define DO_2D_21_21 DO jj = __kJsmh_, __kJep1_ ; DO ji = __kIsmh_, __kIep1_88 #define DO_2D_31_31 DO jj = __kJsmhp1_, __kJep1_ ; DO ji = __kIsmhp1_, __kIep1_89 #define DO_2D_30_30 DO jj = __kJsmhp1_, __kJe_ ; DO ji = __kIsmhp1_, __kIe_90 80 91 81 #define DO_2D_11_00 DO jj = __kJsm1_, __kJep1_ ; DO ji = __kIs_, __kIe_ … … 102 92 #define DO_3D_10_10(ks,ke) DO jk = ks, ke ; DO_2D_10_10 103 93 #define DO_3D_10_11(ks,ke) DO jk = ks, ke ; DO_2D_10_11 104 #105 #define DO_3D_20_20(ks,ke) DO jk = ks, ke ; DO_2D_20_20106 #define DO_3D_21_21(ks,ke) DO jk = ks, ke ; DO_2D_21_21107 #define DO_3D_31_31(ks,ke) DO jk = ks, ke ; DO_2D_31_31108 #define DO_3D_30_30(ks,ke) DO jk = ks, ke ; DO_2D_30_30109 94 110 95 #define DO_3D_11_11(ks,ke) DO jk = ks, ke ; DO_2D_11_11 111 #define DO_3D_21_21(ks,ke) DO jk = ks, ke ; DO_2D_21_21112 96 113 97 #define DO_3DS_00_00(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_00 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/par_oce.F90
r12586 r12719 61 61 INTEGER, PUBLIC :: jpimax! = ( jpiglo-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls !: maximum jpi 62 62 INTEGER, PUBLIC :: jpjmax! = ( jpjglo-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls !: maximum jpj 63 INTEGER, PUBLIC :: jplbi64 INTEGER, PUBLIC :: jplbj65 63 66 64 !!---------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.