Scrambler  1
totals.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 !    totals.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 !#########################################################################
00023 MODULE Totals
00024    USE TreeDeclarations
00025    USE DataDeclarations
00026    USE PhysicsDeclarations
00027    USE GlobalDeclarations
00028    USE EllipticDeclarations
00029    USE ParticleDeclarations
00030    USE Fields
00031    USE Shapes
00032    IMPLICIT NONE
00033    TYPE TotalDef
00034       TYPE(FieldDef) :: Field
00035       REAL(KIND=qPREC) :: CurrentValue=0d0
00036       TYPE(ShapeDef), POINTER :: shape=>NULL()
00037       TYPE(TotalDef), POINTER :: next=>NULL()
00038    END TYPE TotalDef
00039 
00040    TYPE(TotalDef), POINTER :: FirstTotal, LastTotal
00041    LOGICAL :: lFirstTotalFrame
00042    SAVE
00043 CONTAINS
00044    SUBROUTINE TotalInit()
00045       Nullify(FirstTotal, LastTotal)
00046       lFirstTotalFrame=.true.
00047    END SUBROUTINE TotalInit
00048 
00049 
00050    SUBROUTINE AddAllTotals(component, OptShape)
00051       INTEGER :: component, j
00052       TYPE(TotalDef), POINTER :: Total
00053       TYPE(ShapeDef), POINTER, OPTIONAL :: OptShape
00054       IF (Component /= GASCOMP .AND. Component /= PARTICLECOMP .AND. Component /= BOTHCOMP) THEN
00055          IF (MPI_ID == 0) PRINT*, 'Err - unrecognized component in AddAllTotals'
00056       ELSE
00057          DO j=1,NrFieldVars
00058             CALL CreateTotal(Total)
00059             Total%Field%Component=component
00060             Total%Field%id=j
00061             Total%Field%name=FieldName(j)
00062             IF (Present(OptShape)) Total%shape=>OptShape
00063          END DO
00064          DO j=1,NrTracerVars
00065             CALL CreateTotal(Total)
00066             Total%Field%Component=COMPONENT
00067             Total%Field%id=NrFieldVars+j
00068             Total%Field%name=TracerName(j)
00069             IF (Present(OptShape)) Total%shape=>OptShape
00070          END DO
00071          CALL CreateTotal(Total)
00072          Total%Field%Component=Component
00073          Total%Field%id=KE_Field
00074          Total%Field%name='Kinetic_Energy'
00075          IF (Present(OptShape)) Total%shape=>OptShape
00076          CALL CreateTotal(Total)
00077          Total%Field%Component=Component
00078          Total%Field%id=iE_Field
00079          Total%Field%name='Internal_Energy'
00080          IF (Present(OptShape)) Total%shape=>OptShape
00081          CALL CreateTotal(Total)
00082          Total%Field%Component=Component
00083          Total%Field%id=P_Field
00084          Total%Field%name='Pressure'
00085          IF (Present(OptShape)) Total%shape=>OptShape
00086          CALL CreateTotal(Total)
00087          Total%Field%Component=Component
00088          Total%Field%id=Temp_Field
00089          Total%Field%name='Temperature'
00090          IF (Present(OptShape)) Total%shape=>OptShape
00091          IF (lMHD) THEN
00092             CALL CreateTotal(Total)
00093             Total%Field%Component=Component
00094             Total%Field%id=BE_Field
00095             Total%Field%name='Magnetic_Energy'
00096             IF (Present(OptShape)) Total%shape=>OptShape
00097          END IF
00098          IF (lSelfGravity) THEN
00099             CALL CreateTotal(Total)
00100             Total%Field%Component=Component
00101             Total%Field%id=GravEnergy_Field
00102             Total%Field%name='Gravitational_Energy'
00103             IF (Present(OptShape)) Total%shape=>OptShape
00104          END IF
00105       END IF
00106    END SUBROUTINE AddAllTotals
00107 
00108    SUBROUTINE CreateTotal(Total)
00109       TYPE(TotalDef), POINTER :: Total
00110       ALLOCATE(Total)
00111       CALL AddTotalToList(Total)
00112    END SUBROUTINE CreateTotal
00113 
00114    SUBROUTINE DestroyTotal(Total)
00115       TYPE(TotalDef), POINTER :: Total
00116       DEALLOCATE(Total)
00117       NULLIFY(Total)
00118    END SUBROUTINE DestroyTotal
00119 
00120    SUBROUTINE AddTotalToList(Total)
00121       TYPE(TotalDef),POINTER :: Total
00122       IF(.NOT. ASSOCIATED(FirstTotal)) THEN ! First Total Object only
00123          FirstTotal=>Total
00124          LastTotal=>Total
00125       ELSE
00126          LastTotal%next=>Total
00127          LastTotal=>Total
00128       END IF
00129    END SUBROUTINE AddTotalToList
00130 
00131    SUBROUTINE ProcessTotals
00132       TYPE(TotalDef), POINTER :: Total
00133       Total=>FirstTotal
00134       DO WHILE (ASSOCIATED(Total))        
00135          CALL ProcessTotal(Total)
00136          Total=>Total%next            
00137       END DO
00138       CALL OutputTotals
00139 
00140    END SUBROUTINE ProcessTotals
00141 
00142    SUBROUTINE ProcessTotal(Total)
00143       TYPE(TotalDef), POINTER :: Total
00144       INTEGER :: n
00145       TYPE(NodeDefList), POINTER :: NodeList
00146       TYPE(ParticleListDef), POINTER :: ParticleList
00147       REAL(KIND=qPREC) :: rpos(3)
00148       Total%CurrentValue=0d0
00149       IF (Total%Field%Component==GASCOMP .OR. Total%Field%Component==BOTHCOMP) THEN
00150          DO n=0, MaxLevel
00151             Nodelist=>Nodes(n)%p
00152             DO WHILE (ASSOCIATED(NodeList))
00153                CALL ProcessTotalInfo(Nodelist%self%info, Total)
00154                Nodelist=>Nodelist%next
00155             END DO
00156          END DO
00157          CALL CollectTotal(Total)
00158       END IF
00159       IF (Total%Field%Component==PARTICLECOMP .OR. Total%Field%Component==BOTHCOMP) THEN
00160          ParticleList=>SinkParticles
00161          DO WHILE (ASSOCIATED(ParticleList))
00162             IF (ASSOCIATED(Total%shape)) THEN
00163                IF (IsInShape(Total%shape, ParticleList%self%xloc, rpos, levels(0)%tnow)) THEN
00164                   Total%CurrentValue=Total%CurrentValue+GetParticleField(ParticleList%self, Total%Field%id)
00165                END IF
00166             ELSE
00167                Total%CurrentValue=Total%CurrentValue+GetParticleField(ParticleList%self, Total%Field%id)
00168             END IF
00169             ParticleList=>ParticleList%next
00170          END DO
00171       END IF
00172    END SUBROUTINE ProcessTotal
00173 
00174    SUBROUTINE ProcessTotalInfo(Info, Total)
00175       TYPE(InfoDef) :: Info
00176       TYPE(TotalDef) :: Total
00177       INTEGER :: i,j,k
00178       REAL(KIND=qPREC) :: dv, pos(3), rpos(3)
00179       dv=levels(Info%level)%dx**nDim
00180       DO i=1, Info%mX(1)
00181          IF (iCylindrical /= NoCyl) dv=levels(Info%level)%dx**nDim*(Info%xBounds(1,1)+levels(Info%level)%dx*(REAL(i)-.5d0))
00182          DO j=1, Info%mX(2)
00183             DO k=1, Info%mX(3)
00184                IF (ASSOCIATED(Total%shape)) THEN
00185                   pos=CellPos(Info, i, j, k)
00186                   IF (.NOT. IsInShape(Total%shape, pos, rpos, levels(Info%level)%tnow)) CYCLE
00187                END IF
00188                IF (Info%level < MaxLevel) THEN
00189                   IF (Info%ChildMask(i,j,k) /= 0) THEN
00190                      !                     PRINT*, 'cycling'
00191                      CYCLE
00192                   END IF
00193                END IF
00194                Total%CurrentValue=Total%CurrentValue+GetField(Info,i,j,k,Total%Field%ID)*dv
00195             END DO
00196          END DO
00197       END DO
00198    END SUBROUTINE ProcessTotalInfo
00199 
00200 
00201 
00202    SUBROUTINE CollectTotal(Total)
00203       TYPE(TotalDef), POINTER :: Total
00204       INTEGER :: iErr
00205       CALL MPI_ALLREDUCE(MPI_IN_PLACE, Total%CurrentValue, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
00206    END SUBROUTINE CollectTotal
00207 
00208 
00209    SUBROUTINE OutputTotals
00210       TYPE(TotalDef), POINTER :: Total
00211       INTEGER :: iErr
00212       IF (MPI_ID == 0) THEN
00213          OPEN(UNIT=TOTALS_DATA_HANDLE, FILE=TOTALS_DATA_FILE, STATUS='OLD', POSITION='APPEND', IOSTAT=iErr)
00214          IF (iErr /= 0) THEN !File does not already exist
00215             OPEN(UNIT=TOTALS_DATA_HANDLE, FILE=TOTALS_DATA_FILE, STATUS='NEW', IOSTAT=iErr)
00216             IF (iErr /= 0) THEN !File cannot be created new either
00217                PRINT*, 'Error - cannot open file as old or new'
00218                STOP
00219             END IF
00220          END IF
00221          IF (lFirstTotalFrame) THEN
00222             write(TOTALS_DATA_HANDLE,'(A20)', ADVANCE='NO') 'Time                '
00223             Total=>FirstTotal
00224             DO WHILE (ASSOCIATED(Total))
00225                IF (ASSOCIATED(total%next)) THEN
00226                   write(TOTALS_DATA_HANDLE,'(A20)', ADVANCE='NO') GetName(Total%field)
00227                ELSE
00228                   write(TOTALS_DATA_HANDLE,'(A20)') GetName(Total%field)
00229                END IF
00230                Total=>Total%next
00231             END DO
00232             lFirstTotalFrame=.false.
00233          END IF
00234          write(TOTALS_DATA_HANDLE,'(E20.11)', ADVANCE='NO') levels(0)%tnow
00235          Total=>FirstTotal
00236          DO WHILE (ASSOCIATED(Total))
00237             IF (ASSOCIATED(total%next)) THEN
00238                write(TOTALS_DATA_HANDLE,'(E20.11)', ADVANCE='NO') Total%CurrentValue
00239             ELSE
00240                write(TOTALS_DATA_HANDLE,'(E20.11)') Total%CurrentValue
00241             END IF
00242             Total=>Total%next
00243          END DO
00244          CLOSE(TOTALS_DATA_HANDLE)
00245       END IF
00246    END SUBROUTINE OutputTotals
00247 END MODULE Totals
 All Classes Files Functions Variables