diff --git a/src/algos/dynamics.f90 b/src/algos/dynamics.f90 index f3a2425..ff351e9 100644 --- a/src/algos/dynamics.f90 +++ b/src/algos/dynamics.f90 @@ -69,9 +69,11 @@ subroutine crest_moleculardynamics(env,tim) !>--- check if we have any MD & calculation settings allocated if (.not. mddat%requested) then write (stdout,*) 'MD requested, but no MD settings present.' + env%iostatus_meta = status_config return else if (calc%ncalculations < 0) then write (stdout,*) 'MD requested, but no calculation settings present.' + env%iostatus_meta = status_config return end if @@ -99,7 +101,8 @@ subroutine crest_moleculardynamics(env,tim) write (stdout,*) 'MD run completed successfully' write (stdout,*) 'Trajectory written to ',trjf else - write (stdout,*) 'MD run terminated with error' + write (stdout,*) 'WARNING: MD run terminated ABNORMALLY' + env%iostatus_meta = status_failed end if !========================================================================================! call tim%stop(14) diff --git a/src/algos/numhess.f90 b/src/algos/numhess.f90 index 4fe28c1..2b081a8 100644 --- a/src/algos/numhess.f90 +++ b/src/algos/numhess.f90 @@ -162,6 +162,8 @@ subroutine crest_numhess(env,tim) write (stdout,*) 'At least two calculation level must be' write (stdout,*) 'given for the calculation of the effective Hessian.' write (stdout,*) + env%iostatus_meta = status_config + return end if @@ -388,7 +390,8 @@ subroutine thermo_standalone(env) write(stdout,'(1x,a,a)') 'Reading frequencies from: ',trim(env%thermo%vibfile) call rdfreq(env%thermo%vibfile,nat3,freq) else - error stop 'No Hessian or vibspectrum file allocated for thermo routine!' + write(stdout,'(1x,a)') 'No Hessian or vibspectrum file allocated for thermo routine!' + call creststop(status_input) endif write(stdout,*) diff --git a/src/algos/optimization.f90 b/src/algos/optimization.f90 index cb88534..775c041 100644 --- a/src/algos/optimization.f90 +++ b/src/algos/optimization.f90 @@ -98,6 +98,7 @@ subroutine crest_optimization(env,tim) close (ich) else write (stdout,*) 'geometry optimization FAILED!' + env%iostatus_meta = status_failed endif write (stdout,*) @@ -169,7 +170,8 @@ subroutine crest_ensemble_optimization(env,tim) if (ex) then ensnam = env%ensemblename else - write (stdout,*) 'no ensemble file provided.' + write (stdout,*) '**ERROR** no ensemble file provided.' + env%iostatus_meta = status_input return end if @@ -178,7 +180,11 @@ subroutine crest_ensemble_optimization(env,tim) !>---- read the input ensemble call rdensembleparam(ensnam,nat,nall) - if (nall .lt. 1) return + if (nall .lt. 1)then + write (stdout,*) '**ERROR** empty ensemble file.' + env%iostatus_meta = status_input + return + endif allocate (xyz(3,nat,nall),at(nat),eread(nall)) call rdensemble(ensnam,nat,nall,at,xyz,eread) !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<---- read the input ensemble call rdensembleparam(ensnam,nat,nall) - if (nall .lt. 1) return - + if (nall .lt. 1)then + write (stdout,*) '**ERROR** empty ensemble file.' + env%iostatus_meta = status_input + return + endif !>--- set OMP parallelization call new_ompautoset(env,'auto',nall,T,Tn) @@ -305,7 +315,8 @@ subroutine crest_ensemble_screening(env,tim) call rmrfw('crest_rotamers_') call optlev_to_multilev(3.0d0,multilevel) call crest_multilevel_oloop(env,ensnam,multilevel) - + if(env%iostatus_meta .ne. 0 ) return + !>--- printout call catdel('cregen.out.tmp') write (stdout,'(/,1x,a,1x,a)') 'Final ensemble on file','<'//trim(ensemblefile)//'>' diff --git a/src/algos/protonate.f90 b/src/algos/protonate.f90 index 70da016..a058bdd 100644 --- a/src/algos/protonate.f90 +++ b/src/algos/protonate.f90 @@ -149,6 +149,7 @@ subroutine crest_new_protonate(env,tim) write (stdout,*) 'WARNING: No suitable protonation sites found!' write (stdout,*) ' Confirm whether you expect π- or LP-centers for your molecule!' write (stdout,*) + env%iostatus_meta = status_failed return end if deallocate (tmpcalc) @@ -176,6 +177,7 @@ subroutine crest_new_protonate(env,tim) write (stdout,*) write (stdout,'(a)') '> WARNING: No remaining protonation sites after applying user defined conditions!' write (stdout,'(a)') '> Modify the search criteria and check your input structure for sanity.' + env%iostatus_meta = status_failed return end if @@ -368,7 +370,7 @@ subroutine protonation_candidates(env,mol,natp,np,protxyz,at,xyz,npnew) if (natp .ne. mol%nat+env%protb%amount) then write (stdout,'(a)') 'WARNING: Inconsistent number of atoms in protonation routine' - error stop + call creststop(status_args) end if if (env%protb%swelem) then @@ -902,7 +904,7 @@ subroutine deprotonation_candidates(env,mol,natp,np,at,xyz,npnew) if (natp .ne. mol%nat-env%protb%amount) then write (stdout,'(a)') 'WARNING: Inconsistent number of atoms in deprotonation routine' - error stop + call creststop(status_args) end if if (env%protb%swelem) then @@ -1114,6 +1116,7 @@ subroutine crest_new_tautomerize(env,tim) write (stdout,*) 'WARNING: No suitable protonation sites found!' write (stdout,*) ' Confirm whether you expect π- or LP-centers for your molecule!' write (stdout,*) + env%iostatus_meta = status_failed return end if deallocate (tmpcalc) @@ -1340,7 +1343,7 @@ subroutine tautomer_candidates(env,mol,natp,npadd,npremove,protxyz,at,xyz,npnew) if (natp .ne. mol%nat) then write (stdout,'(a)') 'WARNING: Inconsistent number of atoms in protonation routine' - error stop + call creststop(status_args) end if ati = 1 !> always refer to Hydrogen for tautomers diff --git a/src/algos/search_1.f90 b/src/algos/search_1.f90 index 92899b0..8b4d9ae 100644 --- a/src/algos/search_1.f90 +++ b/src/algos/search_1.f90 @@ -96,7 +96,8 @@ subroutine crest_search_1(env,tim) !>--- read ensemble call rdensembleparam(ensnam,nat,nall) if (nall .lt. 1) then - write(stdout,*) 'empty ensemble file' + write(stdout,*) '**ERROR** empty ensemble file' + env%iostatus_meta = status_failed return endif allocate (xyz(3,nat,nall),at(nat),eread(nall)) diff --git a/src/algos/search_conformers.f90 b/src/algos/search_conformers.f90 index d4a0b38..a3c32ba 100644 --- a/src/algos/search_conformers.f90 +++ b/src/algos/search_conformers.f90 @@ -90,6 +90,7 @@ subroutine crest_search_imtdgc(env,tim) call tim%start(1,'Trial metadynamics (MTD)') call trialmd(env) call tim%stop(1) + if(env%iostatus_meta .ne. 0 ) return end if !===========================================================! @@ -134,6 +135,7 @@ subroutine crest_search_imtdgc(env,tim) call optlev_to_multilev(env%optlev,multilevel) call crest_multilevel_oloop(env,ensnam,multilevel) call tim%stop(3) + if(env%iostatus_meta .ne. 0 ) return !>--- save the CRE under a backup name call checkname_xyz(crefile,atmp,str) @@ -186,6 +188,7 @@ subroutine crest_search_imtdgc(env,tim) call tim%start(4,'Molecular dynamics (MD)') call crest_rotamermds(env,conformerfile) call tim%stop(4) + if(env%iostatus_meta .ne. 0 ) return !>--- Reoptimization of trajectories call checkname_xyz(crefile,atmp,btmp) @@ -195,6 +198,7 @@ subroutine crest_search_imtdgc(env,tim) call tim%start(3,'Geometry optimization') call crest_multilevel_wrap(env,trim(atmp),-1) call tim%stop(3) + if(env%iostatus_meta .ne. 0 ) return call elowcheck(lower,env) if (lower) then @@ -211,6 +215,8 @@ subroutine crest_search_imtdgc(env,tim) call tim%start(5,'Genetic crossing (GC)') call crest_newcross3(env) call tim%stop(5) + if(env%iostatus_meta .ne. 0 ) return + call confg_chk3(env) call elowcheck(lower,env) if (lower) then @@ -236,6 +242,7 @@ subroutine crest_search_imtdgc(env,tim) call checkname_xyz(crefile,atmp,str) call crest_multilevel_wrap(env,trim(atmp),0) call tim%stop(3) + if(env%iostatus_meta .ne. 0 ) return !==========================================================! !>--- final ensemble sorting @@ -357,7 +364,8 @@ end subroutine crest_refine !>--- read ensemble call rdensembleparam(ensnam,nat,nall) if (nall .lt. 1) then - write(stdout,*) 'empty ensemble file ',trim(ensnam) + write(stdout,*) '**ERROR** empty ensemble file ',trim(ensnam) + env%iostatus_meta = status_failed return endif allocate (xyz(3,nat,nall),at(nat),eread(nall)) @@ -389,8 +397,9 @@ end subroutine crest_refine !>--- check for empty ensemble content call rdensembleparam(trim(inpnam),nat,nall) if (nall .lt. 1) then - write(stdout,*) 'empty ensemble file',trim(inpnam) - stop + write(stdout,*) '**ERROR** empty ensemble file',trim(inpnam) + env%iostatus_meta = status_failed + return endif write(stdout,*) @@ -405,8 +414,9 @@ end subroutine crest_refine !>--- check for empty ensemble content (again) call rdensembleparam(trim(inpnam),nat,nall) if (nall .lt. 1) then - write(stdout,*) 'empty ensemble file',trim(inpnam) - stop + write(stdout,*) '**ERROR** empty ensemble file',trim(inpnam) + env%iostatus_meta = status_failed + return endif !>--- read new ensemble for next iteration allocate (xyz(3,nat,nall),at(nat),eread(nall)) @@ -508,7 +518,8 @@ subroutine crest_rotamermds(env,ensnam) call env%ref%to(mol) call rdensembleparam(ensnam,nat,nall) if (nall .lt. 1) then - write(stdout,*) 'empty ensemble file',trim(ensnam) + write(stdout,*) '**ERROR** empty ensemble file',trim(ensnam) + env%iostatus_meta = status_failed return endif @@ -615,6 +626,7 @@ subroutine crest_newcross3(env) multilevel(4) = .true. end if call crest_multilevel_oloop(env,'confcross.xyz',multilevel) + if(env%iostatus_meta .ne. 0 ) return !>-- append optimized crossed structures and original to a single file call checkname_xyz(crefile,inpnam,outnam) diff --git a/src/algos/search_entropy.f90 b/src/algos/search_entropy.f90 index 1a8e25a..9c1b8c7 100644 --- a/src/algos/search_entropy.f90 +++ b/src/algos/search_entropy.f90 @@ -96,6 +96,7 @@ subroutine crest_search_entropy(env,tim) call tim%start(1,'Trial metadynamics (MTD)') call trialmd(env) call tim%stop(1) + if(env%iostatus_meta .ne. 0) return end if !===========================================================! @@ -140,6 +141,7 @@ subroutine crest_search_entropy(env,tim) call optlev_to_multilev(env%optlev,multilevel) call crest_multilevel_oloop(env,ensnam,multilevel) call tim%stop(3) + if(env%iostatus_meta .ne. 0 ) return !>--- save the CRE under a backup name call checkname_xyz(crefile,atmp,str) @@ -210,6 +212,7 @@ subroutine crest_search_entropy(env,tim) !>-- start from the current crest_conformers.xyz call crest_smtd_mds(env,conformerfile) call tim%stop(6) + if(env%iostatus_meta .ne. 0) return call emtdcheckempty(env,fail,env%emtd%nbias) if (fail) then @@ -226,6 +229,7 @@ subroutine crest_search_entropy(env,tim) multilevel = (/.true.,.false.,.false.,.false.,.false.,.true./) call crest_multilevel_oloop(env,trim(atmp),multilevel) call tim%stop(3) + if(env%iostatus_meta .ne. 0 ) return !>--- if in the entropy mode a lower structure was found -> cycle (required for extrapolation) call elowcheck(lower,env) @@ -311,7 +315,8 @@ subroutine crest_smtd_mds(env,ensnam) call env%ref%to(mol) call rdensembleparam(ensnam,nat,nall) if (nall .lt. 1) then - write (stdout,*) 'empty ensemble file',trim(ensnam) + write (stdout,*) '**ERROR** empty ensemble file',trim(ensnam) + env%iostatus_meta = status_failed return end if @@ -449,7 +454,10 @@ subroutine crest_init_multimd_smtd(env,mddats,nsim,biasfile) !>--- load static bias stuctures inquire (file=biasfile,exist=ex) - if (.not.ex) error stop 'Could not initialize static metadynamics' + if (.not.ex)then + write(stdout,'(a,a)') 'Could not initialize static metadynamics: missing ',trim(biasfile) + call creststop(status_input) + endif call rdensembleparam(biasfile,nat,nall) allocate (xyz(3,nat,nall),at(nat),eread(nall)) call rdensemble(biasfile,nat,nall,at,xyz,eread) diff --git a/src/algos/search_mecp.f90 b/src/algos/search_mecp.f90 index fdf4a91..b480fbf 100644 --- a/src/algos/search_mecp.f90 +++ b/src/algos/search_mecp.f90 @@ -50,8 +50,9 @@ subroutine crest_search_mecp(env,tim) !>--- check calculation setup ex = env%calc%ncalculations > 1 if (.not.ex) then - write (stdout,*) 'not enough calculation levels specified for MECP search.' - error stop + write (stdout,*) '**ERROR** Not enough calculation levels specified for MECP search.' + env%iostatus_meta = status_config + return end if call print_gapcons(env%calc) @@ -120,6 +121,7 @@ end subroutine crest_search_mecp subroutine print_gapcons(calc) use crest_parameters + use crest_data use crest_calculator implicit none @@ -152,8 +154,8 @@ subroutine print_gapcons(calc) end do if (.not.ex) then - write (stdout,*) 'no gap constraint provided' - error stop + write (stdout,*) '**ERROR** no gap constraint provided' + call creststop(status_config) else write (stdout,*) end if diff --git a/src/algos/search_newnci.f90 b/src/algos/search_newnci.f90 index f8b1d45..2472b28 100644 --- a/src/algos/search_newnci.f90 +++ b/src/algos/search_newnci.f90 @@ -87,6 +87,7 @@ subroutine crest_search_newnci(env,tim) call tim%start(1,'Trial metadynamics (MTD)') call trialmd(env) call tim%stop(1) + if(env%iostatus_meta .ne. 0 ) return end if !===========================================================! @@ -131,6 +132,7 @@ subroutine crest_search_newnci(env,tim) call optlev_to_multilev(env%optlev,multilevel) call crest_multilevel_oloop(env,ensnam,multilevel) call tim%stop(3) + if(env%iostatus_meta .ne. 0 ) return !>--- save the CRE under a backup name call checkname_xyz(crefile,atmp,str) @@ -192,6 +194,7 @@ subroutine crest_search_newnci(env,tim) call checkname_xyz(crefile,atmp,str) call crest_multilevel_wrap(env,trim(atmp),0) call tim%stop(3) + if(env%iostatus_meta .ne. 0 ) return !==========================================================! !>--- print CREGEN results and clean up Directory a bit diff --git a/src/algos/setuptest.f90 b/src/algos/setuptest.f90 index baf35ec..c118957 100644 --- a/src/algos/setuptest.f90 +++ b/src/algos/setuptest.f90 @@ -149,7 +149,8 @@ subroutine trialMD_calculator(env) write (stdout,'(1x,"Automatic MD restart failed ",i0," times!")') counter write (stdout,'(1x,"Please try other settings manually.")') write (stdout,*) - error stop + env%iostatus_meta = status_safety + return end if counter = counter+1 @@ -163,7 +164,9 @@ subroutine trialMD_calculator(env) else if (tstep <= 1.0d0.and.shakemode == 0) then write (stdout,'(1x,"Automatic MTD settings check failed!")') write (stdout,'(1x,"Please try other settings manually.")') - error stop + write (stdout,*) + env%iostatus_meta = status_safety + return end if !> don't reduce the timestep below 1 fs automatically @@ -346,7 +349,7 @@ subroutine trialOPT_warning(env,mol,success) write (stdout,*) write (stdout,*) ' Initial geometry optimization failed!' write (stdout,*) ' Please check your input and, if present, crestopt.log.' - error stop + call creststop(status_failed) end if write (stdout,*) 'Geometry successfully optimized.' !---- if necessary, check if the topology has changed! @@ -399,7 +402,7 @@ subroutine trialOPT_warning(env,mol,success) write (stdout,'(/,4x,a)') 'C) Fix the initial input geometry by introducing bond length constraints' write (stdout,'(4x,a)') ' or by using a method with fixed topology (e.g. GFN-FF).' write (stdout,*) - error stop 'safety termination of CREST' + call creststop(status_safety) end if end if end if diff --git a/src/algos/singlepoint.f90 b/src/algos/singlepoint.f90 index 4e43670..6fb67e2 100644 --- a/src/algos/singlepoint.f90 +++ b/src/algos/singlepoint.f90 @@ -99,6 +99,7 @@ subroutine crest_singlepoint(env,tim) if (io /= 0) then write (stdout,*) write (stdout,*) 'WARNING: Calculation exited with error!' + env%iostatus_meta = status_failed else !>--- print out the results write (stdout,*) 'SUCCESS!' @@ -182,7 +183,8 @@ subroutine crest_xtbsp(env,xtblevel,molin) !>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<--- write wbo file @@ -238,7 +240,8 @@ subroutine crest_ensemble_singlepoints(env,tim) if (ex) then ensnam = env%ensemblename else - write (stdout,*) 'no ensemble file provided.' + write (stdout,*) '**ERROR** no ensemble file provided.' + env%iostatus_meta = status_input return end if @@ -247,7 +250,11 @@ subroutine crest_ensemble_singlepoints(env,tim) !>---- read the input ensemble call rdensembleparam(ensnam,nat,nall) - if (nall .lt. 1) return + if (nall .lt. 1)then + write (stdout,*) '**ERROR** empty ensemble file.' + env%iostatus_meta = status_input + return + endif allocate (xyz(3,nat,nall),at(nat),eread(nall)) call rdensemble(ensnam,nat,nall,at,xyz,eread) !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<--- exit status + integer,parameter,public :: status_normal = 0 !> success + integer,parameter,public :: status_error = 1 !> general error + integer,parameter,public :: status_ioerr = 2 !> general I/O error + integer,parameter,public :: status_args = 4 !> invalid subroutine arguments + integer,parameter,public :: status_input = 10 !> Input file read error + integer,parameter,public :: status_config = 20 !> invalid configuration + integer,parameter,public :: status_failed = 155 !> general calculation failure + integer,parameter,public :: status_safety = 156 !> safety terminantion + !>--- refinement levels (typically after multilevel opt.) type ,private:: refine_type integer :: non = 0 @@ -307,6 +317,9 @@ module crest_data !========================================================================================! !>--- GENERAL data type :: systemdata + + integer :: iostatus_meta = status_normal !> The overall program exit status + integer :: crestver !> Runtype-variable integer :: runver !> additional runtype-variable integer :: properties !> additional stuff before or after the confsearch diff --git a/src/crest_main.f90 b/src/crest_main.f90 index c8d9fc4..e9809d4 100644 --- a/src/crest_main.f90 +++ b/src/crest_main.f90 @@ -21,10 +21,11 @@ ! This is the code of the Conformer-Rotamer Ensemble Sampling Tool (CREST). !=========================================================================================! program CREST - use iso_fortran_env,wp => real64 - !> module for the main data storage - use crest_data - use crest_restartlog +! use iso_fortran_env,wp => real64 + use crest_parameters !> Datatypes and constants + use crest_data !> module for the main data storage (imports systemdata and timer) + use crest_restartlog + USE, INTRINSIC :: IEEE_EXCEPTIONS implicit none type(systemdata) :: env !> MAIN STORAGE OF SYSTEM DATA type(timer) :: tim !> timer object @@ -38,6 +39,7 @@ program CREST logical :: ex,ex1,ex2 intrinsic :: iargc,getarg + LOGICAL :: overflow, division_by_zero, invalid_operation call initsignal() !SIGTERM catcher @@ -361,9 +363,9 @@ program CREST call custom_cleanup(env) !=========================================================================================! -!> Evaluate and print timings +!> Evaluate and print timings, then stop the program call eval_timer(tim) - write (*,*) 'CREST terminated normally.' + call creststop(env%iostatus_meta) !> end of main program end program CREST diff --git a/src/parsing/confparse2.f90 b/src/parsing/confparse2.f90 index fc31a59..9eb8a4e 100644 --- a/src/parsing/confparse2.f90 +++ b/src/parsing/confparse2.f90 @@ -115,7 +115,7 @@ subroutine parseinputfile(env,fname) !>--- terminate if there were any unrecognized keywords if(readstatus /= 0)then write(stdout, '(i0,a)') readstatus,' error(s) while reading input file' - error stop + call creststop(status_config) endif !>--- check for lwONIOM setup (will be read at end of confparse) @@ -192,6 +192,10 @@ subroutine env_calcdat_specialcases(env) integer :: i,j,k,l integer :: refine_lvl + !> if this return is triggered, the program will fall back to GFN2 at some point + if(env%calc%ncalculations .lt. 1) return + + !> special case for GFN-FF calculations if (any(env%calc%calcs(:)%id == jobtype%gfnff)) then env%mdstep = 1.5d0 diff --git a/src/parsing/constraining.f90 b/src/parsing/constraining.f90 index 2ec0e33..43c62ce 100644 --- a/src/parsing/constraining.f90 +++ b/src/parsing/constraining.f90 @@ -516,7 +516,8 @@ end subroutine write_cts_biasext ! build a constrainment file for the chosen list of atoms !----------------------------------------------------------------------------- subroutine quick_constrain_file(fname,nat,at,atlist) - use iso_fortran_env,only:output_unit + use crest_parameters + use crest_data use iomod implicit none !> Input @@ -541,10 +542,11 @@ subroutine quick_constrain_file(fname,nat,at,atlist) write (*,'(1x,i0,a,i0,a)') ncon,' of ',nat,' atoms will be constrained.' write (*,'(1x,a,a,a)') 'A reference coord file ',fname,'.ref was created.' write (*,'(1x,a,/)') 'The following will be written to <.xcontrol.sample>:' - call cat_mod(output_unit,' > ','.xcontrol.sample','') + call cat_mod(stdout,' > ','.xcontrol.sample','') write (*,*) deallocate (unconstrained) - stop '<.xcontrol.sample> written. exit.' + write(stdout,'(a)') '<.xcontrol.sample> written. exit.' + call creststop(status_normal) end subroutine quick_constrain_file subroutine build_constrain_file(fname,nat,unconstrained) diff --git a/src/parsing/parse_calcdata.f90 b/src/parsing/parse_calcdata.f90 index 0f93444..3597568 100644 --- a/src/parsing/parse_calcdata.f90 +++ b/src/parsing/parse_calcdata.f90 @@ -66,6 +66,8 @@ module parse_calcdata character(len=*),parameter,private :: fmturk = '("unrecognized KEYWORD in ",a," : ",a)' character(len=*),parameter,private :: fmtura = '("unrecognized ARGUMENT : ",a)' + external creststop + !========================================================================================! !========================================================================================! contains !> MODULE PROCEDURES START HERE @@ -245,7 +247,7 @@ subroutine parse_setting_auto(env,job,kv,rd) job%id = jobtype%unknown !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) kv%value_c - error stop + call creststop(status_config) end select case ('bin','binary','script') @@ -276,7 +278,8 @@ subroutine parse_setting_auto(env,job,kv,rd) job%gradtype = gradtype%unknown !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) kv%value_c - error stop + call creststop(status_config) + end select case ('gradkey') @@ -306,7 +309,8 @@ subroutine parse_setting_auto(env,job,kv,rd) job%tblitelvl = xtblvl%unknown !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) kv%value_c - error stop + call creststop(status_config) + end select case ('tblite_param') job%tbliteparam = kv%value_c @@ -336,7 +340,8 @@ subroutine parse_setting_auto(env,job,kv,rd) job%refine_lvl = refine%non !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) kv%value_c - error stop + call creststop(status_config) + end select case ('restartfile','topo','reftopo') @@ -346,31 +351,34 @@ subroutine parse_setting_auto(env,job,kv,rd) job%restartfile = kv%value_c else write (stderr,'(a,a,a)') 'specified restart file ',kv%value_c,' does not exist' - error stop + call creststop(status_input) end if + case ('refgeo','refxyz') inquire (file=kv%value_c,exist=ex) if (ex) then job%refgeo = kv%value_c else write (stderr,'(a,a,a)') 'specified reference geometry file ',kv%value_c,' does not exist' - error stop + call creststop(status_input) end if + case ('parametrisation') inquire (file=kv%value_c,exist=ex) if (ex) then job%parametrisation = kv%value_c else write (stderr,'(a,a,a)') 'specified parametrisation file ',kv%value_c,' does not exist' - error stop + call creststop(status_input) end if + case ('refchrg','refcharges') inquire (file=kv%value_c,exist=ex) if (ex) then job%refcharges = kv%value_c else write (stderr,'(a,a,a)') 'specified reference charge file ',kv%value_c,' does not exist' - error stop + call creststop(status_config) end if case ('print') @@ -509,7 +517,7 @@ subroutine parse_calc_auto(env,calc,kv,rd) case default !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) kv%value_c - error stop + call creststop(status_config) end select case ('opt','opt_engine','opt_algo') @@ -525,7 +533,7 @@ subroutine parse_calc_auto(env,calc,kv,rd) case default !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) kv%value_c - error stop + call creststop(status_config) end select case ('freeze') @@ -614,7 +622,7 @@ subroutine parse_constraint_auto(env,calc,constr,kv,success,rd) case default !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) kv%value_c - error stop + call creststop(status_config) end select if (constr%type /= 0) success = .true. @@ -793,7 +801,8 @@ subroutine parse_constraint_auto(env,calc,constr,kv,success,rd) dum4 = kv%value_fa(6) call constr%bondrangeconstraint(atm1,atm2,dum1,dum2,beta=dum3,T=dum4) case default - error stop '**ERROR** wrong number of arguments in bondrange constraint' + write(stdout,'(a)') '**ERROR** wrong number of arguments in bondrange constraint' + call creststop(status_config) end select success = .true. !>-------------- diff --git a/src/parsing/parse_inputfile.F90 b/src/parsing/parse_inputfile.F90 index f79c947..4497c87 100644 --- a/src/parsing/parse_inputfile.F90 +++ b/src/parsing/parse_inputfile.F90 @@ -19,6 +19,7 @@ module parse_inputfile use crest_parameters + use crest_data use parse_datastruct use parse_toml implicit none @@ -27,6 +28,8 @@ module parse_inputfile public :: parse_test public :: parse_input + external creststop + !========================================================================================! !========================================================================================! contains !> MODULE PROCEDURES START HERE @@ -72,7 +75,7 @@ subroutine parse_input(fname,dict) select case (extension) case default write (stdout,'(a,a)') 'Unknown file format of input file ',trim(fname) - error stop + call creststop(status_input) case ('.toml') #ifdef WITH_TOMLF !>--- parse .toml file via the toml-f library (the DEFAULT setting) diff --git a/src/parsing/parse_maindata.f90 b/src/parsing/parse_maindata.f90 index 723ddc1..e2e04f4 100644 --- a/src/parsing/parse_maindata.f90 +++ b/src/parsing/parse_maindata.f90 @@ -40,6 +40,8 @@ module parse_maindata character(len=*),parameter,private :: fmturk = '("unrecognized KEYWORD in ",a," : ",a)' character(len=*),parameter,private :: fmtura = '("unrecognized ARGUMENT : ",a)' + external creststop + !========================================================================================! !========================================================================================! contains !> MODULE PROCEDURES START HERE @@ -212,7 +214,7 @@ subroutine parse_main_c(env,key,val,rd) case default !>--- keyword was recognized, but invalid argument supplied write (stdout,fmtura) val - error stop + call creststop(status_config) end select case ('ensemble_input','ensemble','input_ensemble') diff --git a/src/parsing/parse_toml.F90 b/src/parsing/parse_toml.F90 index 8f31f5a..d1caecb 100644 --- a/src/parsing/parse_toml.F90 +++ b/src/parsing/parse_toml.F90 @@ -25,6 +25,8 @@ module parse_toml public :: parse_tomlf public :: parse_toml_input_fallback + external creststop + !========================================================================================! !========================================================================================! contains !> MODULE PROCEDURES START HERE @@ -87,7 +89,7 @@ subroutine handle_tomlf_error(error) type(toml_error),intent(in),optional :: error if (present(error)) then write (stderr,'(a)') error%message - stop 1 + call creststop(2) end if end subroutine handle_tomlf_error !=======================================================================================! diff --git a/src/sigterm.f90 b/src/sigterm.f90 index 4c26284..e1d3a79 100644 --- a/src/sigterm.f90 +++ b/src/sigterm.f90 @@ -1,7 +1,7 @@ !================================================================================! ! This file is part of crest. ! -! Copyright (C) 2023 Philipp Pracht +! Copyright (C) 2023-2024 Philipp Pracht ! ! crest is free software: you can redistribute it and/or modify it under ! the terms of the GNU Lesser General Public License as published by @@ -16,6 +16,41 @@ ! You should have received a copy of the GNU Lesser General Public License ! along with crest. If not, see . !================================================================================! + +subroutine creststop(io) + use crest_parameters + use crest_data + implicit none + integer,intent(in) :: io + + select case(io) + case (status_normal) + write (stdout,*) 'CREST terminated normally.' + case default + write (stdout,*) 'CREST terminated abnormally.' + case ( status_error ) + write (stdout,*) 'CREST terminated with errors.' + case ( status_ioerr ) + write (stdout,*) 'CREST terminated with I/O errors.' + case ( status_args ) + write (stdout,*) 'CREST terminated due to invalid parameters.' + case ( status_input ) + write (stdout,*) 'CREST terminated due to failed input file read.' + case ( status_config ) + write (stdout,*) 'CREST terminated due to invalid configuration.' + case ( status_failed ) + write (stdout,*) 'CREST terminated with failures.' + case ( status_safety ) + write (stdout,*) 'Safety termination of CREST.' + end select + call exit(io) + +end subroutine creststop + +!================================================================================! +!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC! +!================================================================================! + subroutine wsigint !> Ctrl+C use crest_parameters,only:stderr,stdout use crest_restartlog,only:dump_restart @@ -25,7 +60,7 @@ subroutine wsigint !> Ctrl+C write (stderr,'(" recieved SIGINT, trying to terminate CREST...")') !call dump_restart() call cs_shutdown(io) - call exit(1) + call exit(130) error stop end subroutine wsigint @@ -38,7 +73,7 @@ subroutine wsigquit !> Ctrl+D or Ctrl+\ write (stderr,'(" recieved SIGQUIT, trying to terminate CREST...")') !call dump_restart() call cs_shutdown(io) - call exit(1) + call exit(131) error stop end subroutine wsigquit @@ -51,7 +86,7 @@ subroutine wsigterm !> Recieved by the "kill" pid command write (stderr,'(" recieved SIGTERM, trying to terminate CREST...")') !call dump_restart() call cs_shutdown(io) - call exit(1) + call exit(143) error stop end subroutine wsigterm @@ -62,6 +97,7 @@ subroutine wsigkill integer :: io !call dump_restart() call cs_shutdown(io) + call exit(137) error stop 'CREST recieved SIGKILL.' end subroutine wsigkill