! module gkssubs2.f90
! All stuff here written by E.Huckert (EH) 2019-2022
!
! Should replace all calls for GKS/NCAR routines
! Needed for the creation of output files with increasing numbers
! in the names
! These routines produce files containing x,y coordinates for
! later use in gnuplot. gnuplot is used to produce graphics in
! JPEG or other formats
!
MODULE OUTPUT_FILES
INTEGER :: outpUnitL ! for proc. LINE(), must be initialized
INTEGER :: outpStateL ! must be initialized
INTEGER :: outpUnitC ! for proc. CURVE(), must be initialized
INTEGER :: outpStateC ! must be initialized
INTEGER :: outpUnitS ! for proc. SET(), must be initialized
INTEGER :: outpStateS ! must be initialized
INTEGER :: outpUnitF ! for proc. FRAME(), must be initialized
INTEGER :: outpStateF ! must be initialized
INTEGER :: fileCount ! used to generate file names
COMMON /COMMON_OUTFILES/ outpUnitL, outpStateL, outpUnitC, outpStateC, &
outpUnitS, outpStateS, outpUnitF, outpuStateF, &
fileCount
END MODULE
!
! All stuff here written by E.Huckert 2019-2022
! ------------------------------------------------------
! A replacement for GKS and NCAR routines (dummy routines)
! Eliminate this module if the real GKS/NCAR libraries are accessible
!MODULE gkssubs1
! CONTAINS
!
!
! ----------------------------------------------------
! Delete all existing files, i.e. files from previous runs
SUBROUTINE deleteExistingFiles()
CHARACTER(32) :: fileName
CHARACTER(16) :: baseName
INTEGER :: fileCount
!
fileCount = 0
DO fileCount =0, 200, 1
WRITE(baseName, '(AI3.3)') "L", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit=26, iostat=io_error, &
file = TRIM(fileName), &
status='old')
if (io_error == 0) THEN
close(26, status='delete')
END IF
!
WRITE(baseName, '(AI3.3)') "C", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit=26, iostat=io_error, &
file = TRIM(fileName), &
status='old')
if (io_error == 0) THEN
close(26, status='delete')
END IF
!
WRITE(baseName, '(AI3.3)') "S", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit=26, iostat=io_error, &
file = TRIM(fileName), &
status='old')
if (io_error == 0) THEN
close(26, status='delete')
END IF
!
WRITE(baseName, '(AI3.3)') "F", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit=26, iostat=io_error, &
file = TRIM(fileName), &
status='old')
if (io_error == 0) THEN
close(26, status='delete')
END IF
ENDDO
!
RETURN
END Subroutine deleteExistingFiles
!
! ----------------------------------------------------
! Close all existing output files
SUBROUTINE closeOutputFiles()
USE OUTPUT_FILES
close(outpUnitL)
outputStateL = 0
CLOSE(outpUnitC)
outputStateC = 0;
CLOSE(outpUnitS)
outputStateS = 0;
CLOSE(outpUnitF)
outputStateF = 0;
RETURN
END SUBROUTINE closeOutputFiles
!
! ----------------------------------------------------
SUBROUTINE makeOutputFiles()
USE OUTPUT_FILES
CHARACTER(32) :: fileName
CHARACTER(16) :: baseName
!
! Open a new series of output files
! Open the file for LINE()
outpUnitL = 25 ! for LINE()
WRITE(baseName, '(AI3.3)') "L", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit = outpUnitL, &
file = TRIM(fileName), &
status = 'unknown', &
ACTION = 'write', &
iostat = io_error)
outpStateL = 1; ! TODO: check IO_ERROR
!
! Open the file for CURVE()
outpUnitC = 26 ! for CURVE()
WRITE(baseName, '(AI3.3)') "C", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit = outpUnitC, &
file = fileName, &
status = 'unknown', &
ACTION = 'write', &
iostat = io_error)
outpStateC = 1; ! TODO: check IO_ERROR
!
! Open the file for SET()
outpUnitS = 27 ! for SET()
WRITE(baseName, '(AI3.3)') "S", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit = outpUnitS, &
file = fileName, &
status = 'unknown', &
ACTION = 'write', &
iostat = io_error)
outpStateS = 1; ! TODO: check IO_ERROR
!
! Open the file for FRAME()
outpUnitF = 28 ! for SET()
WRITE(baseName, '(AI3.3)') "F", fileCount
fileName = TRIM(baseName) // ".dat"
open(unit = outpUnitF, &
file = fileName, &
status = 'unknown', &
ACTION = 'write', &
iostat = io_error)
outpStateF = 1; ! TODO: check IO_ERROR
!
! prepare fileCount for the next call
fileCount = fileCount + 1;
RETURN
END SUBROUTINE makeOutputFiles
!
!------------------------------------------------------
! What is the purpose of the SET() routine???
! Writes to a file called "S00x.at"
SUBROUTINE SET(p1, p2, p3, p4, p5, p6, p7, p8, p9)
USE OUTPUT_FILES
REAL p1, p2, p3, p4, p5, p6, p7, p8
INTEGER p9
!
if (outpStateS > 0) THEN
write(outpUnitS, *) p1
write(outpUnitS, *) p2
write(outpUnitS, *) p3
write(outpUnitS, *) p4
write(outpUnitS, *) p5
write(outpUnitS, *) p6
write(outpUnitS, *) p7
write(outpUnitS, *) p8
write(outpUnitS, *) p9
else
write(*, *) 'SET file ERROR file=', fileName ! ???
end if
outpStateS = outpStateS + 1
!
RETURN
END SUBROUTINE SET
!
!------------------------------------------------------
! This routine does nothing as gnuplot does the
! necessary work automatically
SUBROUTINE HALFAX(p1, p2, p3, p4, p5, p6, p7, p8)
INTEGER p1, p2, p3, p4
REAL p5, p6
INTEGER p7, p8
!
RETURN
END SUBROUTINE HALFAX
! ----------------------------------------------------
! Generate plot values for gnuplot (x,y per line)
! The plot data are written to a file called "C00x.dat"
! Assumes that the output file with unit=outputUnitC has been
! created/open in proc. OPNGKS()
SUBROUTINE CURVE(xcoord, & ! array of x values
ycoord, & ! array of y values
nPoints) ! no. of array elements in xcoord and yccod
USE OUTPUT_FILES
REAL :: xcoord(nPoints), ycoord(nPoints)
INTEGER :: nPoints
!
if (outpStateC > 0) THEN
! write to that file
do n = 1, nPoints
write(outpUnitC, *) xcoord(n), ' ', ycoord(n)
end do
else
write(*, *) 'CURVE file ERROR file=', fileName
end if
outpStateC = outpStateC + 1
RETURN
END SUBROUTINE CURVE
!
! ----------------------------------------------------
! GKS/NCHAR FRAME makes a new drawing("frame")
! Closes all existing output files
! Opens a new series of output files
SUBROUTINE FRAME
USE OUTPUT_FILES
!
CHARACTER(32) :: baseName
CHARACTER(64) :: fileName
!
! Writes output that is not really needed
WRITE(outpUnitF, *) 'FRAME called'
PRINT *, "Frame called: ", fileCount
!
CALL closeOutputFiles()
CALL makeOutputFiles()
RETURN
END SUBROUTINE FRAME
! ----------------------------------------------------
! Set the GKS line type
! ltype = 1: solid line
! ltype = 2: dashed line
! ltype = 3: dotted line
SUBROUTINE GSLN(ltype1)
INTEGER :: ltype
!
RETURN
END SUBROUTINE GSLN
! ----------------------------------------------------
! Replaces LINE() form NCAR graphics
! Writes to a file named "L00x.dat"
SUBROUTINE LINE(par1, par2, par3, par4)
USE OUTPUT_FILES
REAL :: par1, par2, par3, p4
!
! write to that file
if (outpStateL > 0) THEN
write(outpUnitL, *) par1, par2
! WRITE(outpUnitL, *) par3, par4, NEW_LINE('a')
WRITE(outpUnitL, *) par3, par4, ACHAR(10)
END IF
!
RETURN
END SUBROUTINE LINE
! --------------------------------------------------
! Original: Calculates and plots isolines
! This seems to be the routine published by Paul Burke in 1987
SUBROUTINE CONREC(arr, &
xd, yd, zd, &
f1, f2, f3, &
i1, i2, i3)
INTEGER xd, yd, zd
REAL arr(xd, yd)
REAL f1, f2, f3
INTEGER i1, i2, i3
!
RETURN
END SUBROUTINE CONREC
!---------------------------------------------------
! Replacement for GKS/NCAR OPNGKS()
! This prepares files to be used later with gnuplot
! Deletes all existing output file
! Creates and opens all files with names like "L000.dat" etc.
SUBROUTINE OPNGKS()
USE OUTPUT_FILES
!
CALL deleteExistingFiles()
fileCount = 0;
CALL makeOutputFiles()
RETURN
END SUBROUTINE OPNGKS
!---------------------------------------------------
! Closes the files written here and used as inputs for gnuplot
SUBROUTINE CLSGKS()
USE OUTPUT_FILES
! Close the data file written in proc. LINE() etc.
CALL closeOutputFiles()
RETURN
END SUBROUTINE CLSGKS