From 648c8d59345cabec373a98c9b35f46bc473bcd84 Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Tue, 10 May 2022 17:28:05 +0900 Subject: [PATCH] Inquire directory for gFortran --- Makefile | 14 ++++++++++---- excittrans.f90 | 3 ++- fileIO.f90 | 36 +++++++++++++++++++++++++++++++++++- inquire.c | 19 +++++++++++++++++++ population.f90 | 3 ++- sub.f90 | 7 ++++--- 6 files changed, 72 insertions(+), 10 deletions(-) create mode 100644 inquire.c diff --git a/Makefile b/Makefile index 93dc84c..a940282 100644 --- a/Makefile +++ b/Makefile @@ -7,6 +7,7 @@ OPT1 = -O1 -qopenmp -qopenmp-link=static -threads $(SIMD) -diag-disable 8290,829 LIB_GUI = ./GUI/dislin_d-11.0.a -lXm -lXt -lX11 -lGL #At least works for CentOS 7.x LIB_noGUI = FC = ifort +CC = icc EXE = Multiwfn EXE_noGUI = Multiwfn_noGUI LIBRETAPATH = ./libreta_hybrid @@ -16,7 +17,8 @@ DFTxclib.o edflib.o fparser.o fileIO.o spectrum.o DOS.o Multiwfn.o 0123dim.o LSB population.o orbcomp.o bondorder.o topology.o excittrans.o otherfunc.o \ otherfunc2.o otherfunc3.o O1.o surfana.o procgriddata.o AdNDP.o fuzzy.o CDA.o basin.o \ orbloc.o visweak.o EDA.o CDFT.o ETS_NOCV.o atmraddens.o NAONBO.o grid.o PBC.o hyper_polar.o deloc_aromat.o \ -minpack.o blockhrr_012345.o ean.o hrr_012345.o eanvrr_012345.o boysfunc.o naiveeri.o ryspoly.o +minpack.o blockhrr_012345.o ean.o hrr_012345.o eanvrr_012345.o boysfunc.o naiveeri.o ryspoly.o \ +inquire.o objects_noGUI = noGUI/dislin_d_empty.o @@ -74,7 +76,10 @@ plot.o : plot.f90 define.o util.o GUI.o : GUI.f90 define.o plot.o function.o $(FC) $(OPT) -c GUI.f90 -modules = define.o util.o function.o plot.o GUI.o libreta.o +fileIO.o : fileIO.f90 define.o util.o + $(FC) $(OPT) -c fileIO.f90 + +modules = define.o util.o function.o plot.o GUI.o libreta.o fileIO.o #Library or adpated third-part codes @@ -109,8 +114,6 @@ sub.o : sub.f90 $(modules) integral.o : integral.f90 $(modules) $(FC) $(OPT) -c integral.f90 -fileIO.o : fileIO.f90 $(modules) - $(FC) $(OPT) -c fileIO.f90 spectrum.o : spectrum.f90 $(modules) $(FC) $(OPT) -c spectrum.f90 @@ -202,6 +205,9 @@ hyper_polar.o : hyper_polar.f90 $(modules) deloc_aromat.o : deloc_aromat.f90 $(modules) $(FC) $(OPT) -c deloc_aromat.f90 +inquire.o : inquire.c + $(CC) -O2 -c inquire.c + noGUI/dislin_d_empty.o : noGUI/dislin_d_empty.F90 $(FC) $(OPT) -c noGUI/dislin_d_empty.F90 -o noGUI/dislin_d_empty.o diff --git a/excittrans.f90 b/excittrans.f90 index 15c11de..063dce1 100644 --- a/excittrans.f90 +++ b/excittrans.f90 @@ -5641,6 +5641,7 @@ subroutine CTspectrum use excitinfo use defvar use util +use fileIO, only: inquire implicit real*8 (a-h,o-z) character c80tmp*80,c2000tmp*2000,tmpdir*12 integer,allocatable :: fragnatm(:),frag(:,:) !Indices of atoms in fragments, frag(1:fragnatm(i),i) are atoms in fragment i @@ -5800,7 +5801,7 @@ if (imethod==2.and.iautointgrid==1) then end if !Generate CTspectrum.txt -inquire(directory="CT_multiple",exist=alive) +call inquire(directory="CT_multiple",exist=alive) if (alive) then if (isys==1) then !delete old wfntmp folder write(*,*) "Running: rmdir /S /Q CT_multiple" diff --git a/fileIO.f90 b/fileIO.f90 index 7dd4c26..3e4d460 100644 --- a/fileIO.f90 +++ b/fileIO.f90 @@ -11093,4 +11093,38 @@ else if (isys==2) then end if write(*,*) "Deleting "//trim(delname) call system(trim(command)) -end subroutine \ No newline at end of file +end subroutine + +module fileIO + implicit none +contains + subroutine inquire(directory, file, exist) + use, intrinsic ::iso_c_binding, only: c_int, c_char + character(kind=c_char, len=*), intent(in), optional :: directory + character(kind=c_char, len=*), intent(in), optional :: file + logical, intent(out) :: exist + integer(kind=c_int) :: i_exist + interface + subroutine inquire_directory(directory, exist) bind(C, name="inquire_directory") + import + character(kind=c_char), intent(in) :: directory(*) + integer(kind=c_int), intent(out) :: exist + end subroutine inquire_directory + subroutine inquire_file(file, exist) bind(C, name="inquire_file") + import + character(kind=c_char), intent(in) :: file(*) + integer(kind=c_int), intent(out) :: exist + end subroutine inquire_file + end interface + if (present(directory).and.present(file)) then + error stop "Both file and directory are checked simultaneously!" + else if (.not.(present(directory).or.present(file))) then + error stop "Nothing is for checking!" + else if (present(directory)) then + call inquire_directory(directory // char(0), i_exist) + else if (present(file)) then + call inquire_file(file // char(0), i_exist) + end if + exist = transfer(i_exist, exist) + end subroutine inquire +end module fileIO diff --git a/inquire.c b/inquire.c new file mode 100644 index 0000000..bd633f8 --- /dev/null +++ b/inquire.c @@ -0,0 +1,19 @@ +#include + +void inquire_directory(const char *directory, int *exist) { + struct stat sb; + if (stat(directory, &sb) == 0 && (sb.st_mode & S_IFDIR)) { + *exist = 1; + } else { + *exist = 0; + } +} + +void inquire_file(const char *file, int *exist) { + struct stat sb; + if (stat(file, &sb) == 0 && (sb.st_mode & S_IFREG)) { + *exist = 1; + } else { + *exist = 0; + } +} diff --git a/population.f90 b/population.f90 index ddeb522..f2de8d4 100644 --- a/population.f90 +++ b/population.f90 @@ -3747,6 +3747,7 @@ end subroutine subroutine genatmradfile use defvar use util +use fileIO, only: inquire implicit real*8 (a-h,o-z) character c80tmp*80,c200tmp*200,calclevel*80,radname*200,sep character(len=2) :: statname(-3:3)=(/ "-3","-2","-1","_0","+1","+2","+3" /) @@ -3943,7 +3944,7 @@ do iatm=1,ncenter end if !Generate .gjf file - inquire(directory="atmrad",exist=alive) + call inquire(directory="atmrad",exist=alive) if (.not.alive) call system("mkdir atmrad") c200tmp="atmrad"//sep//trim(a(iatm)%name)//statname(istat)//".gjf" open(10,file=c200tmp,status="replace") diff --git a/sub.f90 b/sub.f90 index a1f929f..ef87b79 100644 --- a/sub.f90 +++ b/sub.f90 @@ -1552,6 +1552,7 @@ end subroutine subroutine setpromol use defvar use util +use fileIO, only: inquire implicit real*8 (a-h,o-z) integer :: itype=0 character(len=2) typename(100),nametmp @@ -1564,7 +1565,7 @@ if (iwfntmptype==1) then if (isys==1) tmpdir="wfntmp\" if (isys==2) tmpdir="wfntmp/" c80tmp="wfntmp" - inquire(directory="wfntmp",exist=alivewfntmp) + call inquire(directory="wfntmp",exist=alivewfntmp) if (isys==1.and.alivewfntmp) then !Delete old wfntmp folder write(*,*) "Running: rmdir /S /Q wfntmp" call system("rmdir /S /Q wfntmp") @@ -1575,7 +1576,7 @@ if (iwfntmptype==1) then else if (iwfntmptype==2) then do i=1,9999 !Find a proper name of temporary folder write(c80tmp,"('wfntmp',i4.4)") i - inquire(directory=c80tmp,exist=alivewfntmp) + call inquire(directory=c80tmp,exist=alivewfntmp) if (.not.alivewfntmp) exit end do if (isys==1) write(tmpdir,"('wfntmp',i4.4,'\')") i @@ -1583,7 +1584,7 @@ else if (iwfntmptype==2) then end if write(*,*) "Running: mkdir "//trim(c80tmp) !Build new temporary folder call system("mkdir "//trim(c80tmp)) -inquire(directory="atomwfn",exist=aliveatomwfn) +call inquire(directory="atomwfn",exist=aliveatomwfn) if (isys==1.and.aliveatomwfn) then write(*,*) "Running: copy atomwfn\*.wfn "//trim(tmpdir) call system("copy atomwfn\*.wfn "//trim(tmpdir)) -- 2.25.1

map