! ! This file is part of SACAMOS, State of the Art CAble MOdels in 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-2017 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 in 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-2017 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