Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! data_parsing.f90 is part of AstroBEAR. 00008 ! 00009 ! AstroBEAR is free software: you can redistribute it and/or modify 00010 ! it under the terms of the GNU General Public License as published by 00011 ! the Free Software Foundation, either version 3 of the License, or 00012 ! (at your option) any later version. 00013 ! 00014 ! AstroBEAR is distributed in the hope that it will be useful, 00015 ! but WITHOUT ANY WARRANTY; without even the implied warranty of 00016 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 ! GNU General Public License for more details. 00018 ! 00019 ! You should have received a copy of the GNU General Public License 00020 ! along with AstroBEAR. If not, see <http://www.gnu.org/licenses/>. 00021 ! 00022 !######################################################################### 00025 00031 00036 MODULE DataParsing 00037 00038 USE MPIPacking 00039 USE MessageDeclarations 00040 USE DataInfoOps 00041 USE TreeDeclarations 00042 IMPLICIT NONE 00043 00044 CONTAINS 00045 00048 00053 INTEGER FUNCTION SendChildrenData_Precalculate(level, node, child) 00054 00055 INTEGER :: level 00056 TYPE(NodeDef), POINTER :: node 00057 TYPE(NodeDef), POINTER :: child 00058 00059 INTEGER, DIMENSION(3,2) :: mB 00060 INTEGER, DIMENSION(3,2) :: ip 00061 INTEGER :: accumulator 00062 INTEGER :: rmbc 00063 00064 ! child%box%mGlobal 00065 accumulator = (6 * PACK_INTEGER_SIZE) 00066 00067 IF (level > -1) THEN 00068 rmbc=levels(level)%pmbc 00069 ! node%info%qChild 00070 mB = GetChildmBounds(node, child%box%mGlobal, level) 00071 ip = stretch(mB, rmbc) 00072 accumulator = accumulator + & 00073 (SIZE(node%info%qChild(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),1:nProlongate)) * PACK_DOUBLE_SIZE) 00074 00075 ! node%info%auxChild 00076 IF (MaintainAuxArrays) THEN 00077 ip = stretchaux(mB,rmbc) 00078 accumulator = accumulator + & 00079 (SIZE(node%info%auxChild(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),1:nAux)) * PACK_DOUBLE_SIZE) 00080 END IF 00081 00082 END IF 00083 00084 SendChildrenData_Precalculate = accumulator 00085 00086 END FUNCTION SendChildrenData_Precalculate 00087 00093 SUBROUTINE SendChildrenData(message, node, child) 00094 TYPE(NodeDef), POINTER :: node, child 00095 TYPE(PackedMessage), POINTER :: message 00096 INTEGER, DIMENSION(3,2) :: mB, ip 00097 INTEGER :: rmbc 00098 INTEGER :: counter = 0 00099 00100 CALL PackData(message, child%box%mGlobal) !Given the child - the parent can be found - but not vice-versa 00101 00102 IF (message%level > -1) THEN 00103 rmbc=levels(message%level)%pmbc 00104 mB=GetChildmBounds(node,child%box%mGlobal,message%level) 00105 ip=stretch(mB, rmbc) 00106 00107 CALL PackData(message, node%info%qChild(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),:)) 00108 IF (MaintainAuxArrays) THEN 00109 ip=stretchaux(mB,rmbc) 00110 00111 CALL PackData(message, node%info%auxChild(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),:)) 00112 END IF 00113 END IF 00114 END SUBROUTINE SendChildrenData 00115 00119 INTEGER FUNCTION RecvParentsData_Precalculate(parent_level, node) 00120 00121 INTEGER :: parent_level 00122 TYPE(NodeDef), POINTER :: node 00123 00124 INTEGER :: accumulator 00125 INTEGER, DIMENSION(3,2) :: mB 00126 INTEGER, DIMENSION(3,2) :: ip 00127 INTEGER, DIMENSION(3) :: ip_mx 00128 INTEGER :: rmbc 00129 00130 ! Add the size of the child grid, which will be sent over and caught by StrictGetNextBox(). 00131 accumulator = (6 * PACK_INTEGER_SIZE) 00132 00133 IF (parent_level > -1) THEN 00134 rmbc=levels(parent_level)%pmbc 00135 ! Use the node's bounds within its parent to calculate the dimensions of the prolongated parent data that will 00136 ! be sent over. 00137 mB = LevelDown(node%box%mGlobal, parent_level+1, parent_level) 00138 ip = stretch(mB, rmbc) 00139 00140 ip_mx = ip(:,2) - ip(:,1) + 1 00141 00142 ! parent%info%qChild 00143 accumulator = accumulator + (PRODUCT(ip_mx) * nProlongate * PACK_DOUBLE_SIZE) 00144 00145 ! parent%info%auxChild 00146 IF (MaintainAuxArrays) THEN 00147 ip = stretchaux(mB, rmbc) 00148 ip_mx = ip(:,2) - ip(:,1) + 1 00149 accumulator = accumulator + (PRODUCT(ip_mx) * nAux * PACK_DOUBLE_SIZE) 00150 END IF 00151 00152 END IF 00153 00154 RecvParentsData_Precalculate = accumulator 00155 00156 END FUNCTION RecvParentsData_Precalculate 00157 00158 00162 SUBROUTINE RecvParentsData(message) 00163 TYPE(NodeDef), POINTER :: node, parent 00164 TYPE(PackedMessage), POINTER :: message 00165 TYPE(NodeBox) :: node_box 00166 INTEGER :: level 00167 INTEGER, DIMENSION(3,2) :: mB, ip 00168 TYPE(InfoDef), POINTER :: ParentInfo 00169 INTEGER :: rmbc 00170 00171 node_box%MPI_ID=MPI_ID 00172 level=message%level+1 00173 rmbc=levels(message%level)%pmbc 00174 DO WHILE(StrictGetNextBox(message, node_box%mGlobal, "RecvParentsData")) 00175 00176 CALL StrictFindNode(level,node_box,node, "RecvParentsData(node)") 00177 parent=>node%parent 00178 00179 ALLOCATE(parentInfo) 00180 CALL NullifyInfoFields(parentInfo) 00181 00182 IF (message%level > -1) THEN 00183 mB=node%Info%mBounds 00184 00185 ip=stretch(mB,rmbc) 00186 00187 ALLOCATE(parentInfo%qChild(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),nProlongate)) 00188 00189 CALL UnPackData(message, parentInfo%qChild) 00190 00191 IF (MaintainAuxArrays) THEN 00192 ip=stretchaux(mB,rmbc) 00193 ALLOCATE(parentInfo%auxChild(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),nAux)) 00194 CALL UnPackData(message, parentInfo%auxChild) 00195 END IF 00196 END IF 00197 00198 CALL ProlongateParentData(ParentInfo, Node%Info) 00199 IF (message%level > -1) THEN 00200 DEALLOCATE(parentInfo%qChild) 00201 IF (MaintainAuxArrays) DEALLOCATE(parentInfo%auxChild) 00202 END IF 00203 DEALLOCATE(parentInfo) 00204 00205 END DO 00206 00207 END SUBROUTINE RecvParentsData 00209 00212 00213 00218 INTEGER FUNCTION SendOverlapData_Precalculate(level, node, overlap) 00219 00220 INTEGER :: level 00221 TYPE(NodeDef), POINTER :: node 00222 TYPE(NodeDef), POINTER :: overlap 00223 00224 INTEGER :: accumulator 00225 INTEGER, DIMENSION(3,2) :: mT, mS 00226 INTEGER, POINTER, DIMENSION(:,:,:) :: mTs, mSs 00227 INTEGER :: nOverlaps,i,dir,j 00228 INTEGER :: EGCopyFieldsSize 00229 00230 00231 ! Add the size of overlap%box%mGlobal. 00232 accumulator = PACK_BOX_SIZE 00233 00234 IF (level > -1) THEN 00235 00236 CALL CalcOverlaps(overlap%box%mGlobal, node%box%mGlobal, mTs, mSs, nOverlaps, level, lHydroPeriodic, levels(level)%gmbc(levels(level)%step)) 00237 00238 ! nOverlaps again. 00239 accumulator = accumulator + PACK_INTEGER_SIZE 00240 00241 IF (nOverlaps > 0) THEN 00242 !Add the size of the overlap arrays. 00243 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 00244 00245 DO i=1,nOverlaps 00246 mS=mSs(i,:,:) 00247 mT=mTs(i,:,:) 00248 00249 ! node%info%q using overlap source boundaries and the size of the GCopyFields array. 00250 accumulator = accumulator + (PRODUCT(mS(:,2) - mS(:,1) + 1) * GVars * PACK_DOUBLE_SIZE) 00251 00252 END DO 00253 00254 DEALLOCATE(mTs,mSs) 00255 NULLIFY(mTs,mSs) 00256 END IF 00257 00258 00259 IF (level > BaseLevel .AND. ((level == 0 .AND. levels(level)%step <= 1) .OR. levels(level)%step > 1) .AND. EGVars > 0) THEN 00260 ! IF (level >= BaseLevel .AND. (level == 0 .OR. levels(level)%step > 1) .AND. EGVars > 0) THEN 00261 00262 CALL CalcOverlaps(overlap%box%mGlobal, node%box%mGlobal, mTs, mSs, nOverlaps, level, lEllipticPeriodic, levels(level)%egmbc(levels(level)%step)) 00263 00264 ! nOverlaps again. 00265 accumulator = accumulator + PACK_INTEGER_SIZE 00266 00267 IF (nOverlaps > 0) THEN 00268 !Add the size of the overlap arrays. 00269 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 00270 00271 EGCopyFieldsSize = SIZE(EGCopyFields) 00272 00273 DO i=1,nOverlaps 00274 mS=mSs(i,:,:) 00275 00276 accumulator = accumulator + (PRODUCT(mS(:,2) - mS(:,1) + 1) * EGCopyFieldsSize * PACK_DOUBLE_SIZE) 00277 END DO 00278 DEALLOCATE(mTs,mSs) 00279 NULLIFY(mTs,mSs) 00280 END IF 00281 END IF 00282 00283 IF (MaintainAuxArrays) THEN 00284 DO dir=1,nDim 00285 CALL CalcAuxOverlaps(overlap%box%mGlobal, node%box%mGlobal, mTs, mSs, nOverlaps, level, dir,lHydroPeriodic) 00286 00287 ! nOverlaps again. 00288 accumulator = accumulator + PACK_INTEGER_SIZE 00289 00290 IF (nOverlaps > 0) THEN 00291 !Add the size of the overlap arrays. 00292 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 00293 00294 DO i=1,nOverlaps 00295 mS=mSs(i,:,:) 00296 ! node%info%aux using overlap source dimensions and the dir array. 00297 accumulator = accumulator + (PRODUCT(mS(:,2) - mS(:,1) + 1) * PACK_DOUBLE_SIZE) 00298 END DO 00299 00300 DEALLOCATE(mTs,mSs) 00301 NULLIFY(mTs,mSs) 00302 END IF 00303 END DO 00304 END IF 00305 00306 END IF 00307 SendOverlapData_Precalculate = accumulator 00308 00309 END FUNCTION SendOverlapData_Precalculate 00310 00311 00317 SUBROUTINE SendOverlapData(message, node, overlap) 00318 TYPE(NodeDef), POINTER :: node, overlap 00319 TYPE(PackedMessage), POINTER :: message 00320 INTEGER, DIMENSION(3,2) :: mT, mS 00321 INTEGER, POINTER, DIMENSION(:,:,:) :: mTs, mSs 00322 INTEGER :: nOverlaps,i,dir,j 00323 00324 CALL PackData(message, overlap%box%mGlobal) 00325 00326 IF (message%level > -1) THEN 00327 00328 CALL CalcOverlaps(overlap%box%mGlobal, node%box%mGlobal,mTs,mSs,nOverlaps,message%level,lHydroPeriodic, levels(message%level)%gmbc(levels(message%level)%step)) 00329 CALL PackData(message, nOverlaps) 00330 00331 IF (nOverlaps > 0) THEN 00332 CALL PackData(message, mTs) 00333 CALL PackData(message, mSs) 00334 00335 DO i=1,nOverlaps 00336 mT=mTs(i,:,:) 00337 mS=mSs(i,:,:) 00338 CALL PackData(message, node%info%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),GCopyFields)) 00339 00340 END DO 00341 DEALLOCATE(mTs,mSs) 00342 NULLIFY(mTs,mSs) 00343 END IF 00344 00345 IF (message%level > BaseLevel .AND. ((message%level == 0 .AND. levels(message%level)%step <= 1) .OR. levels(message%level)%step > 1) .AND. EGVars > 0) THEN 00346 ! IF (message%level >= BaseLevel .AND. (message%level == 0 .OR. levels(message%level)%step > 1) .AND. EGVars > 0) THEN 00347 00348 CALL CalcOverlaps(overlap%box%mGlobal, node%box%mGlobal,mTs,mSs,nOverlaps,message%level, lEllipticPeriodic, levels(message%level)%egmbc(levels(message%level)%step)) 00349 CALL PackData(message, nOverlaps) 00350 00351 IF (nOverlaps > 0) THEN 00352 CALL PackData(message, mTs) 00353 CALL PackData(message, mSs) 00354 00355 DO i=1,nOverlaps 00356 mT=mTs(i,:,:) 00357 mS=mSs(i,:,:) 00358 DO j=1,size(EGCopyFields) 00359 CALL PackData(message, node%info%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),EGCopyFields(j))) 00360 END DO 00361 END DO 00362 DEALLOCATE(mTs,mSs) 00363 NULLIFY(mTs,mSs) 00364 END IF 00365 END IF 00366 00367 IF (MaintainAuxArrays) THEN 00368 DO dir=1,nDim 00369 CALL CalcAuxOverlaps(overlap%box%mGlobal, node%box%mGlobal,mTs,mSs,nOverlaps,message%level,dir,lHydroPeriodic) 00370 CALL PackData(message, nOverlaps) 00371 00372 IF (nOverlaps > 0) THEN 00373 CALL PackData(message, mTs) 00374 CALL PackData(message, mSs) 00375 00376 DO i=1,nOverlaps 00377 mT=mTs(i,:,:) 00378 mS=mSs(i,:,:) 00379 CALL PackData(message, node%info%aux(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),dir:dir)) 00380 00381 END DO 00382 DEALLOCATE(mTs,mSs) 00383 NULLIFY(mTs,mSs) 00384 END IF 00385 END DO 00386 END IF 00387 00388 END IF 00389 00390 END SUBROUTINE SendOverlapData 00391 00396 INTEGER FUNCTION RecvOverlapData_Precalculate(level, node, overlap) 00397 00398 INTEGER :: level 00399 TYPE(NodeDef), POINTER :: node 00400 TYPE(NodeDef), POINTER :: overlap 00401 00402 INTEGER :: accumulator 00403 INTEGER, DIMENSION(3,2) :: mT, mS 00404 INTEGER, POINTER, DIMENSION(:,:,:) :: mTs, mSs 00405 INTEGER :: nOverlaps,i,dir,j 00406 INTEGER :: EGCopyFieldsSize 00407 00408 00409 ! The size of a localnodebox global array. 00410 accumulator = 6 * PACK_INTEGER_SIZE 00411 00412 IF (level > -1) THEN 00413 00414 CALL CalcOverlaps(node%box%mGlobal, overlap%box%mGlobal, mTs, mSs, nOverlaps, & 00415 level, lHydroPeriodic, levels(level)%gmbc(levels(level)%step)) 00416 00417 ! nOverlaps 00418 accumulator = accumulator + PACK_INTEGER_SIZE 00419 00420 IF (nOverlaps > 0) THEN 00421 00422 !Add the size of the overlap arrays. 00423 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 00424 00425 DO i=1,nOverlaps 00426 mS=mSs(i,:,:) 00427 mT=mTs(i,:,:) 00428 00429 ! overlapInfo%q using source array and Gvars field. 00430 accumulator = accumulator + (PRODUCT(mS(:,2) - mS(:,1) + 1) * GVars * PACK_DOUBLE_SIZE) 00431 END DO 00432 00433 DEALLOCATE(mTs,mSs) 00434 NULLIFY(mTs,mSs) 00435 END IF 00436 00437 IF (level > BaseLevel .AND. ((level == 0 .AND. levels(level)%step <= 1) .OR. levels(level)%step > 1) .AND. EGVars > 0) THEN 00438 ! IF (level >= BaseLevel .AND. (level == 0 .OR. levels(level)%step > 1) .AND. EGVars > 0) THEN 00439 00440 CALL CalcOverlaps(node%box%mGlobal, overlap%box%mGlobal, mTs, mSs, nOverlaps, level, lEllipticPeriodic, levels(level)%egmbc(levels(level)%step)) 00441 00442 ! nOverlaps 00443 accumulator = accumulator + PACK_INTEGER_SIZE 00444 00445 IF (nOverlaps > 0) THEN 00446 00447 !Add the size of the overlap arrays. 00448 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 00449 00450 DO i=1,nOverlaps 00451 mS=mSs(i,:,:) 00452 DO j=1,EGVars 00453 ! overlapInfo%q using source array and EGCopyFields(j) field. 00454 accumulator = accumulator + (PRODUCT(mS(:,2) - mS(:,1) + 1) * PACK_DOUBLE_SIZE) 00455 END DO 00456 END DO 00457 00458 DEALLOCATE(mTs,mSs) 00459 NULLIFY(mTs,mSs) 00460 END IF 00461 END IF 00462 00463 IF (MaintainAuxArrays) THEN 00464 DO dir=1,nDim 00465 CALL CalcAuxOverlaps(node%box%mGlobal, overlap%box%mGlobal, mTs, mSs, nOverlaps, level, dir,lHydroPeriodic) 00466 00467 ! nOverlaps again. 00468 accumulator = accumulator + PACK_INTEGER_SIZE 00469 00470 IF (nOverlaps > 0) THEN 00471 !Add the size of the overlap arrays. 00472 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 00473 DO i=1,nOverlaps 00474 mS=mSs(i,:,:) 00475 ! overlapInfo%aux using source array and dir field. 00476 accumulator = accumulator + (PRODUCT(mS(:,2) - mS(:,1) + 1) * PACK_DOUBLE_SIZE) 00477 END DO 00478 00479 DEALLOCATE(mTs,mSs) 00480 NULLIFY(mTs,mSs) 00481 END IF 00482 END DO 00483 END IF 00484 END IF 00485 RecvOverlapData_Precalculate = accumulator 00486 00487 END FUNCTION RecvOverlapData_Precalculate 00488 00491 SUBROUTINE RecvOverlaps(message) 00492 TYPE(NodeDef), POINTER :: node 00493 TYPE(PackedMessage), POINTER :: message 00494 TYPE(InfoDef) :: overlapInfo 00495 TYPE(NodeBox) :: localnodebox 00496 INTEGER :: level, nOverlaps,i,dir 00497 INTEGER, DIMENSION(:,:,:), POINTER :: mTs, mSs 00498 INTEGER, DIMENSION(3,2) :: mT, mS 00499 00500 INTEGER :: j 00501 00502 00503 localnodebox%MPI_ID=MPI_ID 00504 level=message%level 00505 DO WHILE(StrictGetNextBox(message, localnodebox%mGlobal, "RecvOverlaps")) 00506 00507 CALL NullifyInfoFields(overlapInfo) 00508 00509 CALL StrictFindNode(level, localnodebox,node, "RecvOverlaps(node)") 00510 00511 IF (message%level > -1) THEN 00512 CALL UnPackData(message, nOverlaps) 00513 IF (nOverlaps > 0) THEN 00514 ALLOCATE(mTs(nOverlaps,3,2),mSs(nOverlaps,3,2)) 00515 CALL UnPackData(message, mTs) 00516 CALL UnPackData(message, mSs) 00517 00518 DO i=1,nOverlaps 00519 mT=mTs(i,:,:) 00520 mS=mSs(i,:,:) 00521 ALLOCATE(overlapinfo%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),GVars)) 00522 CALL UnPackData(message, overlapinfo%q) 00523 CALL ApplySingleOverlap(node%info,overlapInfo,mS,mT,GCopyFields) 00524 DEALLOCATE(overlapInfo%q) 00525 NULLIFY(overlapInfo%q) 00526 END DO 00527 DEALLOCATE(mTs,mSs) 00528 NULLIFY(mTs,mSs) 00529 END IF 00530 00531 IF (message%level > BaseLevel .AND. ((message%level == 0 .AND. levels(message%level)%step <= 1) .OR. levels(message%level)%step > 1) .AND. EGVars > 0) THEN 00532 ! IF (message%level >= BaseLevel .AND. (message%level == 0 .OR. levels(message%level)%step > 1) .AND. EGVars > 0) THEN 00533 00534 CALL UnPackData(message, nOverlaps) 00535 00536 IF (nOverlaps > 0) THEN 00537 ALLOCATE(mTs(nOverlaps,3,2),mSs(nOverlaps,3,2)) 00538 CALL UnPackData(message, mTs) 00539 CALL UnPackData(message, mSs) 00540 00541 DO i=1,nOverlaps 00542 mT=mTs(i,:,:) 00543 mS=mSs(i,:,:) 00544 DO j=1,EGVars 00545 ALLOCATE(overlapinfo%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),EGCopyFields(j):EGCopyFields(j))) 00546 CALL UnPackData(message, overlapinfo%q) 00547 CALL ApplySingleOverlap(node%info,overlapInfo,mS,mT,EGCopyFields(j:j)) 00548 DEALLOCATE(overlapInfo%q) 00549 NULLIFY(overlapInfo%q) 00550 END DO 00551 END DO 00552 DEALLOCATE(mTs,mSs) 00553 NULLIFY(mTs,mSs) 00554 END IF 00555 END IF 00556 00557 IF (MaintainAuxArrays) THEN 00558 DO dir=1,nDim 00559 CALL UnPackData(message, nOverlaps) 00560 IF (nOverlaps > 0) THEN 00561 ALLOCATE(mTs(nOverlaps,3,2),mSs(nOverlaps,3,2)) 00562 CALL UnPackData(message, mTs) 00563 CALL UnPackData(message, mSs) 00564 DO i=1,nOverlaps 00565 mT=mTs(i,:,:) 00566 mS=mSs(i,:,:) 00567 ALLOCATE(overlapinfo%aux(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),dir:dir)) 00568 CALL UnPackData(message, overlapinfo%aux) 00569 CALL ApplySingleAuxOverlap(node%info,overlapInfo,mS,mT,dir) 00570 DEALLOCATE(overlapInfo%aux) 00571 NULLIFY(overlapInfo%aux) 00572 END DO 00573 DEALLOCATE(mTs,mSs) 00574 NULLIFY(mTs,mSs) 00575 END IF 00576 END DO 00577 END IF 00578 END IF 00579 END DO 00580 END SUBROUTINE RecvOverlaps 00581 00583 00586 00591 INTEGER FUNCTION SendParentsData_Precalculate(child_level, parent, node) 00592 00593 INTEGER :: child_level 00594 TYPE(NodeDef), POINTER :: parent 00595 TYPE(NodeDef), POINTER :: node 00596 00597 INTEGER :: accumulator 00598 INTEGER, DIMENSION(3,2) :: ip 00599 INTEGER, DIMENSION(3) :: ip_mx 00600 INTEGER :: n 00601 00602 00603 ! Initializes the accumulator with the cost of the node's global array. 00604 accumulator = 6 * PACK_INTEGER_SIZE 00605 00606 IF (child_level > 0) THEN 00607 00608 ip = GetChildmBounds(parent,node%box%mGlobal,child_level - 1) 00609 00610 ip_mx(:) = ip(:,2) - ip(:,1) + 1 00611 00612 ! The cost of the child's parentEMF fields. 00613 IF (MaintainAuxArrays) THEN 00614 ip_mx(1:nDim)=ip_mx(1:nDim)+1 00615 accumulator = accumulator + (PRODUCT(ip_mx) * nEMF * PACK_DOUBLE_SIZE) 00616 ip_mx(1:nDim)=ip_mx(1:nDim)-1 00617 END IF 00618 00619 accumulator = accumulator + (PRODUCT(ip_mx) * nRestrict * PACK_DOUBLE_SIZE) 00620 00621 ! The projected cost of the parentFixup data that will be transferred from the child. 00622 DO n=1,nDim 00623 ip_mx(n) = 2 ! The AllocBoundary() routine would set the array size along this dimension to 2. 00624 accumulator = accumulator + (PRODUCT(ip_mx) * nFlux * PACK_DOUBLE_SIZE) 00625 ip_mx(n)=ip(n,2)-ip(n,1)+1 00626 END DO 00627 00628 END IF 00629 00630 SendParentsData_Precalculate = accumulator 00631 00632 END FUNCTION SendParentsData_Precalculate 00633 00638 SUBROUTINE SendParentsData(message, node) 00639 TYPE(NodeDef), POINTER :: node 00640 TYPE(PackedMessage), POINTER :: message 00641 00642 CALL PackData(message, node%box%mGlobal) !Child Box should already exit on the parent proc 00643 IF (message%level > -1) THEN 00644 IF (MaintainAuxArrays) CALL PackData(message, node%Info%ParentEMF) 00645 CALL PackData(message, node%Info%qParent) 00646 CALL PackData(message, node%Info%ParentFixup) 00647 END IF 00648 END SUBROUTINE SendParentsData 00649 00654 INTEGER FUNCTION RecvChildrenData_Precalculate(parent_level, node, child) 00655 INTEGER :: parent_level 00656 TYPE(NodeDef), POINTER :: node 00657 TYPE(NodeDef), POINTER :: child 00658 00659 INTEGER :: accumulator 00660 INTEGER, DIMENSION(3,2) :: ip 00661 INTEGER, DIMENSION(3) :: ip_mx 00662 INTEGER :: n 00663 00664 00665 ! Initialize the accumulator to the size of the child's six-integer global array. 00666 accumulator = 6 * PACK_INTEGER_SIZE 00667 00668 ip = GetChildmBounds(node,child%box%mGlobal,parent_level) 00669 ip_mx(:) = ip(:,2) - ip(:,1) + 1 00670 00671 ! On grid-level nodes, there will be EMF and fixup data to transfer to parents. This 00672 ! counts against the message size. 00673 IF (parent_level > -1) THEN 00674 00675 ! The cost of the child's parentEMF fields. 00676 IF (MaintainAuxArrays) THEN 00677 ip_mx(1:nDim)=ip_mx(1:nDim)+1 00678 accumulator = accumulator + (PRODUCT(ip_mx) * nEMF * PACK_DOUBLE_SIZE) 00679 ip_mx(1:nDim)=ip_mx(1:nDim)-1 00680 END IF 00681 00682 ! The cost of the qParent data. 00683 accumulator = accumulator + (PRODUCT(ip_mx) * nRestrict * PACK_DOUBLE_SIZE) 00684 00685 ! The projected cost of the parentFixup data that will be transferred from the child. 00686 DO n=1,nDim 00687 ip_mx(n) = 2 ! The AllocBoundary() routine would set the array size along this dimension to 2. 00688 accumulator = accumulator + (PRODUCT(ip_mx) * nFlux * PACK_DOUBLE_SIZE) 00689 ip_mx(n)=ip(n,2)-ip(n,1)+1 00690 END DO 00691 END IF 00692 00693 RecvChildrenData_Precalculate = accumulator 00694 00695 END FUNCTION RecvChildrenData_Precalculate 00696 00700 SUBROUTINE RecvChildrenData(message) 00701 TYPE(NodeDef), POINTER :: node, child 00702 TYPE(PackedMessage), POINTER :: message 00703 TYPE(NodeBox) :: childbox 00704 INTEGER :: level, j 00705 INTEGER, DIMENSION(3,2) :: ip 00706 TYPE(InfoDef), POINTER :: ChildInfo 00707 00708 00709 childbox%MPI_ID=message%remote_proc 00710 level=message%level 00711 00712 DO WHILE(StrictGetNextBox(message, childbox%mGlobal, "RecvChildrenData")) 00713 CALL StrictFindNode(level+1,childbox,child, "RecvChildrenData(child)") 00714 node=>child%parent 00715 00716 ALLOCATE(ChildInfo) 00717 CALL NullifyInfoFields(ChildInfo) 00718 ChildInfo%level=level+1 00719 ChildInfo%mBounds(:,:)=GetChildmBounds(node,childbox%mGlobal,level) 00720 ip=ChildInfo%mBounds 00721 00722 IF (level > -1) THEN 00723 ALLOCATE(ChildInfo%qParent(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),nRestrict)) 00724 00725 IF (MaintainAuxArrays) THEN 00726 ip(1:nDim,2)=ip(1:nDim,2)+1 00727 ALLOCATE(ChildInfo%parentEmf(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),1:nEMF)) 00728 CALL UnPackData(message, ChildInfo%ParentEmf) 00729 ip(1:nDim,2)=ip(1:nDim,2)-1 00730 END IF 00731 00732 CALL AllocBoundaries(ChildInfo%ParentFixup, ip) 00733 00734 CALL UnPackData(message, ChildInfo%qParent) 00735 CALL UnPackData(message, ChildInfo%ParentFixup) 00736 END IF 00737 00738 CALL ApplyChildData(node%info, ChildInfo, GetChildID(node, child), level) 00739 IF (level > -1) THEN 00740 DEALLOCATE(ChildInfo%qParent) 00741 IF (MaintainAuxArrays) THEN 00742 DEALLOCATE(ChildInfo%parentemf) 00743 END IF 00744 CALL DeAllocBoundaries(ChildInfo%ParentFixup) 00745 END IF 00746 DEALLOCATE(ChildInfo) 00747 NULLIFY(ChildInfo) 00748 END DO 00749 00750 END SUBROUTINE RecvChildrenData 00752 00755 00759 INTEGER FUNCTION SendParentsInitialData_Precalculate(child_level, node) 00760 00761 INTEGER :: child_level 00762 TYPE(NodeDef), POINTER :: node 00763 00764 INTEGER :: accumulator 00765 INTEGER, DIMENSION(3,2) :: ip 00766 INTEGER, DIMENSION(3) :: ip_mx 00767 INTEGER :: n 00768 00769 00770 ! Initializes the accumulator with the cost of the node's global array. 00771 accumulator = PACK_BOX_SIZE 00772 00773 00774 ! On grid-level nodes, there will be cell-centered and face-centered data to transfer to parents. This 00775 ! counts against the message size. 00776 IF (child_level > 0) THEN 00777 00778 ip = GetChildmBounds(node%parent,node%box%mGlobal,child_level - 1) 00779 ip_mx(:) = ip(:,2) - ip(:,1) + 1 00780 00781 accumulator = accumulator + (PRODUCT(ip_mx) * nRestrict * PACK_DOUBLE_SIZE) 00782 00783 IF (MaintainAuxArrays) THEN 00784 ip(1:nDim,2)=ip(1:nDim,2)+1 00785 ip_mx(:) = ip(:,2) - ip(:,1) + 1 00786 accumulator = accumulator + (PRODUCT(ip_mx) * nAux * PACK_DOUBLE_SIZE) 00787 ip(1:nDim,2)=ip(1:nDim,2)-1 00788 END IF 00789 END IF 00790 00791 SendParentsInitialData_Precalculate = accumulator 00792 00793 END FUNCTION SendParentsInitialData_Precalculate 00794 00799 SUBROUTINE SendParentsInitialData(message, node) 00800 TYPE(NodeDef), POINTER :: node 00801 TYPE(PackedMessage), POINTER :: message 00802 00803 CALL PackData(message, node%box%mGlobal) !Child Box should already exit on the parent proc 00804 00805 IF (message%level > -1) THEN 00806 CALL PackData(message, node%Info%qParent) 00807 IF (MaintainAuxArrays) CALL PackData(message, node%Info%auxParent) 00808 END IF 00809 00810 END SUBROUTINE SendParentsInitialData 00811 00816 INTEGER FUNCTION RecvInitialChildrenData_Precalculate(parent_level, node, child) 00817 INTEGER :: parent_level 00818 TYPE(NodeDef), POINTER :: node 00819 TYPE(NodeDef), POINTER :: child 00820 00821 INTEGER :: accumulator 00822 INTEGER, DIMENSION(3,2) :: ip 00823 INTEGER, DIMENSION(3) :: ip_mx 00824 INTEGER :: n 00825 00826 00827 accumulator = PACK_BOX_SIZE 00828 00829 00830 ! On grid-level nodes, there will be EMF and fixup data to transfer to parents. This 00831 ! counts against the message size. 00832 IF (parent_level > -1) THEN 00833 00834 ip = GetChildmBounds(node,child%box%mGlobal,parent_level) 00835 ip_mx(:) = ip(:,2) - ip(:,1) + 1 00836 00837 ! The cost of the qParent data. 00838 accumulator = accumulator + (PRODUCT(ip_mx) * nRestrict * PACK_DOUBLE_SIZE) 00839 00840 ! The cost of the child's parentEMF fields. 00841 IF (MaintainAuxArrays) THEN 00842 ip(1:nDim,2)=ip(1:nDim,2)+1 00843 ip_mx(:) = ip(:,2) - ip(:,1) + 1 00844 accumulator = accumulator + (PRODUCT(ip_mx) * nAux * PACK_DOUBLE_SIZE) 00845 ip(1:nDim,2)=ip(1:nDim,2)-1 00846 END IF 00847 00848 END IF 00849 00850 RecvInitialChildrenData_Precalculate = accumulator 00851 00852 END FUNCTION RecvInitialChildrenData_Precalculate 00853 00857 SUBROUTINE RecvInitialChildrenData(message) 00858 TYPE(NodeDef), POINTER :: node, child 00859 TYPE(PackedMessage), POINTER :: message 00860 TYPE(NodeBox) :: childbox 00861 INTEGER :: level 00862 INTEGER, DIMENSION(3,2) :: ip 00863 TYPE(InfoDef), POINTER :: ChildInfo 00864 00865 childbox%MPI_ID=message%remote_proc 00866 level=message%level 00867 00868 DO WHILE(StrictGetNextBox(message, childbox%mGlobal, "RecvInitialChildrenData")) 00869 00870 NULLIFY(child) 00871 CALL StrictFindNode(level+1,childbox,child, "RecvInitialChildrenData(child)") 00872 00873 node=>child%parent 00874 00875 ALLOCATE(ChildInfo) 00876 CALL NullifyInfoFields(ChildInfo) 00877 00878 ChildInfo%level=level+1 00879 ChildInfo%mBounds(:,:)=GetChildmBounds(node,childbox%mGlobal,level) 00880 ip=ChildInfo%mBounds 00881 00882 IF (level > -1) THEN 00883 ALLOCATE(ChildInfo%qParent(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),nRestrict)) 00884 CALL UnPackData(message, ChildInfo%qParent) 00885 00886 IF (MaintainAuxArrays) THEN 00887 ip(1:nDim,2)=ip(1:nDim,2)+1 00888 ALLOCATE(ChildInfo%auxParent(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),nAux)) 00889 CALL UnPackData(message, ChildInfo%auxParent) 00890 END IF 00891 END IF 00892 00893 CALL ApplyInitialChildData(node%info, ChildInfo, level) 00894 IF (level > -1) THEN 00895 DEALLOCATE(ChildInfo%qParent) 00896 IF (MaintainAuxArrays) THEN 00897 DEALLOCATE(ChildInfo%auxParent) 00898 END IF 00899 END IF 00900 DEALLOCATE(ChildInfo) 00901 NULLIFY(ChildInfo) 00902 00903 END DO 00904 00905 END SUBROUTINE RecvInitialChildrenData 00906 00908 00913 INTEGER FUNCTION SendFluxes_Precalculate(level, node, neighbor) 00914 00915 INTEGER :: level 00916 TYPE(NodeDef), POINTER :: node 00917 TYPE(NodeDef), POINTER :: neighbor 00918 INTEGER :: dir,nOverlaps,i,edge 00919 INTEGER, DIMENSION(:,:,:), POINTER :: mTs, mSs 00920 INTEGER, DIMENSION(3,2) :: mT, mS,ip 00921 INTEGER, DIMENSION(:), POINTER :: edges 00922 INTEGER, DIMENSION(:,:), POINTER :: Offsets 00923 INTEGER :: accumulator 00924 INTEGER, DIMENSION(3) :: ip_mx 00925 INTEGER, DIMENSION(3) :: ms_mx 00926 00927 00928 ! node%box%mGlobal size. 00929 accumulator = 6 * PACK_INTEGER_SIZE 00930 00931 ! neighbor%box%mGlobal size. 00932 accumulator = accumulator + 6 * PACK_INTEGER_SIZE 00933 00934 DO dir=1,nDim 00935 00936 ! Calculates the flux overlaps. 00937 CALL CalcFluxOverlaps(neighbor%box%mGlobal, node%box%mGlobal,mTs,mSs,edges,nOverlaps,level,dir,lHydroPeriodic) 00938 00939 ! Holds the number of overlaps. 00940 accumulator = accumulator + PACK_INTEGER_SIZE 00941 00942 IF (nOverlaps > 0) THEN 00943 00944 !Add the size of the overlap and edge arrays. 00945 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs) + SIZE(edges)) * PACK_INTEGER_SIZE) 00946 00947 DO i=1,nOverlaps 00948 mT=mTs(i,:,:) 00949 mS=mSs(i,:,:) 00950 edge=edges(i) 00951 ip=mS 00952 ip(dir,:)=3-edge 00953 00954 ip_mx(:) = ip(:,2) - ip(:,1) + 1 00955 00956 ! Add space for the contents of a single fixup flux side (node%info%fixupflux%side(dir)%data). 00957 accumulator = accumulator + (PRODUCT(ip_mx) * SIZE(node%info%fixupflux%side(dir)%data, 4) * PACK_DOUBLE_SIZE) 00958 00959 END DO 00960 00961 DEALLOCATE(mTs,mSs,edges) 00962 NULLIFY(mTs,mSs,edges) 00963 END IF 00964 END DO 00965 00966 IF (MaintainAuxArrays) THEN 00967 DO dir=1,nEMF 00968 CALL CalcEmfOverlaps(neighbor%box%mGlobal,node%box%mGlobal,mTs,mSs,nOverlaps,offsets, level,EmfDir(dir),lHydroPeriodic) 00969 00970 ! Another nOverlaps value. 00971 accumulator = accumulator + PACK_INTEGER_SIZE 00972 00973 IF (nOverlaps > 0) THEN 00974 00975 !Add the size of the overlap and offset arrays. 00976 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs) + SIZE(offsets)) * PACK_INTEGER_SIZE) 00977 00978 DO i=1,nOverlaps 00979 mT=mTs(i,:,:) 00980 mS=mSs(i,:,:) 00981 00982 ! node%Info%emf 00983 ms_mx(:) = mS(:,2) - mS(:,1) + 1 00984 accumulator = accumulator + PRODUCT(ms_mx) * PACK_DOUBLE_SIZE 00985 END DO 00986 00987 DEALLOCATE(mTs,mSs,offsets) 00988 NULLIFY(mTs,mSs,offsets) 00989 END IF 00990 END DO 00991 END IF 00992 00993 SendFluxes_Precalculate = accumulator 00994 00995 END FUNCTION SendFluxes_Precalculate 00996 00999 01004 SUBROUTINE SendFluxes(message, node, neighbor) 01005 TYPE(NodeDef), POINTER :: node, neighbor 01006 TYPE(PackedMessage), POINTER :: message 01007 INTEGER :: dir,nOverlaps,i,edge 01008 INTEGER, DIMENSION(:,:,:), POINTER :: mTs, mSs 01009 INTEGER, DIMENSION(3,2) :: mT, mS,ip 01010 INTEGER, DIMENSION(:), POINTER :: edges 01011 INTEGER, DIMENSION(:,:), POINTER :: Offsets 01012 01013 01014 CALL PackData(message, neighbor%box%mGlobal) 01015 CALL PackData(message, node%box%mGlobal) 01016 DO dir=1,nDim 01017 CALL CalcFluxOverlaps(neighbor%box%mGlobal, node%box%mGlobal,mTs,mSs,edges,nOverlaps,message%level,dir,lHydroPeriodic) 01018 CALL PackData(message, nOverlaps) 01019 IF (nOverlaps > 0) THEN 01020 CALL PackData(message, mTs) 01021 CALL PackData(message, mSs) 01022 CALL PackData(message, edges) 01023 DO i=1,nOverlaps 01024 mT=mTs(i,:,:) 01025 mS=mSs(i,:,:) 01026 edge=edges(i) 01027 ip=mS 01028 ip(dir,:)=3-edge 01029 01030 CALL PackData(message, node%info%fixupflux%side(dir)%data(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),:)) 01031 END DO 01032 DEALLOCATE(mTs,mSs,edges) 01033 NULLIFY(mTs,mSs,edges) 01034 END IF 01035 END DO 01036 IF (MaintainAuxArrays) THEN 01037 DO dir=1,nEMF 01038 CALL CalcEmfOverlaps(neighbor%box%mGlobal,node%box%mGlobal,mTs,mSs,nOverlaps,offsets,message%level,EmfDir(dir), lHydroPeriodic) 01039 CALL PackData(message, nOverlaps) 01040 IF (nOverlaps > 0) THEN 01041 CALL PackData(message, mTs) 01042 CALL PackData(message, mSs) 01043 CALL PackData(message, offsets) 01044 DO i=1,nOverlaps 01045 mT=mTs(i,:,:) 01046 mS=mSs(i,:,:) 01047 01048 CALL PackData(message,node%info%emf(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),EmfLoc(emfdir(dir)):EmfLoc(emfdir(dir)))) 01049 END DO 01050 DEALLOCATE(mTs,mSs,offsets) 01051 NULLIFY(mTs,mSs,offsets) 01052 END IF 01053 END DO 01054 END IF 01055 END SUBROUTINE SendFluxes 01056 01057 01062 INTEGER FUNCTION RecvFluxes_Precalculate(level, node, neighbor) 01063 01064 INTEGER :: level 01065 TYPE(NodeDef), POINTER :: node 01066 TYPE(NodeDef), POINTER :: neighbor 01067 01068 INTEGER :: dir,nOverlaps,i,edge,j 01069 INTEGER, DIMENSION(:,:,:), POINTER :: mTs, mSs 01070 INTEGER, DIMENSION(3,2) :: mT, mS,ip 01071 INTEGER, DIMENSION(:), POINTER :: edges 01072 INTEGER, DIMENSION(:,:), POINTER :: Offsets 01073 INTEGER, DIMENSION(3) :: offset 01074 01075 INTEGER :: accumulator 01076 INTEGER, DIMENSION(3) :: ip_mx 01077 INTEGER, DIMENSION(3) :: ms_mx 01078 01079 01080 ! neighbor mGlobal 01081 accumulator = 6 * PACK_INTEGER_SIZE 01082 01083 ! node mGlobal 01084 accumulator = accumulator + 6 * PACK_INTEGER_SIZE 01085 01086 DO dir=1,nDim 01087 01088 ! Unpack nOverlaps 01089 accumulator = accumulator + PACK_INTEGER_SIZE 01090 01091 ! Calculates the flux overlaps (reversed from SendFluxes). 01092 CALL CalcFluxOverlaps(node%box%mGlobal, neighbor%box%mGlobal,mTs,mSs,edges,nOverlaps,level,dir,lHydroPeriodic) 01093 01094 IF (nOverlaps > 0) THEN 01095 01096 !Add the size of the overlap and edge arrays. 01097 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs) + SIZE(edges)) * PACK_INTEGER_SIZE) 01098 01099 DO i=1,nOverlaps 01100 mS=mSs(i,:,:) 01101 edge=edges(i) 01102 ip=mS 01103 ip(dir,:)=3-edge 01104 01105 ip_mx(:) = ip(:,2) - ip(:,1) + 1 01106 01107 ! neighborinfo%fixupflux%side%data 01108 accumulator = accumulator + (PRODUCT(ip_mx) * nFlux * PACK_DOUBLE_SIZE) 01109 01110 END DO 01111 01112 DEALLOCATE(mTs,mSs,edges) 01113 NULLIFY(mTs,mSs,edges) 01114 END IF 01115 END DO 01116 01117 IF (MaintainAuxArrays) THEN 01118 01119 DO dir=1,nEMF 01120 01121 ! add nOverlaps space. 01122 accumulator = accumulator + PACK_INTEGER_SIZE 01123 01124 ! Calculate overlaps (the inverse of the SendFluxes_Precalculate operation). 01125 CALL CalcEmfOverlaps(node%box%mGlobal,neighbor%box%mGlobal,mTs,mSs,nOverlaps,offsets,level,EmfDir(dir), lHydroPeriodic) 01126 01127 IF (nOverlaps > 0) THEN 01128 01129 !Add the size of the overlap and offsets arrays. 01130 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs) + SIZE(offsets)) * PACK_INTEGER_SIZE) 01131 01132 DO i=1,nOverlaps 01133 mS=mSs(i,:,:) 01134 offset=offsets(i,:) 01135 01136 ms_mx(:) = mS(:,2) - mS(:,1) + 1 01137 01138 ! Add space for neighborinfo%emf(emfloc(dir)). 01139 accumulator = accumulator + PRODUCT(ms_mx) * PACK_DOUBLE_SIZE 01140 01141 END DO 01142 01143 DEALLOCATE(mTs,mSs,offsets) 01144 NULLIFY(mTs,mSs,offsets) 01145 01146 END IF 01147 END DO 01148 END IF 01149 01150 RecvFluxes_Precalculate = accumulator 01151 01152 END FUNCTION RecvFluxes_Precalculate 01153 01156 SUBROUTINE RecvFluxes(message) 01157 TYPE(NodeDef), POINTER :: node 01158 TYPE(PackedMessage), POINTER :: message 01159 INTEGER :: dir,nOverlaps,i,level,edge,j 01160 INTEGER, DIMENSION(:,:,:), POINTER :: mTs, mSs 01161 INTEGER, DIMENSION(3,2) :: mT, mS,ip 01162 INTEGER, DIMENSION(:), POINTER :: edges 01163 INTEGER, DIMENSION(:,:), POINTER :: Offsets 01164 INTEGER, DIMENSION(3) :: offset 01165 TYPE(NodeBox) :: localnodebox 01166 TYPE(InfoDef), POINTER :: neighborinfo 01167 01168 01169 localnodebox%MPI_ID=MPI_ID 01170 level=message%level 01171 01172 NULLIFY(NeighborInfo) 01173 ALLOCATE(NeighborInfo) 01174 CALL NullifyInfoFields(NeighborInfo) 01175 01176 DO WHILE(StrictGetNextBox(message, localnodebox%mGlobal, "RecvFluxes")) 01177 01178 CALL StrictFindNode(level,localnodebox,node, "RecvFluxes") 01179 CALL UnPackData(message,NeighborInfo%mGlobal) 01180 ALLOCATE(neighborinfo%fixupflux) 01181 DO dir=1,nDim 01182 01183 CALL UnPackData(message, nOverlaps) 01184 01185 01186 IF (nOverlaps > 0) THEN 01187 01188 ALLOCATE(neighborinfo%fixupflux%side(dir:dir)) 01189 ALLOCATE(mTs(nOverlaps,3,2)) 01190 ALLOCATE(mSs(nOverlaps,3,2)) 01191 ALLOCATE(edges(nOverlaps)) 01192 01193 CALL UnPackData(message, mTs) 01194 CALL UnPackData(message, mSs) 01195 CALL UnPackData(message, edges) 01196 01197 DO i=1,nOverlaps 01198 mT=mTs(i,:,:) 01199 mS=mSs(i,:,:) 01200 edge=edges(i) 01201 ip=mS 01202 ip(dir,:)=3-edge 01203 ALLOCATE(neighborinfo%fixupflux%side(dir)%data(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), nFlux)) 01204 01205 CALL UnPackData(message, neighborinfo%fixupflux%side(dir)%data) 01206 01207 CALL SyncSingleFlux(node%info,neighborinfo,mT,mS,dir,edge) 01208 DEALLOCATE(neighborinfo%fixupflux%side(dir)%data) 01209 NULLIFY(neighborinfo%fixupflux%side(dir)%data) 01210 END DO 01211 01212 DEALLOCATE(mTs,mSs,edges) 01213 NULLIFY(mTs,mSs,edges) 01214 01215 DEALLOCATE(neighborinfo%fixupflux%side) 01216 NULLIFY(neighborinfo%fixupflux%side) 01217 END IF 01218 END DO 01219 01220 DEALLOCATE(neighborinfo%fixupflux) 01221 NULLIFY(neighborinfo%fixupflux) 01222 01223 IF (MaintainAuxArrays) THEN 01224 DO dir=1,nEMF 01225 CALL UnPackData(message, nOverlaps) 01226 01227 IF (nOverlaps > 0) THEN 01228 01229 ALLOCATE(mTs(nOverlaps,3,2), mSs(nOverlaps,3,2), offsets(nOverlaps,3)) 01230 01231 CALL UnPackData(message, mTs) 01232 CALL UnPackData(message, mSs) 01233 CALL UnPackData(message, offsets) 01234 01235 DO i=1,nOverlaps 01236 mT=mTs(i,:,:) 01237 mS=mSs(i,:,:) 01238 offset=offsets(i,:) 01239 ALLOCATE(neighborinfo%emf(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),EmfLoc(emfdir(dir)):EmfLoc(emfdir(dir)))) 01240 CALL UnPackData(message,neighborinfo%emf(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),EmfLoc(emfdir(dir)))) 01241 01242 CALL SyncSingleEMF(node%info, neighborinfo, mT, mS, offset, EmfDir(dir)) 01243 DEALLOCATE(neighborinfo%emf) 01244 NULLIFY(neighborinfo%emf) 01245 END DO 01246 01247 DEALLOCATE(mTs,mSs,offsets) 01248 NULLIFY(mTs,mSs,offsets) 01249 01250 END IF 01251 END DO 01252 END IF 01253 END DO 01254 01255 DEALLOCATE(NeighborInfo) 01256 NULLIFY(NeighborInfo) 01257 01258 END SUBROUTINE RecvFluxes 01259 01261 01264 01271 INTEGER FUNCTION SendGenericData_Precalculate(level, node, neighbor, fields, nghost, lPeriodic) 01272 01273 INTEGER :: level 01274 TYPE(NodeDef), POINTER :: node 01275 TYPE(NodeDef), POINTER :: neighbor 01276 INTEGER, DIMENSION(:) :: fields 01277 INTEGER :: nghost 01278 LOGICAL, DIMENSION(3) :: lPeriodic 01279 INTEGER :: accumulator 01280 INTEGER, DIMENSION(3,2) :: mS 01281 INTEGER, POINTER, DIMENSION(:,:,:) :: mTs, mSs 01282 INTEGER :: nOverlaps,i,n 01283 INTEGER, DIMENSION(3) :: ms_mx 01284 01285 01286 ! Pack neighbor%box%mGlobal 01287 accumulator = 6 * PACK_INTEGER_SIZE 01288 01289 ! nOverlaps 01290 accumulator = accumulator + PACK_INTEGER_SIZE 01291 01292 ! Obtain the overlap arrays that will be used by the actual SendGenericData() subroutine. 01293 CALL CalcOverlaps(neighbor%box%mGlobal, node%box%mGlobal,mTs,mSs,nOverlaps,level,lPeriodic, nghost) 01294 01295 IF (nOverlaps > 0) THEN 01296 01297 !Add the size of the overlap and offsets arrays. 01298 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 01299 01300 DO i=1,nOverlaps 01301 mS=mSs(i,:,:) 01302 ms_mx(:) = mS(:,2) - mS(:,1) + 1 01303 01304 ! Add the cost of the overlaps for the generic variables. 01305 accumulator = accumulator + (PRODUCT(ms_mx) * SIZE(fields) * PACK_DOUBLE_SIZE) 01306 END DO 01307 01308 DEALLOCATE(mTs,mSs) 01309 NULLIFY(mTs,mSs) 01310 01311 END IF 01312 01313 SendGenericData_Precalculate = accumulator 01314 01315 END FUNCTION SendGenericData_Precalculate 01316 01324 SUBROUTINE SendGenericData(message, node, neighbor, fields, nghost, lPeriodic) 01325 TYPE(NodeDef), POINTER :: node, neighbor 01326 TYPE(PackedMessage), POINTER :: message 01327 INTEGER, DIMENSION(3,2) :: mT, mS 01328 INTEGER, POINTER, DIMENSION(:,:,:) :: mTs, mSs 01329 INTEGER :: nOverlaps,i,n,dir,j 01330 INTEGER, DIMENSION(:) :: fields 01331 INTEGER :: nghost 01332 LOGICAL, DIMENSION(3) :: lPeriodic 01333 CALL CalcOverlaps(neighbor%box%mGlobal, node%box%mGlobal,mTs,mSs,nOverlaps,message%level,lPeriodic, nghost) 01334 CALL PackData(message, neighbor%box%mGlobal) 01335 CALL PackData(message, nOverlaps) 01336 IF (nOverlaps > 0) THEN 01337 CALL PackData(message, mTs) 01338 CALL PackData(message, mSs) 01339 DO i=1,nOverlaps 01340 mT=mTs(i,:,:) 01341 mS=mSs(i,:,:) 01342 DO j=1,size(fields) 01343 CALL PackData(message, node%info%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),fields(j))) 01344 END DO 01345 END DO 01346 DEALLOCATE(mTs,mSs) 01347 NULLIFY(mTs,mSs) 01348 END IF 01349 END SUBROUTINE SendGenericData 01350 01351 01358 INTEGER FUNCTION RecvGenericData_Precalculate(level, node, neighbor, fields, nghost, lPeriodic) 01359 01360 INTEGER :: level 01361 TYPE(NodeDef), POINTER :: node 01362 TYPE(NodeDef), POINTER :: neighbor 01363 INTEGER, DIMENSION(:) :: fields 01364 INTEGER :: nghost 01365 01366 INTEGER :: accumulator 01367 INTEGER, DIMENSION(3,2) :: mS 01368 INTEGER, POINTER, DIMENSION(:,:,:) :: mTs, mSs 01369 INTEGER :: nOverlaps,i,n 01370 INTEGER, DIMENSION(3) :: ms_mx 01371 LOGICAL, DIMENSION(3) :: lPeriodic 01372 01373 ! Pack neighbor%box%mGlobal 01374 accumulator = 6 * PACK_INTEGER_SIZE 01375 01376 ! Obtain the overlap arrays that will be used by the actual RecvGenericData() subroutine. This is 01377 ! basically the inverse of the CalcOverlaps() call in SendGenericData--note the node and neighbor 01378 ! positions in the subroutine call. 01379 CALL CalcOverlaps(node%box%mGlobal, neighbor%box%mGlobal,mTs,mSs,nOverlaps,level,lPeriodic, nghost) 01380 01381 ! nOverlaps 01382 accumulator = accumulator + PACK_INTEGER_SIZE 01383 01384 IF (nOverlaps > 0) THEN 01385 01386 !Add the size of the overlap and offsets arrays. 01387 accumulator = accumulator + ((SIZE(mTs) + SIZE(mSs)) * PACK_INTEGER_SIZE) 01388 01389 DO i=1,nOverlaps 01390 mS=mSs(i,:,:) 01391 ms_mx(:) = mS(:,2) - mS(:,1) + 1 01392 01393 ! Add the cost of the overlaps for the generic variables. 01394 accumulator = accumulator + (PRODUCT(ms_mx) * SIZE(fields) * PACK_DOUBLE_SIZE) 01395 END DO 01396 01397 DEALLOCATE(mTs,mSs) 01398 NULLIFY(mTs,mSs) 01399 01400 END IF 01401 01402 RecvGenericData_Precalculate = accumulator 01403 01404 END FUNCTION RecvGenericData_Precalculate 01405 01409 SUBROUTINE RecvGenericData(message,fields) 01410 TYPE(NodeDef), POINTER :: node 01411 TYPE(PackedMessage), POINTER :: message 01412 TYPE(InfoDef) :: neighborInfo 01413 TYPE(NodeBox) :: localnodebox 01414 INTEGER :: level, nOverlaps,i,dir,j 01415 INTEGER, DIMENSION(:,:,:), POINTER :: mTs, mSs 01416 INTEGER, DIMENSION(3,2) :: mT, mS 01417 INTEGER, DIMENSION(:) :: fields 01418 localnodebox%MPI_ID=MPI_ID 01419 level=message%level 01420 DO WHILE(StrictGetNextBox(message, localnodebox%mGlobal, "RecvGenericData")) 01421 CALL StrictFindNode(level,localnodebox,node, "RecvGenericData(node)") 01422 CALL UnPackData(message, nOverlaps) 01423 01424 IF (nOverlaps > 0) THEN 01425 01426 ALLOCATE(mTs(nOverlaps,3,2), mSs(nOverlaps,3,2)) 01427 01428 CALL UnPackData(message, mTs) 01429 CALL UnPackData(message, mSs) 01430 01431 DO i=1,nOverlaps 01432 mT=mTs(i,:,:) 01433 mS=mSs(i,:,:) 01434 DO j=1,size(fields) 01435 ALLOCATE(neighborinfo%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2),fields(j):fields(j))) 01436 CALL UnPackData(message, neighborinfo%q) 01437 CALL ApplySingleOverlap(node%info,neighborinfo,mS,mT,fields(j:j)) 01438 DEALLOCATE(neighborinfo%q) 01439 END DO 01440 END DO 01441 DEALLOCATE(mTs,mSs) 01442 NULLIFY(mTs,mSs) 01443 END IF 01444 END DO 01445 END SUBROUTINE RecvGenericData 01447 END MODULE DataParsing