!
! This file is part of SACAMOS, State of the Art CAble MOdels for Spice.
! It was developed by the University of Nottingham and the Netherlands Aerospace
! Centre (NLR) for ESA under contract number 4000112765/14/NL/HK.
!
! Copyright (C) 2016-2018 University of Nottingham
!
! SACAMOS is free software: you can redistribute it and/or modify it under the
! terms of the GNU General Public License as published by the Free Software
! Foundation, either version 3 of the License, or (at your option) any later
! version.
!
! SACAMOS is distributed in the hope that it will be useful, but
! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
! for more details.
!
! A copy of the GNU General Public License version 3 can be found in the
! file GNU_GPL_v3 in the root or at .
!
! SACAMOS uses the EISPACK library (in /SRC/EISPACK). EISPACK is subject to
! the GNU Lesser General Public License. A copy of the GNU Lesser General Public
! License version can be found in the file GNU_LGPL in the root of EISPACK
! (/SRC/EISPACK ) or at .
!
! The University of Nottingham can be contacted at: ggiemr@nottingham.ac.uk
!
!
! File Contents:
!SUBROUTINE write_license
!SUBROUTINE path_format
!FUNCTION path_exists
!SUBROUTINE check_and_make_path
!SUBROUTINE write_long_node_list
!
! NAME
! write_license
!
! DESCRIPTION
! writes the license agreement note
!
! HISTORY
!
! started 3/05/13 CJS
!
! COMMENTS
!
SUBROUTINE write_license()
IMPLICIT NONE
! variables passed to subroutine
! local variables
! START
write(*,*)''
write(*,*)'This software is part of SACAMOS, State of the Art CAble MOdels for Spice.'
write(*,*)'It was developed by the University of Nottingham and the Netherlands Aerospace'
write(*,*)'Centre (NLR) for ESA under contract number 4000112765/14/NL/HK. '
write(*,*)' '
write(*,*)'Copyright (C) 2016-2018 University of Nottingham '
write(*,*)' '
write(*,*)'SACAMOS is free software: you can redistribute it and/or modify it under the'
write(*,*)'terms of the GNU General Public License as published by the Free Software'
write(*,*)'Foundation, either version 3 of the License, or (at your option) any later'
write(*,*)'version. '
write(*,*)' '
write(*,*)'SACAMOS is distributed in the hope that it will be useful, but '
write(*,*)'WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY'
write(*,*)'or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License'
write(*,*)'for more details. '
write(*,*)' '
write(*,*)'A copy of the GNU General Public License version 3 can be found in the'
write(*,*)'file GNU_GPL_v3 in the root or at . '
write(*,*)''
RETURN
END SUBROUTINE write_license
!
! NAME
! path_format
!
! DESCRIPTION
! check the specified path format- it should end with a /
! if not, put one on
!
! HISTORY
!
! started 29/1/2016 CJS
!
! COMMENTS
!
SUBROUTINE path_format(path)
USE type_specifications
IMPLICIT NONE
! variables passed to subroutine
character(len=filename_length),intent(INOUT) :: path
! local variables
integer :: length
! START
length=LEN_TRIM(path)
! Note the different forms for the directory separator in unix and windows
! The file_separator is defined in general_module.F90 for both operating systems
! and is set appropriately using conditional compilation
if (path(length:length).NE.file_separator) then
path=trim(path)//file_separator
end if
RETURN
END SUBROUTINE path_format
!
! NAME
! strip_path
!
! DESCRIPTION
! strip the path from a name based on finding the last file separator character
! and splitting the inpput string there
!
! HISTORY
!
! started 24/2/2017 CJS
!
! COMMENTS
!
!
SUBROUTINE strip_path(ipstring,path,name)
USE type_specifications
IMPLICIT NONE
! variables passed to subroutine
character(len=filename_length),intent(IN) :: ipstring
character(len=filename_length),intent(OUT) :: path
character(len=filename_length),intent(OUT) :: name
! local variables
integer :: length
integer :: path_length
integer :: i
! START
length=LEN_TRIM(ipstring)
! Note the different forms for the directory separator in unix and windows
! The file_separator is defined in general_module.F90 for both operating systems
! and is set appropriately using conditional compilation
path_length=0
do i=length,1,-1
if (ipstring(i:i).EQ.file_separator) then
path_length=i
EXIT
end if
end do
if (path_length.NE.0) then
path=ipstring(1:path_length)
name=ipstring(path_length+1:length)
else
path=""
name=ipstring
end if
RETURN
END SUBROUTINE strip_path
!
! NAME
! path_exists
!
! DESCRIPTION
! check that a given path exists
! if not, exit with an error
!
! HISTORY
!
! started 15/1/2016 CJS
!
! COMMENTS
!
FUNCTION path_exists(path)
USE type_specifications
IMPLICIT NONE
logical :: path_exists
! variables passed to subroutine
character(len=filename_length),intent(IN) :: path
! local variables
integer :: ierr
! START
! Try to create a file in the directory. If it works then assume that the directory exists
OPEN(unit=temp_file_unit,file=trim(path)//'temp',iostat=ierr)
! Test for success
path_exists = (ierr == 0)
! Close and delete the temporary file
if (ierr .EQ. 0) CLOSE(unit=temp_file_unit,status='delete')
RETURN
END FUNCTION path_exists
!
! NAME
! check_and_make_path
!
! DESCRIPTION
! check that a given path exists
! if not, make the appropriate directories
!
! HISTORY
!
! started 15/1/2016 CJS
!
! COMMENTS
! Uses mkdir -p which can build the whole path as opposed to mkdir which can only build the bottom level directory
! mkdir -p works in ubuntu 14.04 - not sure that this is a portable solution though...
!
SUBROUTINE check_and_make_path(path)
USE type_specifications
IMPLICIT NONE
! variables passed to subroutine
character(len=filename_length),intent(IN) :: path
! local variables
character(len=line_length) :: command
! START
! check whether the path already exists, if so all is OK and we can return
if (path_exists(path)) RETURN
! the path doesn't exist so we must create it
! Note there are different forms for the system command on unix and windows
! The mkdir_command is defined in general_module.F90 for both operating systems
command=mkdir_command//trim(path)
CALL EXECUTE_COMMAND_LINE(command)
RETURN
END SUBROUTINE check_and_make_path
!
! NAME
! write_long_node_list
!
! DESCRIPTION
! write a long list of nodes such that each line doesn't exceed the specified length
! This is used so that the maximum number of characters in a spice input file is not exceeded
!
! HISTORY
!
! started 10/10/2016 CJS
!
! COMMENTS
!
!
SUBROUTINE write_long_node_list(n_nodes,node_list,max_length,unit)
USE type_specifications
IMPLICIT NONE
! variables passed to subroutine
integer,intent(IN) :: n_nodes
integer,intent(IN) :: node_list(n_nodes)
integer,intent(IN) :: max_length
integer,intent(IN) :: unit
! local variables
integer :: first_node,last_node,numbers_per_line,number_width
integer :: i
! START
number_width=6 ! unmber of characters to write an integer. Must be consistent with format in write below
numbers_per_line=(max_length-1)/number_width ! -1 for continuation character
! work out the first and last node for the first line
first_node=1
last_node=min(n_nodes,numbers_per_line)
do while (last_node.GE.first_node)
! write the line of the number list
write(unit,'(A)',ADVANCE='NO')'+'
write(unit,'(1000I6)')(node_list(i),i=first_node,last_node)
! work out the first and last node for the next line
first_node=last_node+1
last_node=min(n_nodes,first_node+numbers_per_line-1)
end do
RETURN
END SUBROUTINE write_long_node_list