Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/mpp_nfd_generic.h90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/mpp_nfd_generic.h90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/mpp_nfd_generic.h90
r14495 r14644 1 # define PASTE(a) a2 # define ADD_TRAIL_USCORE(a) PASTE(a)_3 # define CONCATENATE(a,b) ADD_TRAIL_USCORE(a)b4 1 5 #if defined MULTI 6 # define NAT_IN(k) cd_nat(k) 7 # define SGN_IN(k) psgn(k) 8 # define F_SIZE(ptab) kfld 9 # define LBC_ARG (jf) 10 # if defined DIM_2d 11 # if defined SINGLE_PRECISION 12 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_sp) , INTENT(inout) :: ptab(f) 13 # else 14 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D_dp) , INTENT(inout) :: ptab(f) 15 # endif 16 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 17 # define K_SIZE(ptab) 1 18 # define L_SIZE(ptab) 1 19 # endif 20 # if defined DIM_3d 21 # if defined SINGLE_PRECISION 22 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_sp) , INTENT(inout) :: ptab(f) 23 # else 24 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D_dp) , INTENT(inout) :: ptab(f) 25 # endif 26 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 27 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) 28 # define L_SIZE(ptab) 1 29 # endif 30 # if defined DIM_4d 31 # if defined SINGLE_PRECISION 32 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_sp) , INTENT(inout) :: ptab(f) 33 # else 34 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D_dp) , INTENT(inout) :: ptab(f) 35 # endif 36 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 37 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 38 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) 39 # endif 40 #else 41 ! !== IN: ptab is an array ==! 42 # if defined SINGLE_PRECISION 43 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 44 # else 45 # define ARRAY_TYPE(i,j,k,l,f) REAL(dp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 46 # endif 47 # define NAT_IN(k) cd_nat 48 # define SGN_IN(k) psgn 49 # define F_SIZE(ptab) 1 50 # define LBC_ARG 51 # if defined DIM_2d 52 # define ARRAY_IN(i,j,k,l,f) ptab(i,j) 53 # define K_SIZE(ptab) 1 54 # define L_SIZE(ptab) 1 55 # endif 56 # if defined DIM_3d 57 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k) 58 # define K_SIZE(ptab) SIZE(ptab,3) 59 # define L_SIZE(ptab) 1 60 # endif 61 # if defined DIM_4d 62 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k,l) 63 # define K_SIZE(ptab) SIZE(ptab,3) 64 # define L_SIZE(ptab) SIZE(ptab,4) 65 # endif 66 #endif 67 68 # if defined SINGLE_PRECISION 69 # define PRECISION sp 70 # define SENDROUTINE mppsend_sp 71 # define RECVROUTINE mpprecv_sp 72 # define MPI_TYPE MPI_REAL 73 # define HUGEVAL(x) HUGE(CONCATENATE(x,sp)) 74 # else 75 # define PRECISION dp 76 # define SENDROUTINE mppsend_dp 77 # define RECVROUTINE mpprecv_dp 78 # define MPI_TYPE MPI_DOUBLE_PRECISION 79 # define HUGEVAL(x) HUGE(CONCATENATE(x,dp)) 80 # endif 81 82 SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfillmode, pfillval, kfld ) 83 !!---------------------------------------------------------------------- 84 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied 85 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 86 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 87 INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land 88 REAL(wp) , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 89 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 90 10 ! 91 11 LOGICAL :: ll_add_line … … 99 19 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather 100 20 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 101 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather102 21 ! ! Workspace for message transfers avoiding mpi_allgather 103 22 INTEGER :: ipj_b ! sum of lines for all multi fields … … 107 26 INTEGER , DIMENSION(:) , ALLOCATABLE :: ipj_s ! number of sent lines 108 27 REAL(PRECISION), DIMENSION(:,:,:,:) , ALLOCATABLE :: ztabb, ztabr, ztabw ! buffer, receive and work arrays 109 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: z tabglo, znorthloc28 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: znorthloc 110 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. 111 31 !!---------------------------------------------------------------------- 112 32 ! 113 ipk = K_SIZE(ptab) ! 3rd dimension114 ipl = L_SIZE(ptab) ! 4th -115 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 116 36 ! 117 IF( l _north_nogather ) THEN !== no allgather exchanges ==!37 IF( ln_nnogather ) THEN !== no allgather exchanges ==! 118 38 119 39 ! --- define number of exchanged lines --- … … 122 42 ! 123 43 ! However, some other points are duplicated in the north pole folding: 124 ! - jperio=[34], grid=T : half of the last line (jpiglo/2+2:jpiglo-nn_hls)125 ! - jperio=[34], grid=U : half of the last line (jpiglo/2+1:jpiglo-nn_hls)126 ! - jperio=[34], grid=V : all the last line nn_hls+1 and (nn_hls+2:jpiglo-nn_hls)127 ! - jperio=[34], grid=F : all the last line (nn_hls+1:jpiglo-nn_hls)128 ! - jperio=[56], grid=T : 2 points of the last line (jpiglo/2+1 and jpglo-nn_hls)129 ! - jperio=[56], grid=U : no points are duplicated130 ! - jperio=[56], grid=V : half of the last line (jpiglo/2+1:jpiglo-nn_hls)131 ! - 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) 132 52 ! The order of the calculations may differ for these duplicated points (as, for example jj+1 becomes jj-1) 133 53 ! This explain why these duplicated points may have different values even if they are at the exact same location. … … 145 65 IF( ll_add_line ) THEN 146 66 DO jf = 1, ipf ! Loop over the number of arrays to be processed 147 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' /) ) 148 68 END DO 149 69 ELSE 150 ipj_s(:) = nn_hls70 ipj_s(:) = khls 151 71 ENDIF 152 72 … … 159 79 DO jf = 1, ipf ! Loop over the number of arrays to be processed 160 80 ! 161 SELECT CASE ( npolj ) 162 CASE ( 3, 4 ) ! * North fold T-point pivot 163 SELECT CASE ( NAT_IN(jf) ) 81 IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot 82 SELECT CASE ( cd_nat(jf) ) 164 83 CASE ( 'T', 'W', 'U' ) ; i012 = 1 ! T-, U-, W-point 165 84 CASE ( 'V', 'F' ) ; i012 = 2 ! V-, F-point 166 85 END SELECT 167 CASE ( 5, 6 ) ! * North fold F-point pivot 168 SELECT CASE ( NAT_IN(jf) ) 86 ENDIF 87 IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot 88 SELECT CASE ( cd_nat(jf) ) 169 89 CASE ( 'T', 'W', 'U' ) ; i012 = 0 ! T-, U-, W-point 170 90 CASE ( 'V', 'F' ) ; i012 = 1 ! V-, F-point 171 91 END SELECT 172 END SELECT92 ENDIF 173 93 ! 174 94 DO jj = 1, ipj_s(jf) 175 95 ij1 = ij1 + 1 176 96 jj_b(jj,jf) = ij1 177 jj_s(jj,jf) = jpj - 2* nn_hls + jj - i01297 jj_s(jj,jf) = jpj - 2*khls + jj - i012 178 98 END DO 179 99 ! … … 188 108 ij2 = jj_s(jj,jf) 189 109 DO ji = 1, jpi 190 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) 191 111 END DO 192 112 DO ji = jpi+1, jpimax 193 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) 194 114 END DO 195 115 END DO … … 203 123 iproc = nfproc(isendto(jr)) 204 124 IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 205 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 206 128 ENDIF 207 129 END DO … … 216 138 ipi = nfjpi (ipni) 217 139 ! 218 IF( ipni == 1 ) THEN ; iis0 = 1 219 ELSE ; iis0 = 1 + nn_hls ! default: -> from inner domain220 ENDIF 221 IF( ipni == jpni ) THEN ; iie0 = ipi 222 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 223 145 ENDIF 224 146 impp = nfimpp(ipni) - nfimpp(isendto(1)) … … 234 156 ij2 = jj_s(jj,jf) 235 157 DO ji = iis0, iie0 236 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 237 159 END DO 238 160 END DO … … 255 177 ij2 = jj_s(jj,jf) 256 178 DO ji = iis0, iie0 257 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) 258 180 END DO 259 181 END DO … … 262 184 ELSE ! get data from a neighbour trough communication 263 185 ! 264 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 265 189 DO jl = 1, ipl ; DO jk = 1, ipk 266 190 DO jj = 1, ipj_b … … 282 206 ij1 = jj_b( 1 ,jf) 283 207 ij2 = jj_b(ipj_s(jf),jf) 284 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 ) 285 209 END DO 286 210 ! … … 290 214 iproc = nfproc(isendto(jr)) 291 215 IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 292 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 293 217 ENDIF 294 218 END DO … … 298 222 ! 299 223 ! how many lines do we exchange at max? -> ipj (no further optimizations in this case...) 300 ipj = nn_hls + 2224 ipj = khls + 2 301 225 ! how many lines do we need at max? -> ipj2 (no further optimizations in this case...) 302 ipj2 = 2 * nn_hls + 2303 ! 304 i0max = jpimax - 2 * nn_hls226 ipj2 = 2 * khls + 2 227 ! 228 i0max = jpimax - 2 * khls 305 229 ibuffsize = i0max * ipj * ipk * ipl * ipf 306 230 ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) ) … … 311 235 DO ji = 1, Ni_0 312 236 ii2 = Nis0 - 1 + ji ! inner domain: Nis0 to Nie0 313 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) 314 238 END DO 315 239 DO ji = Ni_0+1, i0max 316 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) 317 241 END DO 318 242 END DO … … 321 245 ! start waiting time measurement 322 246 IF( ln_timing ) CALL tic_tac(.TRUE.) 323 #if defined key_mpp_mpi247 #if ! defined key_mpi_off 324 248 CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 325 249 #endif … … 327 251 IF( ln_timing ) CALL tic_tac(.FALSE.) 328 252 DEALLOCATE( znorthloc ) 329 ALLOCATE( ztabglo(jpiglo,ipj2,ipk,ipl,ipf) ) 330 ! 331 ! 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 332 259 ijnr = 0 333 260 DO jr = 1, jpni ! recover the global north array 334 261 iproc = nfproc(jr) 335 262 impp = nfimpp(jr) 336 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 337 264 IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed) 338 265 ! … … 344 271 ij2 = jpj - ipj2 + jj ! the first ipj lines of the last ipj2 lines 345 272 DO ji = 1, ipi 346 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc347 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 348 275 END DO 349 276 END DO … … 353 280 DO jj = 1, ipj 354 281 DO ji = 1, ipi 355 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc356 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 357 284 END DO 358 285 END DO … … 365 292 DO jj = 1, ipj 366 293 DO ji = 1, ipi 367 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc368 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) 369 296 END DO 370 297 END DO … … 376 303 ! 377 304 DO jf = 1, ipf 378 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 379 306 DO jl = 1, ipl ; DO jk = 1, ipk ! e-w periodicity 380 DO jj = 1, nn_hls + 1381 ij1 = ipj2 - ( nn_hls + 1) + jj ! need only the last nn_hls + 1 lines until ipj2382 ztabglo( 1:nn_hls,ij1,jk,jl,jf) = ztabglo(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl,jf)383 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) 384 311 END DO 385 312 END DO ; END DO … … 387 314 ! 388 315 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ! Scatter back to ARRAY_IN 389 DO jj = 1, nn_hls + 1390 ij1 = jpj - ( nn_hls + 1) + jj ! last nn_hls + 1 lines until jpj391 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 392 319 DO ji= 1, jpi 393 320 ii2 = mig(ji) 394 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) 395 322 END DO 396 323 END DO 397 324 END DO ; END DO ; END DO 398 325 ! 326 DO jf = 1, ipf 327 DEALLOCATE( ztabglo(jf)%pt4d ) 328 END DO 399 329 DEALLOCATE( ztabglo ) 400 330 ! 401 331 ENDIF ! l_north_nogather 402 332 ! 403 END SUBROUTINE ROUTINE_NFD333 END SUBROUTINE mpp_nfd_/**/PRECISION 404 334 405 #undef PRECISION406 #undef MPI_TYPE407 #undef SENDROUTINE408 #undef RECVROUTINE409 #undef ARRAY_TYPE410 #undef NAT_IN411 #undef SGN_IN412 #undef ARRAY_IN413 #undef K_SIZE414 #undef L_SIZE415 #undef F_SIZE416 #undef LBC_ARG417 #undef HUGEVAL
Note: See TracChangeset
for help on using the changeset viewer.
