module haw_toolbox use precision_def contains subroutine getTimestamp(philatelist) integer :: time(8) character(4) :: temp character(20) :: philatelist call date_and_time(VALUES=time) ! write(year,'(i4)'),time(1) ! print *, year !81 format(1x,i2,"/",i2,"/",a2, 1x,i2,":",i2) ! write(philatelist,81),time(2),time(3),year(3:4),time(5),time(6) 81 format(1x,a2,"/",a2,"/",a2, 1x,a2,":",a2) write(philatelist,81),num2string(time(2)),num2string(time(3)),& num2string(time(1)),num2string(time(5)),num2string(time(6)) ! Print *, philatelist end subroutine getTimestamp character(2) function num2string(num) integer :: num character(4) :: temp ! character(2) :: num2string 22 format(i2) 23 format("0",i1) 24 format(i4) if (num < 10) then write(num2string,23),num else if (num <100) then write(num2string,22), num else write(temp,24),num num2string = temp(3:4) end if return !string end function num2string integer function string2num(string) character(*) :: string integer :: i, n integer, allocatable :: nums(:) allocate(nums(len_trim(string))) n = 1 !Extract digits from string: do i=1,len_trim(string) if (is_number(string(i:i))) then read (string(i:i),*) nums(n) ! write (nums(n),'(i1)'),string(i:i) n = n+1 end if end do string2num = 0 !Add up extracted digits into a number: do i=1,(n-1) string2num = string2num + nums(i)* (10**(n-i-1)) ! Print *, "string2num: ", string2num end do return end function string2num integer function extract_int(string) !Extracts number from string; designed for getting BPM numbers character(*) :: string integer :: number,i,count integer, allocatable :: digits(:) allocate(digits(len_trim(string))) count = 0 !Extract individual digits to array do i=1, len_trim(string) if (is_number(string(i:i))) then count = count + 1 read ( string(i:i),*) digits(count) else if (count > 0) then !Exit loop if there's a break in the number exit end if end do !Reconstruct number from digits extract_int = 0 do i=1,count extract_int = extract_int + digits(i)*(10**(count-i)) end do return end function extract_int subroutine generateFilename(num,dirPrefix,filePrefix,extension,filename) character(120) :: filename, dirPrefix character(40) :: filePrefix integer :: num character(6) :: numString, extension character(2) :: dirString call condxNum2String(num,numString) call whichNumberDirectory(numString,dirString) filename = trim(adjustl(dirPrefix)) !Add a / if necessary: if (.not. verify(filename(len_trim(filename):len_trim(filename)), "/") == 0) then filename = trim(filename) // "/" end if filename = trim(filename) // dirString // "/" // trim(filePrefix) & // numString // "." // trim(extension) end subroutine generateFilename subroutine makeDirsExist(path) ! !Make sure file directory exists, and if not, create it. ! character(150) :: checkPath,path,makeCommand,dirName integer :: lastChar logical :: exists !We'll check whether the file /path/path/path/. exists to !see whether or not the directory exists. checkPath = trim(adjustl(path)) lastChar = len_trim(checkPath) !See if the last character is a /; if not, add one if (checkPath(lastChar:lastChar) == '/') then checkPath = trim(checkPath) // "." else checkPath = trim(checkPath) // "/." end if !Print *, "path:", checkPath, " lastChar: ", lastChar !Ask Fortran if the directory exists ! dlk: This trick doesnt work. Inquire always returns false. ! There is no way in standard Fortran-90 to test for the ! existence of a directory. ! Intel Fortran allows (as an extension) ! inquire(directory=trim(checkPath),exist=exists) ! but I don't want to make this compiler dependent. inquire(file=trim(checkPath),exist=exists) !Call system to create folder if it doesn't exist if (.not. exists) then ! !Get last folder in path (the one that doesn't exist) !I'm assuming the folders above it exist; this may need to change. ! dirName = checkPath(1:lastChar) !Remove trailing /. ! Print *, "Making directory: ", dirName ! makeCommand = 'mkdir ' // dirName ! dlk: Letting unix do the directory check does work makeCommand = & 'if [[ ! -d '//trim(dirName)//' ]]; then mkdir '//trim(dirName)//'; fi' ! Print *, "Issuing cmd: ", makeCommand ! Print *, " Command: ", makeCommand call system(makeCommand) end if end subroutine makeDirsExist subroutine miaFFTPath(folderPrefix,filePrefix,filenum,bunchNum,filepath) ! !Generates path and filename prefix for FFT plots and data. Doesn't !add extension. ! character(150) :: filepath character(40) :: folderPrefix,filePrefix character(6) :: stringNum character(2) :: dirNum,bunchStr integer :: filenum,lastChar, bunchNum filepath = trim(adjustl(filepath)) lastChar = len_trim(filepath)-1 !Find numbered directory to put data in call condxNum2String(filenum,stringNum) call whichNumberDirectory(stringNum,dirNum) 13 format ("0",i1) 15 format (i2) if (bunchNum > 9) then write(bunchStr,15),bunchNum else write(bunchStr,13),bunchNum end if !Append numbered directory to base path ! Print *,'a', filepath(lastChar:lastChar) if (filepath(lastChar:lastChar) == "/") then filepath = trim(filepath) // dirNum // '/' else filepath = trim(filepath) //'/' // dirNum // '/' end if ! !Create numbered directory if it doesn't exist already ! call makeDirsExist(filepath) filepath = trim(filepath) // trim(folderPrefix) // '-' // stringNum // '_MIA' // '/' ! Print *, "FFT output path: ", filepath call makeDirsExist(filepath) !Now add filename prefix: filepath = trim(filepath) // trim(filePrefix) // '-' // stringNum // "_bunch"//bunchStr end subroutine miaFFTPath subroutine whichNumberDirectory(numString,dir) ! !Uses number string from conxNum2String to !determine the appropriate numbered directory !to place data in. ! character(6) :: numString character(2) :: dir dir = numString(2:3) !It's that easy! end subroutine whichNumberDirectory function is_number(string) ! !Determines if a string is a file number. !Returns false if the input is anything but !an integer. ! character(len=*) :: string logical :: is_number real(rp) :: numberHolder integer :: inputStatus integer :: strLength integer :: i string = adjustl(string) strLength = len_trim(string) ! do i=1, strLength !Try to read indivual characters into numberHolder; !iostat reveals whether it's a number or not. Read (string(1:strLength), *, iostat=inputStatus) numberHolder if (inputStatus == 0) then is_number = .true. else is_number = .false. end if return end function is_number subroutine lowerCase(string) !Modified from Fortran 90/95 for Scientists and Engineers !Written by S.J. Chapman !Shifts a string to all lowercase letters !Modified to check single characters character(1) :: string integer :: i i=1 if ( LGE(string(i:i), 'A') .and. LLE(string(i:i),'Z')) then string(i:i) = ACHAR( IACHAR ( string(i:i)) + 32) end if end subroutine lowerCase subroutine condxNum2String(num,string) ! !Converts a file number to a 6 digit string, !appending the necessary about of leading 0's. ! integer :: num, howManyZeroes, i character(6) :: string 56 format(i6) write (string,56), num string = adjustl(string) howManyZeroes = 6 - len_trim(string) do i=1, howManyZeroes string = "0" // string end do end subroutine condxNum2String end module haw_toolbox