fpakc/src/modules/common/moduleTable.f90
Jorge Gonzalez 4585390b50 Fixing issue
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.
2023-11-21 09:53:36 +01:00

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