Scrambler  1
boundary.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 !    boundary.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 
00029 
00032 MODULE Boundary
00033   USE GlobalDeclarations
00034   IMPLICIT NONE
00035   PUBLIC
00036 
00038   TYPE Face
00039     SEQUENCE
00040     REAL(KIND=qPREC), DIMENSION(:,:,:,:), POINTER :: data
00041   END type Face
00042   
00044   TYPE Boundaries
00045     SEQUENCE
00046     TYPE(Face), DIMENSION(:), POINTER :: side
00047   END type Boundaries
00048 
00050   TYPE pBoundaries
00051     SEQUENCE
00052     TYPE(Boundaries), POINTER :: p
00053   END type PBoundaries
00054   
00055 CONTAINS
00056 
00060   SUBROUTINE AllocBoundaries(fixups,mB)
00061     TYPE(Boundaries), POINTER :: fixups
00062     INTEGER, DIMENSION(3,2) :: mB, ip
00063     INTEGER :: i, iErr
00064 
00065     IF (.NOT. ASSOCIATED(fixups)) THEN
00066         ALLOCATE(fixups, STAT=iErr)
00067         NULLIFY(fixups%side)
00068         IF (iErr /= 0) THEN
00069             PRINT *, "AllocBoundaries() error: unable to allocate fixups object."
00070             STOP
00071         END IF
00072     END IF
00073 
00074     IF (.NOT. ASSOCIATED(fixups%side)) THEN
00075         ALLOCATE(fixups%side(nDim), STAT=iErr)
00076         
00077         IF (iErr /= 0) THEN
00078             PRINT *, "AllocBoundaries() error: unable to allocate fixups%side object."
00079             STOP
00080         END IF
00081      END IF
00082      ip=mb
00083      DO i=1,nDim
00084         ip(i,:)=(/1,2/)        
00085         NULLIFY(fixups%side(i)%data)
00086         ALLOCATE(fixups%side(i)%data(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),nFlux), STAT=iErr)
00087         CALL CheckAllocation(InfoAllocator, size(fixups%side(i)%data)*8, 'boundary')
00088         IF (iErr /= 0) THEN
00089            PRINT "('AllocBoundaries() error:  unable to allocate fixups%side(',i1,')%data object.')", i
00090            STOP
00091         END IF
00092         ip(i,:)=mb(i,:)
00093       END DO
00094   END SUBROUTINE AllocBoundaries
00095 
00098   SUBROUTINE DeAllocBoundaries(fixups)
00099     TYPE(Boundaries), POINTER :: fixups
00100     INTEGER :: i
00101     IF (.NOT. ASSOCIATED(fixups))  RETURN
00102 
00103     IF (ASSOCIATED(fixups%side)) THEN
00104         DO i=1,nDim
00105            IF (ASSOCIATED(fixups%side(i)%data)) THEN
00106               CALL CheckDeAllocation(InfoAllocator, size(fixups%side(i)%data)*8)
00107               DEALLOCATE(fixups%side(i)%data)
00108               NULLIFY(fixups%side(i)%data)
00109            END IF
00110         END DO
00111 
00112         DEALLOCATE(fixups%side)
00113         NULLIFY(fixups%side)
00114 
00115     END IF
00116 
00117     DEALLOCATE(fixups)
00118     NULLIFY(fixups)
00119 
00120   END SUBROUTINE DeAllocBoundaries
00121 
00122 END MODULE boundary
00123 
 All Classes Files Functions Variables