diff --git a/app/main.f90 b/app/main.f90 index 62e9a0a..869c33e 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -25,7 +25,6 @@ program CPCMX use, intrinsic :: iso_fortran_env, only : output_unit, error_unit, input_unit implicit none character(len=*), parameter :: prog_name = "cpx" - logical :: ex integer :: ioerror real(wp), allocatable :: isodens_rad(:) @@ -36,13 +35,12 @@ program CPCMX type(calculation_type) :: calc type(configuration_type) :: config - type(parameter_type) :: parameter type(error_type), allocatable :: error - - - !! ------------------------------------------------------------ + + + !! ------------------------------------------------------------ !! Read Command Line Arguments and set Parameters accordingly !! ------------------------------------------------------------ Call timer%push("total") @@ -54,7 +52,7 @@ program CPCMX else Call initialize_param(config%sac_param_path,calc%param,error) end if - Call check_error(error) + Call check_error(error) if (config%ML) then Call init_pr write(*,*) "Machine Learning Mode selected. Will Only Write an ML.data file." !! ML Mode deprecated @@ -69,10 +67,10 @@ program CPCMX ! write(*,*) "Reading Sigma Profile" ! Call read_singlesig(solvent_sigma,config%csm_solvent,solvent_volume) ! Call read_singlesig(solute_sigma,config%csm_solute,solute_volume) - ! + ! ! Call read_triplesig(solvent_sigma3,config%csm_solvent,solvent_volume) ! Call read_triplesig(solute_sigma3,config%csm_solute,solute_volume) - !else + !else !! ---------------------------------------------------------------------------------- !! Creating COSMO Files with QC packages !! ---------------------------------------------------------------------------------- @@ -92,12 +90,12 @@ program CPCMX error stop end select Call check_error(error) - Call timer%pop() - end if + Call timer%pop() + end if !! ---------------------------------------------------------------------------------- !! Create the Sigma Profile from COSMO files !! ---------------------------------------------------------------------------------- - + Call timer%push("sigma_av") !! ------------------------------------------------------------------------------------ !! Read necessary COSMO Data @@ -116,7 +114,7 @@ program CPCMX call check_error(error) Call read_cosmo(config%csm_solute,calc%solute,config%database,error) call check_error(error) - + !! ------------------------------------------------------------------------------------ !! Sigma Charge Averaging and creating of a single Sigma Profile for Solute and Solvent !! ------------------------------------------------------------------------------------ @@ -130,7 +128,7 @@ program CPCMX !! Determination of Atoms in Rings, necessary for the PR2018 EOS and ER Correction !! ------------------------------------------------------------------------------------ if ((config%ML) .OR. (.NOT. config%model .EQ. "sac")) then - Call timer%push("bondings") + Call timer%push("bondings") write(output_unit,'(5x,a)') "Determine Ring atoms and HB groups." Call calc%init_bonding() Call timer%pop() @@ -147,14 +145,14 @@ program CPCMX end if !! ------------------------------------------------------------------------------------ - !! Exit here if you only want Sigma Profiles to be created + !! Exit here if you only want Sigma Profiles to be created !! ------------------------------------------------------------------------------------ if (config%prof) then; write(*,*) "Only Profile mode choosen, exiting." stop end if !end if - + !! ------------------------------------------------------------------------------------ !! Choice of the different post COSMO Models (sac,sac2010,sac2013,CPCM-X) @@ -179,7 +177,7 @@ program CPCMX ! &config%smd_solvent,config%smd_param_path,config%smd_default) ! ! case("sac2010") - ! + ! ! Call sac_gas(solute_energy,id_scr,solute_area,solute_sv,solute_su,solute_pot) ! Call sac_2010(solvent_sigma3,solute_sigma3,solvent_volume,solute_volume) ! if (config%ML) Call pr2018(solute_area,solute_elements,solute_ident,oh_sol,nh_sol,near_sol) @@ -202,7 +200,7 @@ program CPCMX ! Call sac_2013(solvent_sigma3,solute_sigma3,solvent_volume,solute_volume,sac_disp) ! Call pr2018(solute_area,solute_elements,solute_ident,oh_sol,nh_sol,near_sol) ! case ("crs") - + !! CPCM-RS calculation starts here !! ! Calculation of Solvent Phase energies @@ -226,7 +224,7 @@ program CPCMX "| Gas Phase Results |",& " ------------------------------------------------- ", & "" - + write(output_unit,'(5x,a,t30,F15.8,2x,a)') & "E_COSMO:", calc%solute%energy, "Eh", & "E_COSMO+dE:", (calc%solute%energy+calc%dG_cc),"Eh", & @@ -241,7 +239,7 @@ program CPCMX "Solvent atomic mass:", AtomicMass(calc%solvent%element), "a.u.", & "State correction", calc%dG_ss, "Eh", & "" - + Call timer%push("cds") if (config%isodens) then Call get_isodens_radii(calc%solute%xyz,calc%solute%id,calc%solute%atom_xyz,isodens_rad) @@ -250,13 +248,13 @@ program CPCMX "| Isodensity Radii |",& " ------------------------------------------------- ", & "" - write(output_unit,'(5x,a)'), & + write(output_unit,'(5x,a)') & "Isodensity Flag used, calculated isodensity radii:",& "" - write(output_unit,'(10x,a,t30,a)'), & + write(output_unit,'(10x,a,t30,a)') & "Atom Number:", "[A]" do i=1,maxval(calc%solute%id) - write(output_unit,'(10x,I0,t30,F4.2)'),& + write(output_unit,'(10x,I0,t30,F4.2)') & i, isodens_rad(i) end do write(output_unit,'(a)') "" @@ -273,13 +271,13 @@ program CPCMX Call timer%pop() !end select - + write(output_unit,'(10x,a)') & " ------------------------------------------------- ",& "| Results |",& " ------------------------------------------------- ", & "" - + if (config%ML) then write(*,*) "Writing ML data in ML.data" Call System("paste --delimiters='' ML.energy ML.gamma ML.pr > ML.data") @@ -319,7 +317,7 @@ program CPCMX write(*,*) "total"//repeat(" ", 18)//format_time(ttime) do i = 1,size(label) stime = timer%get(label(i)) - write(*,*) label(i)//repeat(" ",3)//format_time(stime) + write(*,*) label(i)//repeat(" ",3)//format_time(stime) end do end block end if @@ -345,7 +343,7 @@ subroutine help(unit) " --inp", "Allows to specify an input file for advanced configuration.", & " --help", "Show this help message" write(unit, '(a)') - + end subroutine help subroutine sample(filename,rc) @@ -433,20 +431,19 @@ subroutine get_arguments(config, error) type(error_type), allocatable, intent(out) :: error integer :: iarg, narg - real(wp) :: val character(len=:), allocatable :: arg, home logical :: ex Call get_variable("CPXHOME",home) - + if (.not.allocated(home)) then Call move_line("/",home) else if (home(len(home):len(home)) .ne. "/") call move_line(home//"/",home) end if ex=.false. - + config%isodens=.false. iarg = 0 @@ -480,7 +477,7 @@ subroutine get_arguments(config, error) end if call fatal_error(error, "Too many positional arguments present") exit - case ("--prog") + case ("--prog") iarg=iarg+1 call get_argument(iarg,arg) call move_alloc(arg, config%qc_calc) @@ -521,7 +518,7 @@ subroutine get_arguments(config, error) if (config%isodens) then config%qc_calc="tm" - inquire(file=config%database//"/isodens/"//config%sac_param_path, exist=ex) + inquire(file=config%database//"/isodens/"//config%sac_param_path, exist=ex) if (ex) then config%database=config%database//"/isodens" else @@ -570,7 +567,7 @@ subroutine get_arguments(config, error) end if end if end if - + if ((.not.(allocated(config%input))) .AND. (.not. (allocated(config%smd_solvent)))) then if (.not.allocated(error)) then call help(output_unit) @@ -585,17 +582,17 @@ subroutine get_arguments(config, error) end if end if -end subroutine get_arguments +end subroutine get_arguments !> Subroutine to Read the CPCM-SACMD Input File subroutine read_input(config,error) type(configuration_type) :: config type(error_type), allocatable :: error - character(len=100) :: sac_param_path, smd_param_path, line + character(len=100) :: line - integer :: io_error, i, n,j, equal - logical :: ex, started + integer :: io_error, i, j, equal + logical :: ex character(len=:), allocatable :: keyword, substring @@ -637,7 +634,7 @@ subroutine read_input(config,error) else Call move_line(line(j:i-1),keyword) end if - + select case(keyword) case ('TM','tm') if (allocated(config%qc_calc)) then @@ -690,7 +687,7 @@ subroutine read_input(config,error) if (allocated(substring)) deallocate(substring) j=i+1 end if - end do + end do Read(input_unit,'(A)',iostat=io_error,err=255) line !Comment Line Read(input_unit,'(A)',iostat=io_error,err=255) line @@ -700,10 +697,10 @@ subroutine read_input(config,error) Read(input_unit,*,iostat=io_error,err=255) line, config%probe Call move_line(line,config%smd_solvent) Read(input_unit,*,iostat=io_error,err=255) config%T - SysTemp=config%T + SysTemp=config%T config%z1=0.995 config%z2=0.005 - + 255 if (io_error .NE. 0) error stop "Check Input File." end subroutine read_input @@ -722,18 +719,15 @@ subroutine use_default(config, solv, home, error) type(toml_error), allocatable :: config_error character(len=:), allocatable, intent(in) :: home - - + + type(toml_key), allocatable, dimension(:) :: list - integer :: stat - character(len=255) :: line character(:), allocatable :: line2 logical :: ex - character(len=10) :: control, command integer :: nconf, io character(len=:), allocatable :: user - + if (solv .eq. '') then Call fatal_error(error,'The Solvent you specified is not available.') return @@ -761,10 +755,10 @@ subroutine use_default(config, solv, home, error) if (ex) then config%config_path="/home/"//user//"/cpcmx.toml" else - + inquire(file=home//"cpcmx.toml",exist=ex) - if (.not. ex) then + if (.not. ex) then !call fatal_error(error, "No configuration found in "//home) return else @@ -781,7 +775,7 @@ subroutine use_default(config, solv, home, error) call config_table%get_keys(list) do nconf=1,size(list) select case(list(nconf)%key) - case("prog") + case("prog") if (allocated(config%qc_calc)) cycle call get_value(config_table,list(nconf),line2) if (line2 .eq. "NONE") cycle @@ -841,22 +835,22 @@ subroutine move_line(line,aline,hignore) if (present(hignore)) then if (.not. hignore) ignore=.false. - end if + end if if (allocated(aline)) deallocate(aline) if (ignore) then do i= 1,len(trim(line)) - if (line(i:i) .EQ. "#") then + if (line(i:i) .EQ. "#") then allocate(character(len(trim(line(1:i-1)))) :: aline) aline=trim(line(1:i-1)) exit - end if + end if if (i .EQ. len(trim(line))) then allocate(character(len(trim(line(1:i)))) :: aline) aline=trim(line(1:i)) exit - end if + end if end do else allocate(character(len(trim(line))) :: aline) @@ -888,21 +882,21 @@ subroutine echo_init(config) "Solvent:", config%smd_solvent, & "Corresponding COSMO File:", config%csm_solvent - if (allocated(config%qc_calc)) then + if (allocated(config%qc_calc)) then write(output_unit,'(5x,a,t35,a)') & "QC Program:", config%qc_calc else write(output_unit,'(5x,a,t35,a)') & "Solute COSMO File:", config%csm_solute end if - + end subroutine echo_init subroutine check_error(error) type(error_type), intent(in), allocatable :: error integer :: point - + if (allocated(error)) then write(error_unit,'(a)') "" point=index(error%message,".") diff --git a/src/cpcmx/data.f90 b/src/cpcmx/data.f90 index bcbaac0..e4d5b4c 100644 --- a/src/cpcmx/data.f90 +++ b/src/cpcmx/data.f90 @@ -467,8 +467,9 @@ end function density function minnesota_eps(solvent,error) result(epsilon) character(len=*), intent(in) :: solvent type(error_type), allocatable :: error - real(wp):: epsilon + real(wp) :: epsilon + epsilon=ieee_value(epsilon,ieee_positive_inf) select case(solvent_name(solvent)) case('infinity','inf') epsilon=ieee_value(epsilon,ieee_positive_inf) diff --git a/src/cpcmx/initialize.f90 b/src/cpcmx/initialize.f90 index 07c7dc4..4f0013c 100644 --- a/src/cpcmx/initialize.f90 +++ b/src/cpcmx/initialize.f90 @@ -45,7 +45,6 @@ subroutine read_cosmo(compound,mol,database,error) character(:), allocatable :: filen integer :: io_error, dummy1, num, ele_num real(wp) :: dummy3, dummy4, dummy5 - integer, allocatable :: ident(:) character(2) :: element logical :: exists @@ -206,9 +205,7 @@ subroutine load_solvent(solvent,mol,error) character(len=*), intent(in) :: solvent type(error_type), allocatable :: error - character(len=200), allocatable :: cosmo_file(:) character(:), allocatable :: norm_solv - integer :: un, k norm_solv=to_lower(solvent_name(solvent)) if (norm_solv .eq. "") then @@ -228,7 +225,6 @@ subroutine initialize_param_crs(filename,param, error) character(len=*), intent(in) :: filename type(parameter_type), intent(out) :: param logical :: g_exists - integer :: io_error !> Error Handling type(error_type), allocatable :: error @@ -313,7 +309,7 @@ subroutine setup_cov end subroutine setup_cov subroutine load_param(method,solvent,self,error) - use mctc_env, only: error_type, fatal_error, wp + use mctc_env, only: error_type, fatal_error use cpxcalc, only: calculation_type use data, only: solvent_name use internaldb @@ -355,8 +351,7 @@ subroutine initialize_param_def(filename,model,r_cav,disp_con, solvent, error) character(len=3) :: symbol character(len=*) :: filename, model, solvent logical :: g_exists - integer :: i, io_error,dummy1 - character(len=100) :: home,param_path + integer :: i, io_error !> Error Handling type(error_type), allocatable :: error diff --git a/src/cpcmx/profile.f90 b/src/cpcmx/profile.f90 index 92be717..0eeb3de 100644 --- a/src/cpcmx/profile.f90 +++ b/src/cpcmx/profile.f90 @@ -44,16 +44,16 @@ subroutine read_singlesig(sigma,nam,volume) read(2,*) read(2,*) - read(2,*) + read(2,*) read(2,*) dummy1,dummy2,volume - io_error=0 + io_error=0 sigma(:) = 0.0_8 i=0 - do i=0,50 - read(2,*,iostat=io_error) dummy3, sigma(i) - end do + do i=0,50 + read(2,*,iostat=io_error) dummy3, sigma(i) + end do close(2) - + end subroutine read_singlesig subroutine read_triplesig(sigma3,nam,volume) @@ -77,18 +77,18 @@ subroutine read_triplesig(sigma3,nam,volume) read(2,*) read(2,*) - read(2,*) + read(2,*) read(2,*) dummy1,dummy2,volume - io_error=0 + io_error=0 sigma3 = 0.0_8 i=0 do t=1,3 - do i=0,50 - read(2,*,iostat=io_error) dummy3, sigma3(t,i) - end do + do i=0,50 + read(2,*,iostat=io_error) dummy3, sigma3(t,i) + end do end do close(2) - + end subroutine read_triplesig @@ -109,31 +109,31 @@ subroutine single_sigma(sv,area,sigma,nam) character(len=*), intent(in), optional :: nam - integer :: sigma_min, sigma_max, i, j,tmp + integer :: i, tmp real(sp) :: punit - real(sp), parameter :: sig_width=0.025_8 + real(sp), parameter :: sig_width=0.025_sp integer, parameter :: n_sig=51 real(sp) :: counter(0:n_sig-1) - real(wp) :: profile(0:n_sig-1), chdval(0:n_sig-1), temp + real(wp) :: profile(0:n_sig-1), temp punit=0.001 profile(:)=0.0_8 counter(:)=0.0 - + do i=0,n_sig-1 profile(i) = 0.0_8 counter(i) = -sig_width+punit*i end do do i= 1, size(sv) temp = sv(i) - + tmp = int((temp-counter(0))/punit) - + if (tmp<0) tmp=0 if (tmp>n_sig-2) tmp=n_sig-2 profile(tmp) = profile(tmp)+area(i)*(counter(tmp+1)-temp)/punit @@ -141,20 +141,20 @@ subroutine single_sigma(sv,area,sigma,nam) end do if (present(nam)) then open(unit=2,file=nam//"_sigma.txt",action="write",status="replace") - + do i=0,size(profile)-1 write(2,*) counter(i),";", profile(i)/sum(area) end do close(2) end if - + sigma(:)=profile(:) end subroutine subroutine split_sigma(sv,area,hb_group,ident,elements,sigma3,nam) - + !! This Routine splits the charge densities by the Hydrogen Bonding groups !! and creates a seperate Sigma Profile for each independent group. !! Input: @@ -251,7 +251,7 @@ subroutine split_sigma(sv,area,hb_group,ident,elements,sigma3,nam) end if case default - + nh_count=nh_count+1 profile_group(i)="NH" end select @@ -266,9 +266,9 @@ subroutine split_sigma(sv,area,hb_group,ident,elements,sigma3,nam) ! write(*,*) profile_group(i) end do - ! Allocate the three profile array according to the + ! Allocate the three profile array according to the ! number of segments in each profile - + allocate(sv_oh(oh_count)) allocate(area_oh(oh_count)) allocate(sv_ot(ot_count)) @@ -281,7 +281,7 @@ subroutine split_sigma(sv,area,hb_group,ident,elements,sigma3,nam) nh_count=0 ! Sort the Segments into the accordings profiles - + do i=1,size(sv) select case (profile_group(i)) case ("OH") @@ -313,7 +313,7 @@ subroutine split_sigma(sv,area,hb_group,ident,elements,sigma3,nam) temp_sigma=0 Call single_sigma(sv_ot,area_ot,temp_sigma) sigma3(3,:)=temp_sigma(:) - + ! Scale Profiles with probability to form hydrogen bond do i=0,50 @@ -329,9 +329,9 @@ subroutine split_sigma(sv,area,hb_group,ident,elements,sigma3,nam) if (present(nam)) then open(unit=2,file=nam//"_sigma3.txt",action="write",status="replace") - + do i=0,50 - + write(2,999) ((i*punit)-max_sig), sigma3(1,i) end do diff --git a/src/cpcmx/qc_calc.f90 b/src/cpcmx/qc_calc.f90 index a18ac62..d4ce4e9 100644 --- a/src/cpcmx/qc_calc.f90 +++ b/src/cpcmx/qc_calc.f90 @@ -54,7 +54,6 @@ subroutine xtb(solvent, level, error) !> Necessary for reading gas phase energy. character(len=200) :: line character(len=:), allocatable :: xtb_bin - integer :: lines, i real(wp) :: E_gas charge=0 @@ -387,7 +386,7 @@ subroutine orca(input,error,new_functional,new_basis) character(len=25) :: words, dummy1, dummy2, dummy3, dummy4 real(wp) :: E_gas, E_solv !> I/O error - integer :: io_error, file_size + integer :: file_size !> Needed for determining right radii integer :: atoms, i @@ -669,7 +668,7 @@ subroutine turbomole(epsilon, cosmo_out, error, isodens, solvent) end if open(11, file='control', access='append') write(11,'(A)') '$cosmo' - if (epsilon .ne. 0) then + if (epsilon .ne. 0._wp) then write(11,'(A11, F0.2, A4)')' epsilon=',epsilon, merge(' ion',' ',ion) else write(11,'(A19, A4)')' epsilon=infinity', merge(' ion',' ',ion) @@ -687,7 +686,7 @@ subroutine turbomole(epsilon, cosmo_out, error, isodens, solvent) end if write(11,'(A16,A)') '$cosmo_out file=',cosmo_out write(11,'(A4)') '$end' - if (epsilon .ne. 0) then + if (epsilon .ne. 0._wp) then write(output_unit,'(5x,A,F0.2,A)') 'Starting COSMO Calculation with epsilon=',epsilon, merge(' ion',' ',ion) else write(output_unit,'(5x,A,A)') 'Starting COSMO Calculation with epsilon=infinity', merge(' ion',' ',ion) @@ -712,7 +711,7 @@ subroutine turbomole(epsilon, cosmo_out, error, isodens, solvent) Call execute_command_line("kdg end") Call execute_command_line("kdg cosmo") open(13,file="control", access="append") - write(13,'(a)'), & + write(13,'(a)') & "$cosmo", & " epsilon=infinity", & " routf=1.1", & @@ -845,7 +844,7 @@ subroutine prepTM(functional,basis, error) integer :: charge, multi !> Dummy Variables and Loop Variable - integer :: i, j + integer :: i real(wp) :: d1, d2, d3 character(len=2), parameter :: ecp28(32) = ['rb','sr','y ','zr','nb','mo','tc','ru','rh','pd','ag','cu', & diff --git a/src/cpcmx/sac.f90 b/src/cpcmx/sac.f90 index 25c4f8e..9d8e90d 100644 --- a/src/cpcmx/sac.f90 +++ b/src/cpcmx/sac.f90 @@ -31,8 +31,8 @@ subroutine sac_gas(E_cosmo,id_scr,area,sv,su,pot) ! type(DICT_STRUCT), pointer :: dispa_con, dispb_con !real(wp), dimension(10) :: param ! type(DICT_DATA) :: a_disp,b_disp - real(wp) :: E_gas, dEreal, ediel, edielprime, vdW_gain, thermo, beta, avcorr - integer :: dummy1, ioerror, i + real(wp) :: E_gas, dEreal, ediel, edielprime, vdW_gain, avcorr + integer :: ioerror, i logical :: ex INQUIRE(file="gas.energy", exist=ex) @@ -593,7 +593,7 @@ subroutine sac_2013(profil,profil2,vcosmo1,vcosmo2,sac_disp) real(wp), dimension(:) :: sac_disp real(wp) :: gam(3,0:50),maxsig,punit,profile(3,0:50), gam_saved(3,0:50),gam_sol(3,0:50) - real(wp) :: gamma_solv, gamma_sol,gamma_test, summ, mix_prof(3,0:50), mix_gam(3,0:50) + real(wp) :: gamma_solv, gamma_sol, summ, mix_prof(3,0:50), mix_gam(3,0:50) real(wp) :: VNORM, ANORM, RNORM(2), QNORM(2), vcosmo1, z(2),vcosmo2, A, omega real(wp) :: Theta(2), Phi(2), L(2), coord, gammasg(2), bt, bp !SG Equation real(wp) :: gammadisp(2) @@ -853,7 +853,7 @@ subroutine sac2013_disp(nam,is_bonded,ident,elements,disp_con,sac_disp) disp=dict_get_key(disp_con, trim(data_string)) atom_disp=disp%param sac_disp=sac_disp+atom_disp - if (atom_disp .NE. 0) disp_atoms=disp_atoms+1 + if (atom_disp .NE. 0._wp) disp_atoms=disp_atoms+1 !write(*,*) data_string, atom_disp end do diff --git a/src/cpcmx/smd.f90 b/src/cpcmx/smd.f90 index def5e9d..c298441 100644 --- a/src/cpcmx/smd.f90 +++ b/src/cpcmx/smd.f90 @@ -56,12 +56,9 @@ subroutine calculate_cds_internal(species, symbols, coord, probe, solvent, dG_cd character(len=*), intent(in), dimension(:) :: internal_smd !>Laufen integer :: i, j - !> Read Env - integer :: dummy1,io_error !> Parameter Path and Solvent Name character(len=*) :: solvent character(len=:), allocatable :: path - logical :: ex real(wp),allocatable :: cds(:) real(wp) :: cds_sm @@ -136,8 +133,6 @@ subroutine calculate_cds_normal(species, symbols, coord, probe, solvent, path, d logical, intent(in) :: default !>Laufen integer :: i, j - !> Read Env - integer :: dummy1,io_error !> Parameter Path and Solvent Name character(len=*) :: path, solvent logical :: ex @@ -220,8 +215,6 @@ subroutine calculate_cds_isodens(species,symbols,coord,probe,solvent,path,dG_cds real(wp),allocatable :: dsdr(:, :, :) !>Laufen integer :: i, j - !> Read Env - integer :: dummy1,io_error !> Parameter Path and Solvent Name character(len=*) :: path, solvent logical :: ex diff --git a/src/cpx_c_api.f90 b/src/cpx_c_api.f90 index d4bf584..46a7f4d 100644 --- a/src/cpx_c_api.f90 +++ b/src/cpx_c_api.f90 @@ -102,7 +102,7 @@ subroutine read_param_api(vparam_file_crs,vparam_file_smd,vcalc) & use mctc_env, only: error_type, fatal_error character(kind=c_char), dimension(*), intent(in) :: vparam_file_crs character(kind=c_char), dimension(*), intent(in) :: vparam_file_smd - character(len=:, kind=c_char), allocatable :: method, solvent, param_file_crs, param_file_smd + character(len=:, kind=c_char), allocatable :: param_file_crs, param_file_smd type(c_ptr), intent(inout) :: vcalc type(vcalc_type), pointer :: calc type(calculation_type), allocatable :: dummy_calc