Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! io_okc.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 IOOkc 00033 USE ParticleDeclarations 00034 USE ParticleControl 00035 IMPLICIT NONE 00036 00037 CONTAINS 00038 00041 SUBROUTINE MakeOKCFile(nframe) 00042 CHARACTER(19) :: filename 00043 INTEGER :: i,nframe,nractive, j, nrsinkfields 00044 REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:,:) :: data 00045 TYPE(ParticleListDef), POINTER :: ParticleList 00046 TYPE(ParticleDef), POINTER :: Particle 00047 IF (.NOT. lParticles) RETURN 00048 IF (MPI_ID > 0) RETURN 00049 j=0 00050 NrSinkFields=3+NrHydroVars+nAngularMomentum 00051 00052 ALLOCATE(data(NrSinkFields, NrSinkParticles)) 00053 ParticleList=>SinkParticles 00054 00055 DO i=1, NrSinkParticles 00056 IF (.NOT. ASSOCIATED(ParticleList)) THEN 00057 print*, 'error - NrSinkParticles > Count(SinkParticles)' 00058 STOP 00059 END IF 00060 Particle=>ParticleList%Self 00061 data(:,i)=(/particle%xloc-GxBounds(:,1),particle%Q(1:NrHydroVars), particle%J(1:nAngularMomentum)/) 00062 ! data(1:7,i)=(/Particle%xloc-GxBounds(:,1), Particle%Mass, Particle%vel/) 00063 ! IF (nDim == 2) THEN 00064 ! data(10,i)=Particle%J(1) 00065 ! ELSE 00066 ! data(8:10,i)=Particle%J 00067 ! END IF 00068 ParticleList=>ParticleList%Next 00069 END DO 00070 write(filename, '(A10,I5.5,A4)') "out/sinks_", nframe, ".okc" 00071 OPEN (UNIT=11, file=filename, status="unknown") 00072 ! IF (nframe==0) THEN 00073 ! Always create 1 dummy particle to make visit happy 00074 write(11, '(3I6)') NrSinkFields, max(1,NrSinkParticles), NrSinkFields !makes visit happy to have at least one particle when opening the database 00075 ! ELSE 00076 ! write(11, '(3I6)') 10, NrSinkParticles, 10 00077 ! END IF 00078 write(11, *) "x" 00079 write(11, *) "y" 00080 write(11, *) "z" 00081 DO i=1, NrCons 00082 write(11, *) trim(FieldName(i)) 00083 END DO 00084 00085 ! Creates tags for tracer variables. 00086 DO i = 1, NrTracerVars !NrCons+1,NrHydroVars 00087 write(11, *) trim(TracerName(i)) 00088 END DO 00089 00090 IF (nDim == 3) THEN 00091 write(11, *) "sink_Jx" 00092 write(11, *) "sink_Jy" 00093 END IF 00094 write(11, *) "sink_Jz" 00095 DO i=1,3 00096 write(11,'(2E15.5,I4)') GxBounds(i,1), GxBounds(i,2) 00097 END DO 00098 IF (NrSinkParticles==0) THEN 00099 DO i=4,NrSinkFields 00100 write(11, '(2E15.5,I4)') 0d0,0d0 00101 END DO 00102 write(11, '(100E24.16)') (/(i*0d0,i=1,NrSinkFields)/) 00103 ELSE 00104 DO i=4,NrSinkFields 00105 write(11, '(2E15.5)') minval(data(i,:)), maxval(data(i,:)) 00106 END DO 00107 DO i=1,NrSinkParticles 00108 write(11, '(100E24.16)') data(:,i) 00109 END DO 00110 END IF 00111 close(11) 00112 DEALLOCATE(data) 00113 END SUBROUTINE MakeOKCFile 00114 00115 END MODULE IOOkc 00116 00117