! filenames.f90
! module to hold standard routines for obtaining file/name/paths for save and load
! contains: 
! 	LoadPath, SavePath		for getting paths with(out) a specified suffix 
!	GetTextFromReal			for getting text from a real
! 	GetIntFromText, GetTextFromInt	for getting text from an integer, or vice versa
!	GetBatch			for getting a filtered selection of filepaths from the filesystem
!	MakeBatch			for making a set of new filepaths with common stem			
! last modified 09.08.01
! This file has been modified by Soenke Zaehle (PIK) on 30.07.02 for use with XLF compiler
! (PIK). changes are: 
! - removed "," after read and write statements
! - replaced SCRATCH statements with REPLACE statements

module FileNames

implicit none

contains

!*******************************************************************************
! when fed with the filter (a text string such as '/cru/mydir/*.glo'), which can be "blank"
!   returns a string array (size FileN) with all the files that fit that filter

subroutine GetBatch (CallFilter,Batch)

character (len=80), pointer, dimension (:) :: Batch

character (len=80), intent (in) :: CallFilter

integer :: ReadStatus, AllocStat
integer :: FileN
integer :: XFile

character (len=80), parameter :: Blank = ""

character (len= 80) :: Filter, NamesFile, CountFile
character (len=200) :: CommandLine

!character (len= 80) :: Dummy1, Dummy2

!***************************************

do
 if (CallFilter.EQ.Blank) then
  print*, "  > Enter the filter by which to identify the files:"
  do
	read (*,*,iostat=ReadStatus) Filter
	if (ReadStatus.LE.0.AND.Filter.NE."") exit
  end do
 else
  Filter = CallFilter
 end if

 NamesFile   = 'deleteme.names.txt'      
 CommandLine = 'ls -1 ' // trim(adjustl(Filter)) // ' > ' // trim(adjustl(NamesFile))
 CommandLine = trim (CommandLine)
 call system (CommandLine)

 CountFile   = 'deleteme.count.txt'      
 CommandLine = 'wc -l ' // trim(adjustl(NamesFile)) // ' > ' // trim(adjustl(CountFile))
 CommandLine = trim (CommandLine)
 call system (CommandLine)

 open  (1, file=CountFile, status="old", access="sequential", form="formatted", action="read")
 read  (1, fmt="(i8)") FileN
! read  (1, fmt="(i8,x,a)") FileN, Dummy1, Dummy2
 close (1)
 print "(a,i4)", "   > Number of files found: ", FileN
 
 if (FileN.EQ.0) print*, "  > Re-enter the filter."
 if (FileN.GT.0) exit
end do

allocate (Batch (FileN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: GetBatch: Allocation failure #####"
Batch = ""

open  (1, file=NamesFile, status="old", access="sequential", form="formatted", action="read")
do XFile = 1, FileN
  read  (1,"(a80)") Batch (XFile)
end do
close (1)

CommandLine = 'rm deleteme*'
CommandLine = trim (CommandLine)
call system (CommandLine)

end subroutine GetBatch

!*******************************************************************************
! obtain path for loading file (no .Z or .X required, although it is allowable)
! note that this will find any relevant zipped or binary file and return it
! it is permissible to call the routine with a blank suffix, in which case no suffix is required

function LoadPath (CallFile,Suffix)

character (len=80) :: CallFile, GivenFile, FoundFile, LoadPath
character (len=4)  :: Suffix
integer :: ReadStatus, StrLen, CallFileLen, NullSuffix

CallFileLen = len_trim(CallFile)				! remove any zip or binary expression

if (CallFileLen.GE.2) then
 if (CallFile((CallFileLen-1):CallFileLen).EQ.".Z".OR.CallFile((CallFileLen-1):CallFileLen).EQ.".X") then
  GivenFile = CallFile(1:(CallFileLen-2)) // "  "
 else
  GivenFile = CallFile
 end if
else
  GivenFile = CallFile
end if

NullSuffix = 0
if (Suffix.EQ."    ".OR.Suffix.EQ."") NullSuffix = 1

do
    if (GivenFile.EQ."") then
     print*, "  > Enter the file, with suffix: ", Suffix

     do
		read (*,*,iostat=ReadStatus) GivenFile
		if (ReadStatus.GT.0) print*, "  > Not a string. Try again."
		if (GivenFile.EQ."") print*, "  > A null string. Try again."
		if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
     end do
    end if
      
    StrLen = len(trim(GivenFile))
    if (GivenFile((StrLen-1):StrLen).EQ.'.Z'.OR.GivenFile((StrLen-1):StrLen).EQ.'.X') then
      	GivenFile((StrLen-1):StrLen) = '  '					! remove any zip or binary
        StrLen = len(trim(GivenFile))
    end if
      
    if (NullSuffix.EQ.0.AND.GivenFile((StrLen-3):StrLen).NE.Suffix) then	! file has wrong suffix
    	print*, "  > Suffix is not: ", Suffix
    	ReadStatus = 1 ; GivenFile = ""
    else
     inquire (file=GivenFile, name=FoundFile)					! look for file
     FoundFile=GivenFile
     open (1, file=FoundFile, status="old", action="read", iostat=ReadStatus)

     if (ReadStatus .NE. 0) then
      FoundFile = trim(FoundFile) // ".Z"					! look for zipped file
      open (1, file=FoundFile, status="old", action="read", iostat=ReadStatus)
      
      if (ReadStatus .NE. 0) then
       inquire (file=GivenFile, name=FoundFile)					! look for file
         FoundFile=GivenFile
       FoundFile = trim(FoundFile) // ".X"					! look for binary file
       open (1, file=FoundFile, status="old", action="read", form="unformatted", iostat=ReadStatus)
       
       if (ReadStatus .NE. 0) then
        print*, "  > Failed to find file."
        GivenFile = ""
       end if
      end if
     end if
    end if
    
    if (ReadStatus .EQ. 0) close (1)
    if (ReadStatus .EQ. 0) exit
end do

LoadPath = FoundFile

end function LoadPath

!*******************************************************************************
! obtain SavePath for save file
! note that this will check for any zipped or binary file with the same name and not permit it

function SavePath (CallFile,Suffix)

character (len=80) :: CallFile, GivenFile, FoundFile, SavePath, ZipFile, BinFile
character (len=4)  :: Suffix
integer :: ReadStatus, StrLen, CallFileLen, NullSuffix

CallFileLen = len_trim(CallFile)			! remove any zip or binary expression
if (CallFileLen.GE.2) then
 if (CallFile((CallFileLen-1):CallFileLen).EQ.".Z".OR.CallFile((CallFileLen-1):CallFileLen).EQ.".X") then
  GivenFile = CallFile(1:(CallFileLen-2)) // "  "
 else
  GivenFile = CallFile
 end if
else
  GivenFile = CallFile
end if

NullSuffix = 0
if (Suffix.EQ."    ") NullSuffix = 1

do
    if (GivenFile.EQ."") then
     print*, "  > Enter the file, with suffix: ", Suffix

     do
		read (*,*,iostat=ReadStatus) GivenFile
		if (ReadStatus.GT.0) print*, "  > Not a string. Try again."
		if (GivenFile.EQ."") print*, "  > A null string. Try again."
		if (ReadStatus.LE.0.AND.GivenFile.NE."") exit
     end do
    end if
      
    StrLen = len(trim(GivenFile))
    if (GivenFile((StrLen-1):StrLen).EQ.'.Z'.OR.GivenFile((StrLen-1):StrLen).EQ.'.X') then
      	GivenFile((StrLen-1):StrLen) = '  '		! remove any zip or binary
        StrLen = len(trim(GivenFile))
    end if
      
    if (NullSuffix.EQ.0.AND.GivenFile((StrLen-3):StrLen).NE.Suffix) then	! file has wrong suffix
    	print*, "  > Suffix is not: ", Suffix
    	GivenFile = "" ; GivenFile = ""
    else									! look for file
     inquire (file=GivenFile, name=FoundFile)
     FoundFile=GivenFile
!     print *, GivenFile
!     print *, FoundFile
!     print *, Suffix
!     print *, CallFile
     open (1, file=FoundFile, status="new", action="write", iostat=ReadStatus)

     if (ReadStatus .NE. 0) then
      print*, "  > Failed to create file. Try again."
      GivenFile = ""
     else
      close (1)
      call system ('rm ' // FoundFile)			! remove successfully created file
      
      StrLen = len_trim (FoundFile)
      ZipFile = FoundFile(1:StrLen) // ".Z"
      
      open (1, file=ZipFile, status="new", action="write", iostat=ReadStatus)

      if (ReadStatus .NE. 0) then
        print*, "  > A zipped file has this name. Try again."
        GivenFile = ""        
      else
        close (1)
        call system ('rm ' // ZipFile)			! remove successfully created zip file
        
        BinFile = FoundFile(1:StrLen) // ".X"
      
        open (1, file=BinFile, status="new", action="write", iostat=ReadStatus)

        if (ReadStatus .NE. 0) then
          print*, "  > A binary file has this name. Try again."
          GivenFile = ""        
        else
          close (1)
          call system ('rm ' // BinFile)		! remove successfully created bin file
        end if
      end if
     end if
    end if
    
    if (GivenFile.NE."") exit
end do

SavePath = FoundFile

end function SavePath

!*******************************************************************************
! feed this function with an Real and it will return it as text

function GetTextFromReal (Real)

character (len=20) :: GetTextFromReal
integer :: ReadStatus
real :: Real

open  (98,file="temp.trash",status="replace",action="readwrite",iostat=ReadStatus)

write (98,"(a15,f5.1)") "               ", Real
rewind(98)
read  (98,"(a20)") GetTextFromReal

close (98)

GetTextFromReal = adjustl(GetTextFromReal)

end function GetTextFromReal

!*******************************************************************************
! feed this function with an integer and it will return it as text

function GetTextFromInt (Int)

character (len=20) :: GetTextFromInt
integer :: Int, ReadStatus

open  (98,file="temp.trash",status="replace",action="readwrite",iostat=ReadStatus)

write (98,"(i20)") Int
rewind(98)
read  (98,"(a20)") GetTextFromInt

close (98)

GetTextFromInt = adjustl(GetTextFromInt)

end function GetTextFromInt

!*******************************************************************************
! feed this function with text and it will return it as an integer

function GetIntFromText (Text)

character (len=20) :: Text
integer :: GetIntFromText, ReadStatus

open  (98,file="temp.trash",status="replace",action="readwrite",iostat=ReadStatus)

write (98,"(a20)") Text
rewind(98)
read  (98,"(i20)") GetIntFromText

close (98)

end function GetIntFromText

!*******************************************************************************
! feed it with the constant stem and tip, and the unique text strings 
!   to insert between the stem and tip in order to make the set of filepaths (Batch)

subroutine MakeBatch (Stem,Tip,UniqueName,Batch)

character (len=80), pointer, dimension (:) 	:: Batch
character (len=20), pointer, dimension (:) 	:: UniqueName
character (len=80), intent(in) 			:: Stem,Tip

integer :: AllocStat
integer :: XFile,XLetter,XFileCheck
integer :: FileN,LetterN
integer :: NameLen

character (len=80) :: Name

FileN = size (UniqueName,1)

allocate (Batch(FileN),stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: MakeBatch: Allocation failure #####"
Batch=" " ; Batch = trim(adjustl(Stem))

do XFile = 1, FileN					! iterate by File
  Name = trim(adjustl(UniqueName(XFile)))
  LetterN = len_trim(Name)
  if (LetterN.GE.1) then
   do XLetter = 1, LetterN				! for each letter in the Fileion name 
    if (Name(XLetter:XLetter).NE." ".AND.Name(XLetter:XLetter).NE.".") then
      Batch(XFile) = trim(Batch(XFile)) // Name(XLetter:XLetter)	! add it to filepath
    else
      Batch(XFile) = trim(Batch(XFile)) // "_"				! or add _ to filepath
    end if
   end do
  else
   Batch(XFile) = trim(Stem) // "v"
  end if
end do

do XFile = 2, FileN					! check for duplicates
  XFileCheck = 0
  do
    XFileCheck = XFileCheck + 1
    if (Batch(XFile).EQ.Batch(XFileCheck)) then
      Name = GetTextFromInt(XFile)
      Batch(XFile) = trim(Batch(XFile)) // trim(Name)
    end if
    if (XFileCheck.EQ.(XFile-1)) exit
  end do
end do

do XFile = 1, FileN					! add the final suffixes
  Batch(XFile) = trim(Batch(XFile)) // trim(adjustl(Tip))
end do

end subroutine MakeBatch

!*******************************************************************************

end module FileNames