Scrambler  1
data_parsing.f90
Go to the documentation of this file.
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
 All Classes Files Functions Variables