Fixing an issue with reading tables led me to other issues with collisions that I think are fixed right now. I am testing with the 1D ionization model for ALPHIE and things seems to be working properly.
126 lines
2.9 KiB
Fortran
126 lines
2.9 KiB
Fortran
MODULE moduleTable
|
|
|
|
TYPE:: table1D
|
|
REAL(8):: xMin, xMax
|
|
REAL(8):: fMin, fMax
|
|
REAL(8), ALLOCATABLE, DIMENSION(:):: x, f, k
|
|
CONTAINS
|
|
PROCEDURE, PASS:: init => initTable1D
|
|
PROCEDURE, PASS:: get => getValueTable1D
|
|
PROCEDURE, PASS:: convert => convertUnits
|
|
|
|
END TYPE table1D
|
|
|
|
CONTAINS
|
|
SUBROUTINE initTable1D(self, tableFile)
|
|
USE moduleErrors
|
|
IMPLICIT NONE
|
|
|
|
CLASS(table1D), INTENT(inout):: self
|
|
CHARACTER(:), ALLOCATABLE, INTENT(IN):: tableFile
|
|
CHARACTER(100):: dummy
|
|
INTEGER:: amount
|
|
INTEGER:: i
|
|
INTEGER:: stat
|
|
INTEGER:: id = 20
|
|
|
|
OPEN(id, file = tableFile)
|
|
amount = 0
|
|
DO
|
|
READ(id, '(A)', iostat = stat) dummy
|
|
!If EOF or error, exit file
|
|
IF (stat /= 0) EXIT
|
|
!Skip comment
|
|
IF (INDEX(dummy,'#') /= 0) CYCLE
|
|
!Add row
|
|
amount = amount + 1
|
|
|
|
END DO
|
|
|
|
IF (amount == 0) CALL criticalError('Table ' // tableFile // ' is empty', 'initTable1D')
|
|
IF (amount == 1) CALL criticalError('Table ' // tableFile // ' has only one row', 'initTable1D')
|
|
|
|
!Go bback to initial point
|
|
REWIND(id)
|
|
|
|
!Allocate table arrays
|
|
ALLOCATE(self%x(1:amount), self%f(1:amount), self%k(1:amount))
|
|
self%x = 0.D0
|
|
self%f = 0.D0
|
|
self%k = 0.D0
|
|
|
|
i = 0
|
|
DO
|
|
READ(id, '(A)', iostat = stat) dummy
|
|
!TODO: Make this a function
|
|
IF (INDEX(dummy,'#') /= 0) CYCLE
|
|
IF (stat /= 0) EXIT
|
|
!Add data
|
|
!TODO: substitute with extracting information from dummy
|
|
BACKSPACE(id)
|
|
i = i + 1
|
|
READ(id, *) self%x(i), self%f(i)
|
|
|
|
END DO
|
|
|
|
CLOSE(id)
|
|
|
|
self%xMin = self%x(1)
|
|
self%xMax = self%x(amount)
|
|
self%fMin = self%f(1)
|
|
self%fMax = self%f(amount)
|
|
|
|
DO i = 1, amount - 1
|
|
self%k(i) = (self%f(i+1) - self%f(i))/(self%x(i+1) - self%x(i))
|
|
|
|
END DO
|
|
|
|
END SUBROUTINE initTable1D
|
|
|
|
FUNCTION getValueTable1D(self, x) RESULT(f)
|
|
IMPLICIT NONE
|
|
|
|
CLASS(table1D), INTENT(in):: self
|
|
REAL(8):: x
|
|
REAL(8):: f
|
|
REAL(8):: deltaX
|
|
INTEGER:: i
|
|
|
|
IF (x <= self%xMin) THEN
|
|
f = self%fMin
|
|
|
|
ELSEIF (x >= self%xMax) THEN
|
|
f = self%fMax
|
|
|
|
ELSE
|
|
i = MINLOC(ABS(x - self%x), 1)
|
|
deltaX = x - self%x(i)
|
|
IF (deltaX < 0 ) THEN
|
|
i = i - 1
|
|
deltaX = x - self%x(i)
|
|
|
|
END IF
|
|
|
|
f = self%f(i) + self%k(i)*deltaX
|
|
|
|
END IF
|
|
|
|
END FUNCTION getValueTable1D
|
|
|
|
SUBROUTINE convertUnits(self, data_x, data_f)
|
|
IMPLICIT NONE
|
|
|
|
CLASS(table1D), INTENT(inout):: self
|
|
REAL(8):: data_x, data_f
|
|
|
|
self%x = self%x * data_x
|
|
self%xMin = self%xMin * data_x
|
|
self%xMax = self%xMax * data_x
|
|
self%f = self%f * data_f
|
|
self%fMin = self%fMin * data_f
|
|
self%fMax = self%fMax * data_f
|
|
self%k = self%k * data_f / data_x
|
|
|
|
END SUBROUTINE convertUnits
|
|
|
|
END MODULE moduleTable
|