Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/mpp_nfd_generic.h90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/mpp_nfd_generic.h90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/mpp_nfd_generic.h90
r13438 r14789 1 #if defined MULTI2 # define NAT_IN(k) cd_nat(k)3 # define SGN_IN(k) psgn(k)4 # define F_SIZE(ptab) kfld5 # define LBC_ARG (jf)6 # if defined DIM_2d7 # if defined SINGLE_PRECISION8 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp) , INTENT(inout) :: ptab(f)9 # else10 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp) , INTENT(inout) :: ptab(f)11 # endif12 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j)13 # define K_SIZE(ptab) 114 # define L_SIZE(ptab) 115 # endif16 # if defined DIM_3d17 # if defined SINGLE_PRECISION18 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp) , INTENT(inout) :: ptab(f)19 # else20 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp) , INTENT(inout) :: ptab(f)21 # endif22 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k)23 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3)24 # define L_SIZE(ptab) 125 # endif26 # if defined DIM_4d27 # if defined SINGLE_PRECISION28 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp) , INTENT(inout) :: ptab(f)29 # else30 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp) , INTENT(inout) :: ptab(f)31 # endif32 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l)33 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3)34 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4)35 # endif36 #else37 ! !== IN: ptab is an array ==!38 # if defined SINGLE_PRECISION39 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f)40 # else41 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f)42 # endif43 # define NAT_IN(k) cd_nat44 # define SGN_IN(k) psgn45 # define F_SIZE(ptab) 146 # define LBC_ARG47 # if defined DIM_2d48 # define ARRAY_IN(i,j,k,l,f) ptab(i,j)49 # define K_SIZE(ptab) 150 # define L_SIZE(ptab) 151 # endif52 # if defined DIM_3d53 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k)54 # define K_SIZE(ptab) SIZE(ptab,3)55 # define L_SIZE(ptab) 156 # endif57 # if defined DIM_4d58 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k,l)59 # define K_SIZE(ptab) SIZE(ptab,3)60 # define L_SIZE(ptab) SIZE(ptab,4)61 # endif62 #endif63 1 64 # if defined SINGLE_PRECISION 65 # define PRECISION sp 66 # define SENDROUTINE mppsend_sp 67 # define RECVROUTINE mpprecv_sp 68 # define MPI_TYPE MPI_REAL 69 # define HUGEVAL(x) HUGE(x/**/_sp) 70 # else 71 # define PRECISION dp 72 # define SENDROUTINE mppsend_dp 73 # define RECVROUTINE mpprecv_dp 74 # define MPI_TYPE MPI_DOUBLE_PRECISION 75 # define HUGEVAL(x) HUGE(x/**/_dp) 76 # endif 77 78 SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfillmode, pfillval, kfld ) 79 !!---------------------------------------------------------------------- 80 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied 81 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 82 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 83 INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land 84 REAL(wp) , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 85 INTEGER, OPTIONAL, INTENT(in ) :: kfld ! number of pt3d arrays 2 SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, khls, kfld ) 3 TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c. 4 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points 5 REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary 6 INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land 7 REAL(PRECISION) , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 8 INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls 9 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 86 10 ! 87 11 LOGICAL :: ll_add_line … … 95 19 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather 96 20 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 97 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather98 21 ! ! Workspace for message transfers avoiding mpi_allgather 99 22 INTEGER :: ipj_b ! sum of lines for all multi fields … … 103 26 INTEGER , DIMENSION(:) , ALLOCATABLE :: ipj_s ! number of sent lines 104 27 REAL(PRECISION), DIMENSION(:,:,:,:) , ALLOCATABLE :: ztabb, ztabr, ztabw ! buffer, receive and work arrays 105 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: z tabglo, znorthloc28 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: znorthloc 106 29 REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthglo 30 TYPE(PTR_4D_/**/PRECISION), DIMENSION(:), ALLOCATABLE :: ztabglo ! array or pointer of arrays on which apply the b.c. 107 31 !!---------------------------------------------------------------------- 108 32 ! 109 ipk = K_SIZE(ptab) ! 3rd dimension110 ipl = L_SIZE(ptab) ! 4th -111 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers)33 ipk = SIZE(ptab(1)%pt4d,3) 34 ipl = SIZE(ptab(1)%pt4d,4) 35 ipf = kfld 112 36 ! 113 IF( l _north_nogather ) THEN !== no allgather exchanges ==!37 IF( ln_nnogather ) THEN !== no allgather exchanges ==! 114 38 115 39 ! --- define number of exchanged lines --- … … 118 42 ! 119 43 ! However, some other points are duplicated in the north pole folding: 120 ! - jperio=[34], grid=T : half of the last line (jpiglo/2+2:jpiglo-nn_hls)121 ! - jperio=[34], grid=U : half of the last line (jpiglo/2+1:jpiglo-nn_hls)122 ! - jperio=[34], grid=V : all the last line nn_hls+1 and (nn_hls+2:jpiglo-nn_hls)123 ! - jperio=[34], grid=F : all the last line (nn_hls+1:jpiglo-nn_hls)124 ! - jperio=[56], grid=T : 2 points of the last line (jpiglo/2+1 and jpglo-nn_hls)125 ! - jperio=[56], grid=U : no points are duplicated126 ! - jperio=[56], grid=V : half of the last line (jpiglo/2+1:jpiglo-nn_hls)127 ! - jperio=[56], grid=F : half of the last line (jpiglo/2+1:jpiglo-nn_hls-1)44 ! - c_NFtype='T', grid=T : half of the last line (jpiglo/2+2:jpiglo-nn_hls) 45 ! - c_NFtype='T', grid=U : half of the last line (jpiglo/2+1:jpiglo-nn_hls) 46 ! - c_NFtype='T', grid=V : all the last line nn_hls+1 and (nn_hls+2:jpiglo-nn_hls) 47 ! - c_NFtype='T', grid=F : all the last line (nn_hls+1:jpiglo-nn_hls) 48 ! - c_NFtype='F', grid=T : 2 points of the last line (jpiglo/2+1 and jpglo-nn_hls) 49 ! - c_NFtype='F', grid=U : no points are duplicated 50 ! - c_NFtype='F', grid=V : half of the last line (jpiglo/2+1:jpiglo-nn_hls) 51 ! - c_NFtype='F', grid=F : half of the last line (jpiglo/2+1:jpiglo-nn_hls-1) 128 52 ! The order of the calculations may differ for these duplicated points (as, for example jj+1 becomes jj-1) 129 53 ! This explain why these duplicated points may have different values even if they are at the exact same location. … … 141 65 IF( ll_add_line ) THEN 142 66 DO jf = 1, ipf ! Loop over the number of arrays to be processed 143 ipj_s(jf) = nn_hls + COUNT( (/ npolj == 3 .OR. npolj == 4 .OR. NAT_IN(jf) == 'V' .OR. NAT_IN(jf) == 'F' /) )67 ipj_s(jf) = khls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) 144 68 END DO 145 69 ELSE 146 ipj_s(:) = nn_hls70 ipj_s(:) = khls 147 71 ENDIF 148 72 … … 155 79 DO jf = 1, ipf ! Loop over the number of arrays to be processed 156 80 ! 157 SELECT CASE ( npolj ) 158 CASE ( 3, 4 ) ! * North fold T-point pivot 159 SELECT CASE ( NAT_IN(jf) ) 81 IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot 82 SELECT CASE ( cd_nat(jf) ) 160 83 CASE ( 'T', 'W', 'U' ) ; i012 = 1 ! T-, U-, W-point 161 84 CASE ( 'V', 'F' ) ; i012 = 2 ! V-, F-point 162 85 END SELECT 163 CASE ( 5, 6 ) ! * North fold F-point pivot 164 SELECT CASE ( NAT_IN(jf) ) 86 ENDIF 87 IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot 88 SELECT CASE ( cd_nat(jf) ) 165 89 CASE ( 'T', 'W', 'U' ) ; i012 = 0 ! T-, U-, W-point 166 90 CASE ( 'V', 'F' ) ; i012 = 1 ! V-, F-point 167 91 END SELECT 168 END SELECT92 ENDIF 169 93 ! 170 94 DO jj = 1, ipj_s(jf) 171 95 ij1 = ij1 + 1 172 96 jj_b(jj,jf) = ij1 173 jj_s(jj,jf) = jpj - 2* nn_hls + jj - i01297 jj_s(jj,jf) = jpj - 2*khls + jj - i012 174 98 END DO 175 99 ! … … 184 108 ij2 = jj_s(jj,jf) 185 109 DO ji = 1, jpi 186 ztabb(ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf)110 ztabb(ji,ij1,jk,jl) = ptab(jf)%pt4d(ji,ij2,jk,jl) 187 111 END DO 188 112 DO ji = jpi+1, jpimax 189 ztabb(ji,ij1,jk,jl) = HUGE VAL(0.) ! avoid sending uninitialized values (make sure we don't use it)113 ztabb(ji,ij1,jk,jl) = HUGE(0._/**/PRECISION) ! avoid sending uninitialized values (make sure we don't use it) 190 114 END DO 191 115 END DO … … 199 123 iproc = nfproc(isendto(jr)) 200 124 IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 201 CALL SENDROUTINE( 5, ztabb, ibuffsize, iproc, ml_req_nf(jr) ) 125 #if ! defined key_mpi_off 126 CALL MPI_ISEND( ztabb, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ml_req_nf(jr), ierr ) 127 #endif 202 128 ENDIF 203 129 END DO … … 212 138 ipi = nfjpi (ipni) 213 139 ! 214 IF( ipni == 1 ) THEN ; iis0 = 1 215 ELSE ; iis0 = 1 + nn_hls ! default: -> from inner domain216 ENDIF 217 IF( ipni == jpni ) THEN ; iie0 = ipi 218 ELSE ; iie0 = ipi - nn_hls ! default: -> until inner domain140 IF( ipni == 1 ) THEN ; iis0 = 1 ! domain left side: as e-w comm already done -> from 1st column 141 ELSE ; iis0 = 1 + khls ! default: -> from inner domain 142 ENDIF 143 IF( ipni == jpni ) THEN ; iie0 = ipi ! domain right side: as e-w comm already done -> until last column 144 ELSE ; iie0 = ipi - khls ! default: -> until inner domain 219 145 ENDIF 220 146 impp = nfimpp(ipni) - nfimpp(isendto(1)) … … 230 156 ij2 = jj_s(jj,jf) 231 157 DO ji = iis0, iie0 232 ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(Nis0,ij2,jk,jl,jf) ! chose to take the 1st iner domain point158 ztabr(impp+ji,ij1,jk,jl) = ptab(jf)%pt4d(Nis0,ij2,jk,jl) ! chose to take the 1st iner domain point 233 159 END DO 234 160 END DO … … 251 177 ij2 = jj_s(jj,jf) 252 178 DO ji = iis0, iie0 253 ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf)179 ztabr(impp+ji,ij1,jk,jl) = ptab(jf)%pt4d(ji,ij2,jk,jl) 254 180 END DO 255 181 END DO … … 258 184 ELSE ! get data from a neighbour trough communication 259 185 ! 260 CALL RECVROUTINE(5, ztabw, ibuffsize, iproc) 186 #if ! defined key_mpi_off 187 CALL MPI_RECV( ztabw, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, MPI_STATUS_IGNORE, ierr ) 188 #endif 261 189 DO jl = 1, ipl ; DO jk = 1, ipk 262 190 DO jj = 1, ipj_b … … 278 206 ij1 = jj_b( 1 ,jf) 279 207 ij2 = jj_b(ipj_s(jf),jf) 280 CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,ij1:ij2,:,:), cd_nat LBC_ARG, psgn LBC_ARG)208 CALL lbc_nfd_nogather( ptab(jf)%pt4d(:,:,:,:), ztabr(:,ij1:ij2,:,:), cd_nat(jf), psgn(jf), khls ) 281 209 END DO 282 210 ! … … 286 214 iproc = nfproc(isendto(jr)) 287 215 IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 288 CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err ) ! put the wait at the very end just before the deallocate216 CALL mpi_wait( ml_req_nf(jr), MPI_STATUS_IGNORE, ml_err ) ! put the wait at the very end just before the deallocate 289 217 ENDIF 290 218 END DO … … 294 222 ! 295 223 ! how many lines do we exchange at max? -> ipj (no further optimizations in this case...) 296 ipj = nn_hls + 2224 ipj = khls + 2 297 225 ! how many lines do we need at max? -> ipj2 (no further optimizations in this case...) 298 ipj2 = 2 * nn_hls + 2299 ! 300 i0max = jpimax - 2 * nn_hls226 ipj2 = 2 * khls + 2 227 ! 228 i0max = jpimax - 2 * khls 301 229 ibuffsize = i0max * ipj * ipk * ipl * ipf 302 230 ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) ) … … 307 235 DO ji = 1, Ni_0 308 236 ii2 = Nis0 - 1 + ji ! inner domain: Nis0 to Nie0 309 znorthloc(ji,jj,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf)237 znorthloc(ji,jj,jk,jl,jf) = ptab(jf)%pt4d(ii2,ij2,jk,jl) 310 238 END DO 311 239 DO ji = Ni_0+1, i0max 312 znorthloc(ji,jj,jk,jl,jf) = HUGE VAL(0.) ! avoid sending uninitialized values (make sure we don't use it)240 znorthloc(ji,jj,jk,jl,jf) = HUGE(0._/**/PRECISION) ! avoid sending uninitialized values (make sure we don't use it) 313 241 END DO 314 242 END DO … … 317 245 ! start waiting time measurement 318 246 IF( ln_timing ) CALL tic_tac(.TRUE.) 319 #if defined key_mpp_mpi247 #if ! defined key_mpi_off 320 248 CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 321 249 #endif … … 323 251 IF( ln_timing ) CALL tic_tac(.FALSE.) 324 252 DEALLOCATE( znorthloc ) 325 ALLOCATE( ztabglo(jpiglo,ipj2,ipk,ipl,ipf) ) 326 ! 327 ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines 253 ALLOCATE( ztabglo(ipf) ) 254 DO jf = 1, ipf 255 ALLOCATE( ztabglo(jf)%pt4d(jpiglo,ipj2,ipk,ipl) ) 256 END DO 257 ! 258 ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last khls lines 328 259 ijnr = 0 329 260 DO jr = 1, jpni ! recover the global north array 330 261 iproc = nfproc(jr) 331 262 impp = nfimpp(jr) 332 ipi = nfjpi( jr) - 2 * nn_hls ! corresponds to Ni_0 but for subdomain iproc263 ipi = nfjpi( jr) - 2 * khls ! corresponds to Ni_0 but for subdomain iproc 333 264 IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed) 334 265 ! … … 340 271 ij2 = jpj - ipj2 + jj ! the first ipj lines of the last ipj2 lines 341 272 DO ji = 1, ipi 342 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc343 ztabglo( ii1,jj,jk,jl,jf) = ARRAY_IN(Nis0,ij2,jk,jl,jf) ! chose to take the 1st iner domain point273 ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc 274 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = ptab(jf)%pt4d(Nis0,ij2,jk,jl) ! chose to take the 1st inner domain point 344 275 END DO 345 276 END DO … … 349 280 DO jj = 1, ipj 350 281 DO ji = 1, ipi 351 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc352 ztabglo( ii1,jj,jk,jl,jf) = pfillval282 ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc 283 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = pfillval 353 284 END DO 354 285 END DO … … 361 292 DO jj = 1, ipj 362 293 DO ji = 1, ipi 363 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc364 ztabglo( ii1,jj,jk,jl,jf) = znorthglo(ji,jj,jk,jl,jf,ijnr)294 ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc 295 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = znorthglo(ji,jj,jk,jl,jf,ijnr) 365 296 END DO 366 297 END DO … … 372 303 ! 373 304 DO jf = 1, ipf 374 CALL lbc_nfd( ztabglo( :,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG) ! North fold boundary condition305 CALL lbc_nfd( ztabglo(jf:jf), cd_nat(jf:jf), psgn(jf:jf), khls, 1 ) ! North fold boundary condition 375 306 DO jl = 1, ipl ; DO jk = 1, ipk ! e-w periodicity 376 DO jj = 1, nn_hls + 1377 ij1 = ipj2 - ( nn_hls + 1) + jj ! need only the last nn_hls + 1 lines until ipj2378 ztabglo( 1:nn_hls,ij1,jk,jl,jf) = ztabglo(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl,jf)379 ztabglo(j piglo-nn_hls+1:jpiglo,ij1,jk,jl,jf) = ztabglo( nn_hls+1: 2*nn_hls,ij1,jk,jl,jf)307 DO jj = 1, khls + 1 308 ij1 = ipj2 - (khls + 1) + jj ! need only the last khls + 1 lines until ipj2 309 ztabglo(jf)%pt4d( 1: khls,ij1,jk,jl) = ztabglo(jf)%pt4d(jpiglo-2*khls+1:jpiglo-khls,ij1,jk,jl) 310 ztabglo(jf)%pt4d(jpiglo-khls+1:jpiglo,ij1,jk,jl) = ztabglo(jf)%pt4d( khls+1: 2*khls,ij1,jk,jl) 380 311 END DO 381 312 END DO ; END DO … … 383 314 ! 384 315 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ! Scatter back to ARRAY_IN 385 DO jj = 1, nn_hls + 1386 ij1 = jpj - ( nn_hls + 1) + jj ! last nn_hls + 1 lines until jpj387 ij2 = ipj2 - ( nn_hls + 1) + jj ! last nn_hls + 1 lines until ipj2316 DO jj = 1, khls + 1 317 ij1 = jpj - (khls + 1) + jj ! last khls + 1 lines until jpj 318 ij2 = ipj2 - (khls + 1) + jj ! last khls + 1 lines until ipj2 388 319 DO ji= 1, jpi 389 320 ii2 = mig(ji) 390 ARRAY_IN(ji,ij1,jk,jl,jf) = ztabglo(ii2,ij2,jk,jl,jf)321 ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(jf)%pt4d(ii2,ij2,jk,jl) 391 322 END DO 392 323 END DO 393 324 END DO ; END DO ; END DO 394 325 ! 326 DO jf = 1, ipf 327 DEALLOCATE( ztabglo(jf)%pt4d ) 328 END DO 395 329 DEALLOCATE( ztabglo ) 396 330 ! 397 331 ENDIF ! l_north_nogather 398 332 ! 399 END SUBROUTINE ROUTINE_NFD333 END SUBROUTINE mpp_nfd_/**/PRECISION 400 334 401 #undef PRECISION402 #undef MPI_TYPE403 #undef SENDROUTINE404 #undef RECVROUTINE405 #undef ARRAY_TYPE406 #undef NAT_IN407 #undef SGN_IN408 #undef ARRAY_IN409 #undef K_SIZE410 #undef L_SIZE411 #undef F_SIZE412 #undef LBC_ARG413 #undef HUGEVAL
Note: See TracChangeset
for help on using the changeset viewer.
