Scrambler
1
|
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