diff --git a/.gitignore b/.gitignore index 9336281c..ad497cc4 100644 --- a/.gitignore +++ b/.gitignore @@ -29,4 +29,5 @@ fort.* *.log *.agr *.pdf -*.eps \ No newline at end of file +*.eps +*.pyc \ No newline at end of file diff --git a/CMakeLists.txt b/CMakeLists.txt index 254b9c57..4c4d6fd5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -72,21 +72,25 @@ set(FORTRAN_SRC_DIR ${SRC_DIR}/fortran) set(LIB_DIR ${FORTRAN_SRC_DIR}/lib) set(LIB_FILES - mod_error_handling.f90 + mod_io_utils.F90 mod_constants.f90 mod_misc.f90 mod_misc_maths.f90 mod_misc_linalg.f90 - mod_edit_geom.f90 - mod_extended_geom.f90 - mod_elements.f90 + mod_dist_calcs.f90 + mod_geom_utils.f90 + mod_geom_extd.f90 + mod_element_utils.f90 mod_evaluator.f90 - mod_atom_adder.f90 + mod_place_methods.f90 + mod_viability.f90 + mod_distribs.f90 + mod_distribs_host.f90 ) set(SPECIAL_LIB_FILES - mod_rw_geom.f90 - mod_evolver.f90 + mod_geom_rw.f90 + mod_distribs_container.f90 mod_generator.f90 # mod_generator_sub.f90 ) diff --git a/app/inputs.f90 b/app/inputs.f90 index b904ef49..8071ad3e 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -1,8 +1,9 @@ module inputs !! Module for reading input files and setting global variables. - use misc_raffle, only: file_check,flagmaker, icount, to_lower - use generator, only: stoichiometry_type - use constants, only: real12, verbose, pi + use raffle__misc, only: file_check,flagmaker, icount, to_lower + use raffle__generator, only: stoichiometry_type + use raffle__constants, only: real32, pi + use raffle__io_utils implicit none @@ -21,10 +22,12 @@ module inputs public :: bond_pairs, pair_radii public :: set_global_vars + public :: verbose logical :: lseed + integer :: verbose integer :: seed !random seed integer :: num_structures ! number of structures to generate integer :: task ! task setting (defines the RAFFLE task) @@ -32,18 +35,18 @@ module inputs integer :: vdW, volvar - real(real12), dimension(3) :: cutoff_min_list, cutoff_max_list - real(real12), dimension(3) :: width_list, sigma_list + real(real32), dimension(3) :: cutoff_min_list, cutoff_max_list + real(real32), dimension(3) :: width_list, sigma_list - real(real12), dimension(:), allocatable :: element_energies - real(real12), dimension(:), allocatable :: pair_radii + real(real32), dimension(:), allocatable :: element_energies + real(real32), dimension(:), allocatable :: pair_radii character(3), dimension(:), allocatable :: element_symbols character(3), dimension(:,:), allocatable :: bond_pairs integer, dimension(3) :: grid = [0, 0, 0] - real(real12) :: grid_spacing = 0._real12 - real(real12), dimension(5) :: method_probab = & - [1._real12, 0.1_real12, 0.5_real12, 0.5_real12, 1._real12] + real(real32) :: grid_spacing = 0._real32 + real(real32), dimension(5) :: method_probab = & + [1._real32, 0.1_real32, 0.5_real32, 0.5_real32, 1._real32] character(1024), dimension(:), allocatable :: database_list ! list of directories containing input database character(1024) :: database_format !format of input file (POSCAR, XYZ, etc. @@ -81,7 +84,7 @@ subroutine set_global_vars() !--------------------------------------------------------------------------- ! Reads flags and assigns to variables !--------------------------------------------------------------------------- - flagloop: do i=0,command_argument_count()-1 + flagloop: do i=0,command_argument_count() empty=.false. if (skip) then skip=.false. @@ -119,6 +122,10 @@ subroutine set_global_vars() !------------------------------------------------------------------------ elseif(index(buffer,'-v').eq.1)then flag="-v" + call print_build_info() + stop 0 + elseif(index(buffer,'--verbose').eq.1)then + flag="--verbose" call flagmaker(buffer,flag,i,skip,empty) if(.not.empty) read(buffer,*) verbose elseif(index(buffer,'-h').eq.1)then @@ -182,9 +189,9 @@ subroutine read_input_file(file_name) character(1024) :: stoichiometry, database, buffer, energies, & bond_radii !! Strings buffers to hold input values (usually derived types). - real(real12), dimension(3) :: width, sigma + real(real32), dimension(3) :: width, sigma !! Width and sigma values for distribution functions. - real(real12) :: void, rand, walk, grow, min + real(real32) :: void, rand, walk, grow, min !! Placement method probabilities. character(50), dimension(3) :: cutoff_min, cutoff_max !! Cutoff values for distribution functions. @@ -213,12 +220,12 @@ subroutine read_input_file(file_name) output_dir = "iteration1" cutoff_min = "-1.0" cutoff_max = "-1.0" - width = -1._real12 - sigma = -1._real12 + width = -1._real32 + sigma = -1._real32 database_format = "vasprun.xml" - void = 0._real12; rand = 0._real12 - walk = 0._real12; grow = 0._real12 - min = 0._real12 + void = 0._real32; rand = 0._real32 + walk = 0._real32; grow = 0._real32 + min = 0._real32 !--------------------------------------------------------------------------- ! read namelists from input file !--------------------------------------------------------------------------- @@ -263,7 +270,7 @@ subroutine read_input_file(file_name) method_probab = [void, rand, walk, grow, min] if(all(abs(method_probab).lt.1.E-6))then method_probab = & - [1._real12, 0.1_real12, 0.5_real12, 0.5_real12, 1._real12] + [1._real32, 0.1_real32, 0.5_real32, 0.5_real32, 1._real32] end if if(trim(stoichiometry).ne."")then @@ -349,13 +356,13 @@ function read_value_from_string(string) result(output) ! Arguments character(*), intent(in) :: string !! Input string. - real(real12) :: output + real(real32) :: output !! Output value. ! Local variables integer :: k, pos !! Loop index, position. - real(real12) :: variable, power + real(real32) :: variable, power !! Variable and power values. character(:), allocatable :: string_ !! Copy of input string. @@ -363,9 +370,9 @@ function read_value_from_string(string) result(output) !! Numeric set. pos = 1 - output = 1._real12 - variable = 0._real12 - power = 1._real12 + output = 1._real32 + variable = 0._real32 + power = 1._real32 string_ = trim(to_lower(string)) loop: do !! read until first non-numeric character @@ -382,20 +389,20 @@ function read_value_from_string(string) result(output) pos = pos + k - 1 !! identify what the next character is (*, /, pi) - !! if *, then change power factor to 1._real12 - !! if /, then change power factor to -1._real12 - !! if pi, then change power factor to 1._real12 and variable = pi + !! if *, then change power factor to 1._real32 + !! if /, then change power factor to -1._real32 + !! if pi, then change power factor to 1._real32 and variable = pi !! if blank space, move pos to next non-space character and cycle !! if end of string, exit loop if (string_(pos:pos).eq."*")then - power = 1._real12 + power = 1._real32 pos = pos + 1 elseif(string_(pos:pos).eq."/")then - power = -1._real12 + power = -1._real32 pos = pos + 1 elseif(string_(pos:pos+1).eq."pi")then - power = 1._real12 + power = 1._real32 output = output * pi ** power pos = pos + 2 end if diff --git a/app/main.f90 b/app/main.f90 index 14e4391e..6253c41d 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -1,12 +1,12 @@ program raffle_program !! Main program for the interface-based random structure search - use constants, only: real12 - use error_handling, only: stop_program - use misc_raffle, only: touch + use raffle__constants, only: real32 + use raffle__io_utils, only: stop_program + use raffle__misc, only: touch use inputs use read_structures, only: get_evolved_gvectors_from_data - use raffle, only: raffle_generator_type, gvector_container_type - use rw_geom, only: geom_read, geom_write + use raffle, only: raffle_generator_type, distribs_container_type + use raffle__geom_rw, only: geom_read, geom_write implicit none ! Local variables @@ -17,7 +17,7 @@ program raffle_program character(:), allocatable :: next_dir !! Next directory name - real(real12), dimension(:), allocatable :: tmp_energies + real(real32), dimension(:), allocatable :: tmp_energies !! Temporary array for element energies character(len=3), dimension(:), allocatable :: tmp_symbols !! Temporary array for element symbols @@ -78,7 +78,7 @@ program raffle_program generator%distributions = get_evolved_gvectors_from_data( & input_dir = database_list, & file_format = database_format, & - gvector_container_template = gvector_container_type(& + distribs_container_template = distribs_container_type(& width = width_list, & sigma = sigma_list, & cutoff_min = cutoff_min_list, & diff --git a/app/mod_read_structures.f90 b/app/mod_read_structures.f90 index 523e4681..c2856756 100644 --- a/app/mod_read_structures.f90 +++ b/app/mod_read_structures.f90 @@ -4,12 +4,12 @@ module read_structures !! This module takes a list of directories and reads in the structures from !! the contained files. The structures are then converted to a set of !! generalised vectors (gvectors, aka distribution functions). - use constants, only: real12 - use misc_raffle, only: grep - use misc_linalg, only: modu - use rw_geom, only: basis_type, geom_read, geom_write, igeom_input + use raffle__constants, only: real32 + use raffle__misc, only: grep + use raffle__misc_linalg, only: modu + use raffle__geom_rw, only: basis_type, geom_read, geom_write, igeom_input use rw_vasprun, only: get_energy_from_vasprun, get_structure_from_vasprun - use evolver, only: gvector_container_type + use raffle__distribs_container, only: distribs_container_type #ifdef ENABLE_ATHENA use machine_learning, only: network_setup, & network_train, network_train_graph, & @@ -28,19 +28,19 @@ module read_structures !############################################################################### function get_evolved_gvectors_from_data(input_dir, & - file_format, gvector_container_template) & - result(gvector_container) + file_format, distribs_container_template) & + result(distribs_container) !! Read structures from the input directories and evolve them to gvectors. implicit none ! Arguments character(*), dimension(..), intent(in) :: input_dir !! List of directories containing the structures to be read. - type(gvector_container_type), intent(in), optional :: & - gvector_container_template - !! Optional. A template gvector_container to be used. - type(gvector_container_type), allocatable :: gvector_container - !! The gvector_container containing the evolved gvectors. + type(distribs_container_type), intent(in), optional :: & + distribs_container_template + !! Optional. A template distribs_container to be used. + type(distribs_container_type), allocatable :: distribs_container + !! The distribs_container containing the evolved gvectors. character(*), intent(in), optional :: file_format !! Optional. The format of the input files. Default is vasprun.xml. @@ -51,7 +51,7 @@ function get_evolved_gvectors_from_data(input_dir, & !! The format of the input files. integer :: num_structures !! The number of structures read. - real(real12) :: energy + real(real32) :: energy !! The energy of the structure. character(50) :: buffer !! A buffer for reading strings. @@ -71,19 +71,19 @@ function get_evolved_gvectors_from_data(input_dir, & #ifdef ENABLE_ATHENA type(graph_type), dimension(:), allocatable :: graphs !! Graph representations of the structures. - real(real12), dimension(:), allocatable :: & + real(real32), dimension(:), allocatable :: & labels, labels_train, labels_validate !! The labels for the structures. - real(real12), dimension(:,:), allocatable :: & + real(real32), dimension(:,:), allocatable :: & dataset, data_train, data_validate !! The dataset for the structures. #endif - if(present(gvector_container_template)) then - gvector_container = gvector_container_template + if(present(distribs_container_template)) then + distribs_container = distribs_container_template else - gvector_container = gvector_container_type() + distribs_container = distribs_container_type() end if if(present(file_format)) then @@ -104,9 +104,9 @@ function get_evolved_gvectors_from_data(input_dir, & ifile_format = 0 end if - ! inquire(file='gvector_container.dat', exist=success) + ! inquire(file='distribs_container.dat', exist=success) ! if(success) then - ! call gvector_container%read('gvector_container.dat') + ! call distribs_container%read('distribs_container.dat') ! goto 100 ! end if ! ! For each new run of the code, it should populate a new directory and ... @@ -179,7 +179,7 @@ function get_evolved_gvectors_from_data(input_dir, & basis%energy, & ( trim(basis%spec(j)%name), basis%spec(j)%num, & j=1, basis%nspec ) - call gvector_container%add(basis) + call distribs_container%add(basis) end do cycle end select @@ -187,7 +187,7 @@ function get_evolved_gvectors_from_data(input_dir, & write(*,*) & "Found structure: ", trim(adjustl(structure_list(i))), & " with energy: ", basis%energy - call gvector_container%add(basis) + call distribs_container%add(basis) num_structures = num_structures + 1 ! ! STORE THE ENERGY IN AN ARRAY @@ -198,7 +198,7 @@ function get_evolved_gvectors_from_data(input_dir, & -100 call gvector_container%evolve() +100 call distribs_container%evolve() #ifdef ENABLE_ATHENA diff --git a/app/mod_rw_vasprun.f90 b/app/mod_rw_vasprun.f90 index 865f46b4..f86132fc 100644 --- a/app/mod_rw_vasprun.f90 +++ b/app/mod_rw_vasprun.f90 @@ -1,6 +1,6 @@ module rw_vasprun - use constants, only: real12 - use rw_geom, only: basis_type + use raffle__constants, only: real32 + use raffle__geom_rw, only: basis_type implicit none private @@ -82,14 +82,14 @@ end subroutine find_section function get_energy_from_vasprun(unit, found, rewind_file) result(energy) implicit none integer, intent(in) :: unit - real(real12) :: energy + real(real32) :: energy character(len=100) :: line, buffer logical, intent(out) :: found logical, intent(in), optional :: rewind_file integer :: ierror logical :: found_ = .false. - real(real12), dimension(:), allocatable :: energy_list + real(real32), dimension(:), allocatable :: energy_list character(len=32), dimension(3) :: section_list @@ -166,11 +166,11 @@ subroutine get_structure_from_vasprun(unit, basis, found) integer :: number character(len=3) :: element - real(real12) :: mass, valency + real(real32) :: mass, valency character(len=40) :: pseudo integer, dimension(:), allocatable :: number_list character(len=3), dimension(:), allocatable :: element_list - real(real12), dimension(:), allocatable :: mass_list, valency_list + real(real32), dimension(:), allocatable :: mass_list, valency_list character(len=40), dimension(:), allocatable :: pseudo_list diff --git a/app/mod_vasp_file_handler.f90 b/app/mod_vasp_file_handler.f90 index 112e375f..39c70b6c 100644 --- a/app/mod_vasp_file_handler.f90 +++ b/app/mod_vasp_file_handler.f90 @@ -1,6 +1,6 @@ module vasp_file_handler - use constants, only: real12 - use misc_raffle, only: touch, icount + use raffle__constants, only: real32 + use raffle__misc, only: touch, icount implicit none private diff --git a/fpm.toml b/fpm.toml index 12ff6249..d68cc106 100644 --- a/fpm.toml +++ b/fpm.toml @@ -1,5 +1,5 @@ name = "raffle" -version = "0.3.1" +version = "0.4.0" author = "Ned Thaddeus Taylor" maintainer = "n.t.taylor@exeter.ac.uk" description = "A Fortran library and executable for structure prediction at material interfaces" diff --git a/kind_map b/kind_map index e159a9d7..328bae77 100644 --- a/kind_map +++ b/kind_map @@ -4,12 +4,12 @@ '8': 'double', 'dp': 'double', 'idp':'double', - 'real12': 'float'}, + 'real32': 'float'}, 'complex' : {'': 'complex_float', '8' : 'complex_double', '16': 'complex_long_double', 'dp': 'complex_double', - 'real12': 'complex_float'}, + 'real32': 'complex_float'}, 'integer' : {'' : 'int', '4': 'int', '8': 'long_long', diff --git a/param.in b/param.in deleted file mode 100644 index 9d0696dd..00000000 --- a/param.in +++ /dev/null @@ -1,24 +0,0 @@ -&setup - task = 2, - filename_host = "POSCAR_host", - database_format = "vasprun.xml", - database = "database", - seed = 1, - vps_ratio = 1 0 0, - bins = 4 4 10 -/ - -&structure - num_structures=10, - stoichiometry="{C:2, Mg:1}", -/ - -&volume - vdW=100, - volvar=10 -/ - -&distribution - cutoff_min = 0.5 0.0 0.0, - sigma = 0.1 0.1 0.1 -/ \ No newline at end of file diff --git a/pyproject.toml b/pyproject.toml index 35e65664..f272880e 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -1,12 +1,12 @@ [project] name = "raffle" -version = "0.2" +dynamic = ["version"] dependencies = [ "f90wrap>=0.2.14,<0.2.15", "numpy>=1.26,<2.0.0", "ase>=3.23.0", ] -requires-python = ">=3.11" +requires-python = ">=3.11, <3.12" authors = [ { name = "Ned Thaddeus Taylor", email = "n.t.taylor@exeter.ac.uk" }, { name = "Joe Pitfield" }, @@ -36,3 +36,6 @@ requires = [ "cmake>=3.17.5", ] build-backend = "setuptools.build_meta" + +[tool.setuptools.dynamic] +version = {attr = "raffle.__version__"} \ No newline at end of file diff --git a/setup.py b/setup.py index ef52ba2f..0385c7e8 100644 --- a/setup.py +++ b/setup.py @@ -5,6 +5,10 @@ from setuptools.command.build_ext import build_ext import shutil +# Add the subdirectory to sys.path +sys.path.append(os.path.join(os.path.dirname(__file__), 'tools')) +from version_number import get_version + class CMakeBuild(build_ext): """ Custom build command that uses CMake to build extensions. @@ -74,19 +78,12 @@ def __init__(self, name, sourcedir=''): Extension.__init__(self, name, sources=[]) self.sourcedir = os.path.abspath(sourcedir) -minimum_requirements = [ - "f90wrap>=0.2.14,<0.2.15", - "numpy>=1.26,<2.0.0", - "ase>=3.23.0", -] - setup( name='raffle', - version='0.3.1', + version=get_version(), author='Ned Thaddeus Taylor', author_email='n.t.taylor@exeter.ac.uk', description='A Python project with a Fortran library', - install_requires=minimum_requirements, python_requires='>=3.11, <3.12', long_description=open('README.md').read(), long_description_content_type='text/markdown', diff --git a/src/fortran/lib/mod_constants.f90 b/src/fortran/lib/mod_constants.f90 index e2c738a2..78ca0a32 100644 --- a/src/fortran/lib/mod_constants.f90 +++ b/src/fortran/lib/mod_constants.f90 @@ -1,14 +1,13 @@ -module constants +module raffle__constants !! Module with global constants !! !! This module contains global constants that may be used throughout the !! library. implicit none - integer, parameter, public :: real12 = Selected_real_kind(6,37)!(15,307) - real(real12), parameter, public :: pi = 4._real12 * atan(1._real12) - real(real12), parameter, public :: c = 0.26246582250210965422_real12 - real(real12), parameter, public :: c_vasp = 0.262465831_real12 - real(real12), parameter, public :: INF = huge(0._real12) - complex(real12), parameter, public :: imag=(0._real12, 1._real12) - integer, public :: verbose = 0 -end module constants + integer, parameter, public :: real32 = Selected_real_kind(6,37)!(15,307) + real(real32), parameter, public :: pi = 4._real32 * atan(1._real32) + real(real32), parameter, public :: c = 0.26246582250210965422_real32 + real(real32), parameter, public :: c_vasp = 0.262465831_real32 + real(real32), parameter, public :: INF = huge(0._real32) + complex(real32), parameter, public :: imag=(0._real32, 1._real32) +end module raffle__constants diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_dist_calcs.f90 similarity index 54% rename from src/fortran/lib/mod_edit_geom.f90 rename to src/fortran/lib/mod_dist_calcs.f90 index 16eae35b..61cc3e26 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_dist_calcs.f90 @@ -1,11 +1,11 @@ -module edit_geom - !! Module to contain all geometry-manipulation related procedures +module raffle__dist_calcs + !! Module containing distance calculators !! - !! This module contains procedures that are used to manipulate the geometry - !! of the system. The geometry type used is defined in the rw_geom module. - use constants, only: pi,real12 - use rw_geom, only: basis_type - use misc_linalg, only: modu, get_angle + !! This module contains procedures to calculate the distance between atoms + !! and other points in the system. + use raffle__constants, only: pi,real32 + use raffle__geom_rw, only: basis_type + use raffle__misc_linalg, only: modu, get_angle implicit none @@ -15,7 +15,6 @@ module edit_geom public :: get_min_dist_between_point_and_atom public :: get_min_dist_between_point_and_species public :: get_dist_between_point_and_atom - public :: basis_merge contains @@ -35,19 +34,19 @@ function get_min_dist(basis,loc,lignore_close,axis,labove,lreal,tol, & !! If true, ignore atoms that are really close to the point. class(basis_type), intent(in) :: basis !! The basis of the cell. - real(real12), dimension(3), intent(in) :: loc + real(real32), dimension(3), intent(in) :: loc !! The location of the point (in crystal coordinates). integer, intent(in), optional :: axis !! The axis along which to calculate the distance (if undefined, the !! distance is calculated in all directions). - real(real12), intent(in), optional :: tol + real(real32), intent(in), optional :: tol !! The tolerance for the distance. logical, intent(in), optional :: labove, lreal !! If true, return the real distance, otherwise return the vector. integer, dimension(:,:), intent(in), optional :: ignore_list !! List of atoms to ignore. - real(real12), dimension(3) :: output + real(real32), dimension(3) :: output !! The minimum distance between the point and the nearest atom. @@ -56,20 +55,20 @@ function get_min_dist(basis,loc,lignore_close,axis,labove,lreal,tol, & !! Loop counters. integer :: axis_ = 0 !! Axis along which to calculate the distance. - real(real12) :: dtmp1 + real(real32) :: dtmp1 !! Temporary variables. - real(real12) :: min_bond + real(real32) :: min_bond !! Minimum bond length. - real(real12) :: tol_ + real(real32) :: tol_ !! Tolerance for the distance. logical :: labove_, lreal_ !! Booleans for above and real distance arguments - real(real12), dimension(3) :: vdtmp1, vdtmp2 + real(real32), dimension(3) :: vdtmp1, vdtmp2 !! Vectors for distance calculations. ! CORRECT tol TO ACCOUNT FOR LATTICE SIZE - tol_ = 1.E-5_real12 + tol_ = 1.E-5_real32 labove_ = .false. lreal_ = .true. if(present(tol)) tol_ = tol @@ -80,8 +79,8 @@ function get_min_dist(basis,loc,lignore_close,axis,labove,lreal,tol, & if(present(axis)) axis_=axis - min_bond=huge(0._real12) - output = 0._real12 + min_bond=huge(0._real32) + output = 0._real32 do js = 1, basis%nspec atmloop: do ja=1,basis%spec(js)%num if(present(ignore_list))then @@ -94,12 +93,12 @@ function get_min_dist(basis,loc,lignore_close,axis,labove,lreal,tol, & if(axis_.gt.0)then if(abs(vdtmp1(axis_)).lt.tol_) cycle atmloop if(labove_)then - vdtmp1(axis_) = 1._real12 + vdtmp1(axis_) + vdtmp1(axis_) = 1._real32 + vdtmp1(axis_) else - vdtmp1(axis_) = vdtmp1(axis_) - 1._real12 + vdtmp1(axis_) = vdtmp1(axis_) - 1._real32 end if else - vdtmp1 = vdtmp1 - ceiling(vdtmp1 - 0.5_real12) + vdtmp1 = vdtmp1 - ceiling(vdtmp1 - 0.5_real32) end if vdtmp2 = matmul(vdtmp1,basis%lat) dtmp1 = modu(vdtmp2) @@ -132,17 +131,17 @@ pure function get_min_dist_between_point_and_atom(basis,loc,atom) & !! The basis of the cell. integer, dimension(2), intent(in) :: atom !! The index of the atom in the cell (species, atom). - real(real12), dimension(3), intent(in) :: loc + real(real32), dimension(3), intent(in) :: loc !! The location of the point (in crystal coordinates). - real(real12) :: dist + real(real32) :: dist !! The minimum distance between the point and the atom. ! Local variables - real(real12), dimension(3) :: vec + real(real32), dimension(3) :: vec !! Vector between the point and the atom. vec = loc - basis%spec(atom(1))%atom(atom(2),:3) - vec = vec - ceiling(vec - 0.5_real12) + vec = vec - ceiling(vec - 0.5_real32) vec = matmul(vec,basis%lat) dist = modu(vec) @@ -164,23 +163,23 @@ pure function get_min_dist_between_point_and_species( & !! The basis of the cell. integer, intent(in) :: species !! The index of the species in the cell. - real(real12), dimension(3), intent(in) :: loc + real(real32), dimension(3), intent(in) :: loc !! The location of the point (in crystal coordinates). integer, dimension(:,:), intent(in), optional :: ignore_list !! List of atoms to ignore. - real(real12) :: dist + real(real32) :: dist !! The minimum distance between the point and the species. ! Local variables integer :: ia, i !! Loop indices. - real(real12) :: rtmp1 + real(real32) :: rtmp1 !! Temporary variable. - real(real12), dimension(3) :: vec + real(real32), dimension(3) :: vec !! Vector between the point and the atom. - dist = huge(0._real12) + dist = huge(0._real32) atom_loop: do ia = 1,basis%spec(species)%num if(present(ignore_list))then do i = 1, size(ignore_list,1), 1 @@ -188,7 +187,7 @@ pure function get_min_dist_between_point_and_species( & end do end if vec = loc - basis%spec(species)%atom(ia,:3) - vec = vec - ceiling(vec - 0.5_real12) + vec = vec - ceiling(vec - 0.5_real32) vec = matmul(vec, basis%lat) rtmp1 = modu(vec) if( rtmp1 .lt. dist ) dist = rtmp1 @@ -210,13 +209,13 @@ pure function get_dist_between_point_and_atom(basis,loc,atom) result(dist) !! The basis of the cell. integer, dimension(2), intent(in) :: atom !! The index of the atom in the cell (species, atom). - real(real12), dimension(3), intent(in) :: loc + real(real32), dimension(3), intent(in) :: loc !! The location of the point (in crystal coordinates). - real(real12) :: dist + real(real32) :: dist !! The minimum distance between the point and the atom. ! Local variables - real(real12), dimension(3) :: vec + real(real32), dimension(3) :: vec !! Vector between the point and the atom. vec = loc - basis%spec(atom(1))%atom(atom(2),:3) @@ -226,118 +225,4 @@ pure function get_dist_between_point_and_atom(basis,loc,atom) result(dist) end function get_dist_between_point_and_atom !############################################################################### - -!############################################################################### - function basis_merge(basis1,basis2,length,map1,map2) result(output) - !! Merge two supplied bases - !! - !! Merge two bases assuming that the lattice is the same - implicit none - - ! Arguments - type(basis_type) :: output - !! Output merged basis. - class(basis_type), intent(in) :: basis1, basis2 - !! Input bases to merge. - integer, intent(in), optional :: length - !! Number of dimensions for atomic positions (default 3). - integer, allocatable, dimension(:,:,:), optional, intent(inout) :: map1,map2 - !! Maps for atoms in the two bases. - - ! Local variables - integer :: i, j, k, itmp, dim - !! Loop counters. - logical :: lmap - !! Boolean for map presence. - integer, allocatable, dimension(:) :: match - !! Array to match species. - integer, allocatable, dimension(:,:,:) :: new_map - !! New map for merged basis. - - - - !--------------------------------------------------------------------------- - ! set up number of species - !--------------------------------------------------------------------------- - dim=3 - if(present(length)) dim=length - - allocate(match(basis2%nspec)) - match=0 - output%nspec=basis1%nspec - do i=1,basis2%nspec - if(.not.any(basis2%spec(i)%name.eq.basis1%spec(:)%name))then - output%nspec=output%nspec+1 - end if - end do - allocate(output%spec(output%nspec)) - output%spec(:basis1%nspec)%num=basis1%spec(:)%num - output%spec(:basis1%nspec)%name=basis1%spec(:)%name - - - write(output%sysname,'(A,"+",A)') & - trim(basis1%sysname),trim(basis2%sysname) - k=basis1%nspec - spec1check: do i=1,basis2%nspec - do j=1,basis1%nspec - if(basis2%spec(i)%name.eq.basis1%spec(j)%name)then - output%spec(j)%num=output%spec(j)%num+basis2%spec(i)%num - match(i)=j - cycle spec1check - end if - end do - k=k+1 - match(i)=k - output%spec(k)%num=basis2%spec(i)%num - output%spec(k)%name=basis2%spec(i)%name - end do spec1check - - - !--------------------------------------------------------------------------- - ! if map is present, sets up new map - !--------------------------------------------------------------------------- - lmap = .false. - if_map: if(present(map1).and.present(map2))then - if(all(map1.eq.-1)) exit if_map - lmap = .true. - allocate(new_map(& - output%nspec,& - maxval(output%spec(:)%num,dim=1),2)) - new_map = 0 - end if if_map - - - !--------------------------------------------------------------------------- - ! set up atoms in merged basis - !--------------------------------------------------------------------------- - do i=1,basis1%nspec - allocate(output%spec(i)%atom(output%spec(i)%num,dim)) - output%spec(i)%atom(:,:)=0._real12 - output%spec(i)%atom(1:basis1%spec(i)%num,:3)=basis1%spec(i)%atom(:,:3) - if(lmap) new_map(i,:basis1%spec(i)%num,:)=map1(i,:basis1%spec(i)%num,:) - end do - do i=1,basis2%nspec - if(match(i).gt.basis1%nspec)then - allocate(output%spec(match(i))%atom(output%spec(match(i))%num,dim)) - output%spec(match(i))%atom(:,:)=0._real12 - output%spec(match(i))%atom(:,:3)=basis2%spec(i)%atom(:,:3) - if(lmap) new_map(match(i),:basis2%spec(i)%num,:) = & - map2(i,:basis2%spec(i)%num,:) - else - itmp=basis1%spec(match(i))%num - output%spec(match(i))%atom(itmp+1:basis2%spec(i)%num+itmp,:3) = & - basis2%spec(i)%atom(:,:3) - if(lmap) new_map(match(i),itmp+1:basis2%spec(i)%num+itmp,:) = & - map2(i,:basis2%spec(i)%num,:) - end if - end do - output%natom=sum(output%spec(:)%num) - - - if(lmap) call move_alloc(new_map,map1) - - return - end function basis_merge -!############################################################################### - -end module edit_geom +end module raffle__dist_calcs diff --git a/src/fortran/lib/mod_distribs.f90 b/src/fortran/lib/mod_distribs.f90 new file mode 100644 index 00000000..bd6c083c --- /dev/null +++ b/src/fortran/lib/mod_distribs.f90 @@ -0,0 +1,636 @@ +module raffle__distribs + !! Module for handling distribution functions. + !! + !! This module contains the types and subroutines for generating distribution + !! fucntions for individual materials. + !! The distribution functions are used as fingerprints for atomic structures + !! to identify similarities and differences between structures. + use raffle__constants, only: real32, pi + use raffle__io_utils, only: stop_program + use raffle__misc, only: strip_null, sort_str + use raffle__misc_maths, only: triangular_number + use raffle__misc_linalg, only: get_angle, get_improper_dihedral_angle, modu + use raffle__geom_rw, only: basis_type, get_element_properties + use raffle__geom_extd, only: extended_basis_type + use raffle__element_utils, only: & + element_type, element_bond_type, & + element_database, element_bond_database + implicit none + + + private + + public :: distribs_base_type, distribs_type, get_distrib + + + type :: distribs_base_type + !! Base type for distribution functions. + real(real32), dimension(:,:), allocatable :: df_2body + !! 2-body distribution function. + real(real32), dimension(:,:), allocatable :: df_3body + !! 3-body distribution function. + real(real32), dimension(:,:), allocatable :: df_4body + !! 4-body distribution function. + end type distribs_base_type + + type, extends(distribs_base_type) :: distribs_type + !! Type for distribution functions. + !! + !! This type contains the distribution functions for a single atomic + !! structure. It also contains other structure properties, including: + !! - energy + !! - stoichiometry + !! - elements + !! - number of atoms + integer :: num_atoms = 0 + !! Number of atoms in the structure. + real(real32) :: energy = 0.0_real32 + !! Energy of the structure. + real(real32) :: energy_above_hull = 0.0_real32 + !! Energy above the hull of the structure. + logical :: from_host = .false. + !! Boolean whether the structure is derived from the host. + integer, dimension(:), allocatable :: stoichiometry + !! Stoichiometry of the structure. + character(len=3), dimension(:), allocatable :: element_symbols + !! Elements contained within the structure. + integer, dimension(:), allocatable :: num_pairs, num_per_species + !! Number of pairs and number of pairs per species. + real(real32), dimension(:), allocatable :: weight_pair, weight_per_species + !! Weights for the 2-body and species distribution functions. + contains + procedure, pass(this) :: calculate + end type distribs_type + + + contains + +!############################################################################### + subroutine set_bond_radius_to_default(elements) + !! Set the bond radius to the default value. + !! + !! The default value is the average of the covalent radii of the elements. + implicit none + + ! Arguments + character(len=3), dimension(2), intent(in) :: elements + !! Element symbols. + + ! Local variables + integer :: idx1, idx2 + !! Index of the elements in the element database. + real(real32) :: radius, radius1, radius2 + !! Average of covalent radii. + + + write(0,*) 'WARNING: No bond data for element pair ', & + elements(1), ' and ', & + elements(2) + write(0,*) 'WARNING: Setting bond to average of covalent radii' + if(.not.allocated(element_database)) allocate(element_database(0)) + idx1 = findloc([ element_database(:)%name ], & + elements(1), dim=1) + if(idx1.lt.1)then + call get_element_properties(elements(1), radius=radius1) + element_database = [ element_database, & + element_type(name=elements(1), radius=radius1) ] + idx1 = size(element_database) + end if + idx2 = findloc([ element_database(:)%name ], & + elements(2), dim=1) + if(idx2.lt.1)then + call get_element_properties(elements(2), radius=radius2) + element_database = [ element_database, & + element_type(name=elements(2), radius=radius2) ] + idx2 = size(element_database) + end if + radius = ( element_database(idx1)%radius + & + element_database(idx2)%radius ) / 2._real32 + if(.not.allocated(element_bond_database)) & + allocate(element_bond_database(0)) + element_bond_database = [ element_bond_database, & + element_bond_type(elements=[ & + elements(1), & + elements(2) & + ], radius=radius) & + ] + call sort_str( & + element_bond_database(size(element_bond_database))%element & + ) + + end subroutine set_bond_radius_to_default +!############################################################################### + + +!############################################################################### + subroutine calculate(this, basis, & + nbins, width, sigma, cutoff_min, cutoff_max, radius_distance_tol) + !! Calculate the distribution functions for the container. + !! + !! This procedure calculates the 2-, 3-, and 4-body distribution function + !! for a given atomic structure (i.e. basis). + implicit none + + ! Arguments + class(distribs_type), intent(inout) :: this + !! Parent of the procedure. Instance of distribution functions container. + type(basis_type), intent(in) :: basis + !! Atomic structure. + integer, dimension(3), intent(in), optional :: nbins + !! Optional. Number of bins for the distribution functions. + real(real32), dimension(3), intent(in), optional :: width, sigma + !! Optional. Width and sigma for the distribution functions. + real(real32), dimension(3), intent(in), optional :: cutoff_min, cutoff_max + !! Optional. Cutoff minimum and maximum for the distribution functions. + real(real32), dimension(4), intent(in), optional :: radius_distance_tol + !! Tolerance for the distance between atoms for 3- and 4-body. + + ! Local variables + integer, dimension(3) :: nbins_ + !! Number of bins for the distribution functions. + real(real32), dimension(3) :: sigma_ + !! Sigma for the distribution functions. + real(real32), dimension(3) :: width_ + !! Width of the bins for the distribution functions. + real(real32), dimension(3) :: cutoff_min_ + !! Cutoff minimum for the distribution functions. + real(real32), dimension(3) :: cutoff_max_ + !! Cutoff maximum for the distribution functions. + type(element_bond_type), dimension(:), allocatable :: bond_info + !! Bond information for radii. + real(real32), dimension(4) :: radius_distance_tol_ + !! Tolerance for the distance between atoms for 3- and 4-body. + + + integer :: i, b, itmp1, idx + !! Loop index. + integer :: is, js, ia, ja, ka, la + !! Loop index. + integer :: num_pairs + !! Number of pairs and angles. + real(real32) :: bondlength + !! Temporary real variables. + logical :: success + !! Boolean for success. + type(extended_basis_type) :: basis_extd + !! Extended basis of the system. + type(extended_basis_type) :: neighbour_basis + !! Basis for storing neighbour data. + real(real32), dimension(3) :: eta + !! Parameters for the distribution functions. + real(real32), allocatable, dimension(:) :: angle_list, bondlength_list, & + distance + !! Temporary real arrays. + integer, allocatable, dimension(:,:) :: pair_index + !! Index of element pairs. + + + !--------------------------------------------------------------------------- + ! initialise optional variables + !--------------------------------------------------------------------------- + if(present(cutoff_min))then + cutoff_min_ = cutoff_min + else + cutoff_min_ = [0.5_real32, 0._real32, 0._real32] + end if + if(present(cutoff_max))then + cutoff_max_ = cutoff_max + else + cutoff_max_ = [6._real32, pi, pi] + end if + if(present(width))then + width_ = width + else + width_ = [0.25_real32, pi/64._real32, pi/64._real32] + end if + if(present(sigma))then + sigma_ = sigma + else + sigma_ = [0.1_real32, 0.1_real32, 0.1_real32] + end if + if(present(nbins))then + nbins_ = nbins + width_ = ( cutoff_max_ - cutoff_min_ )/real( nbins_ - 1, real32 ) + else + nbins_ = 1 + nint( (cutoff_max_ - cutoff_min_)/width_ ) + end if + if(present(radius_distance_tol))then + radius_distance_tol_ = radius_distance_tol + else + radius_distance_tol_ = [1.5_real32, 2.5_real32, 3._real32, 6._real32] + end if + + + + !--------------------------------------------------------------------------- + ! get the number of pairs of species + ! (this uses a combination calculator with repetition) + !--------------------------------------------------------------------------- + num_pairs = nint(gamma(real(basis%nspec + 2, real32)) / & + ( gamma(real(basis%nspec, real32)) * gamma( 3._real32 ) )) + allocate(this%element_symbols(basis%nspec)) + do is = 1, basis%nspec + this%element_symbols(is) = strip_null(basis%spec(is)%name) + end do + i = 0 + allocate(bond_info(num_pairs)) + allocate(pair_index(basis%nspec,basis%nspec)) + do is = 1, basis%nspec + do js = is, basis%nspec, 1 + i = i + 1 + pair_index(js,is) = i + pair_index(is,js) = i + call bond_info(i)%set( this%element_symbols(is), & + this%element_symbols(js), success & + ) + if(success) cycle + call set_bond_radius_to_default( [ & + this%element_symbols(is), & + this%element_symbols(js) ] & + ) + call bond_info(i)%set( this%element_symbols(is), & + this%element_symbols(js), success & + ) + end do + end do + + + !--------------------------------------------------------------------------- + ! get the stoichiometry, energy, and number of atoms + !--------------------------------------------------------------------------- + this%stoichiometry = basis%spec(:)%num + this%energy = basis%energy + this%num_atoms = basis%natom + + + !--------------------------------------------------------------------------- + ! calculate the gaussian width and allocate the distribution functions + !--------------------------------------------------------------------------- + eta = 1._real32 / ( 2._real32 * sigma_**2._real32 ) + allocate(this%num_pairs(num_pairs), source = 0) + allocate(this%num_per_species(basis%nspec), source = 0) + allocate(this%weight_pair(num_pairs), source = 0._real32) + allocate(this%weight_per_species(basis%nspec), source = 0._real32) + allocate(this%df_2body(nbins_(1), num_pairs), source = 0._real32) + allocate(this%df_3body(nbins_(2), basis%nspec), source = 0._real32) + allocate(this%df_4body(nbins_(3), basis%nspec), source = 0._real32) + + + !--------------------------------------------------------------------------- + ! create the extended basis and neighbour basis + !--------------------------------------------------------------------------- + call basis_extd%copy(basis) + call basis_extd%create_images( max_bondlength = cutoff_max_(1) ) + allocate(bondlength_list(basis_extd%natom+basis_extd%num_images)) + + allocate(neighbour_basis%spec(1)) + allocate(neighbour_basis%image_spec(1)) + allocate(neighbour_basis%spec(1)%atom( & + sum(basis_extd%spec(:)%num)+sum(basis_extd%image_spec(:)%num), 3 & + ) ) + allocate(neighbour_basis%image_spec(1)%atom( & + sum(basis_extd%spec(:)%num)+sum(basis_extd%image_spec(:)%num), 3 & + ) ) + neighbour_basis%nspec = basis%nspec + neighbour_basis%natom = 0 + neighbour_basis%num_images = 0 + neighbour_basis%lat = basis%lat + + + !--------------------------------------------------------------------------- + ! calculate the distribution functions + !--------------------------------------------------------------------------- + do is = 1, basis%nspec + do ia = 1, basis%spec(is)%num + allocate(distance(basis_extd%natom+basis_extd%num_images)) + neighbour_basis%spec(1)%num = 0 + neighbour_basis%image_spec(1)%num = 0 + do js = 1, basis%nspec + itmp1 = 0 + + !------------------------------------------------------------------ + ! loop over all atoms inside the unit cell + !------------------------------------------------------------------ + atom_loop: do ja = 1, basis_extd%spec(js)%num + + associate( vector => matmul( [ & + basis_extd%spec(js)%atom(ja,1:3) - & + basis_extd%spec(is)%atom(ia,1:3) & + ], basis_extd%lat ) & + ) + bondlength = modu( vector ) + + if( bondlength .lt. cutoff_min_(1) .or. & + bondlength .gt. cutoff_max_(1) ) cycle atom_loop + + ! add 2-body bond to store if within tolerances for 3-body + ! distance + if( & + bondlength .ge. & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(1) .and. & + bondlength .le. & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(2) & + ) then + neighbour_basis%spec(1)%num = & + neighbour_basis%spec(1)%num + 1 + neighbour_basis%spec(1)%atom( & + neighbour_basis%spec(1)%num,1:3) = vector + end if + + ! add 2-body bond to store if within tolerances for 4-body + ! distance + if( bondlength .ge. ( & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(3) ) .and. & + bondlength .le. ( & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(4) ) & + ) then + neighbour_basis%image_spec(1)%num = & + neighbour_basis%image_spec(1)%num + 1 + neighbour_basis%image_spec(1)%atom( & + neighbour_basis%image_spec(1)%num,1:3) = vector + end if + + !if(js.lt.js.or.(is.eq.js.and.ja.le.ia)) cycle + itmp1 = itmp1 + 1 + bondlength_list(itmp1) = bondlength + distance(itmp1) = 1._real32 + + end associate + end do atom_loop + + + !------------------------------------------------------------------ + ! loop over all image atoms outside of the unit cell + !------------------------------------------------------------------ + image_loop: do ja = 1, basis_extd%image_spec(js)%num + associate( vector => matmul( [ & + basis_extd%image_spec(js)%atom(ja,1:3) - & + basis_extd%spec(is)%atom(ia,1:3) & + ], basis_extd%lat ) & + ) + + bondlength = modu( vector ) + + if( bondlength .lt. cutoff_min_(1) .or. & + bondlength .gt. cutoff_max_(1) ) cycle image_loop + + ! add 2-body bond to store if within tolerances for 3-body + ! distance + if( & + bondlength .ge. & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(1) .and. & + bondlength .le. & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(2) & + ) then + neighbour_basis%spec(1)%num = & + neighbour_basis%spec(1)%num + 1 + neighbour_basis%spec(1)%atom( & + neighbour_basis%spec(1)%num,1:3 & + ) = vector + end if + + ! add 2-body bond to store if within tolerances for 4-body + ! distance + if( bondlength .ge. ( & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(3) ) .and. & + bondlength .le. ( & + bond_info(pair_index(is, js))%radius_covalent * & + radius_distance_tol_(4) ) & + ) then + neighbour_basis%image_spec(1)%num = & + neighbour_basis%image_spec(1)%num + 1 + neighbour_basis%image_spec(1)%atom( & + neighbour_basis%image_spec(1)%num,1:3 & + ) = vector + end if + + itmp1 = itmp1 + 1 + bondlength_list(itmp1) = bondlength + distance(itmp1) = 1._real32 + + end associate + end do image_loop + + !------------------------------------------------------------------ + ! calculate the 2-body distribution function contributions from + ! atom (is,ia) for species pair (is,js) + !------------------------------------------------------------------ + if(itmp1.gt.0)then + this%df_2body(:,pair_index(is, js)) = & + this%df_2body(:,pair_index(is, js)) + & + get_distrib( & + bondlength_list(:itmp1), & + nbins_(1), eta(1), width_(1), & + cutoff_min_(1), & + scale_list = distance(:itmp1) & + ) + this%weight_pair(pair_index(is, js)) = & + this%weight_pair(pair_index(is, js)) + & + 4._real32 * sum( & + ( & + bond_info(pair_index(is, js))%radius_covalent / & + bondlength_list(:itmp1) ) ** 2 & + ) + this%num_pairs(pair_index(is, js)) = & + this%num_pairs(pair_index(is, js)) + itmp1 + this%weight_per_species(is) = & + this%weight_per_species(is) + & + 4._real32 * sum( & + ( & + bond_info(pair_index(is, js))%radius_covalent / & + bondlength_list(:itmp1) ) ** 2 & + ) + this%num_per_species(is) = this%num_per_species(is) + itmp1 + end if + + end do + deallocate(distance) + + + !--------------------------------------------------------------------- + ! calculate the 3-body distribution function for atom (is,ia) + !--------------------------------------------------------------------- + if(neighbour_basis%spec(1)%num.le.1) cycle + associate( & + num_angles => & + triangular_number( neighbour_basis%spec(1)%num - 1 ) & + ) + allocate( angle_list(num_angles), distance(num_angles) ) + end associate + do concurrent ( ja = 1:neighbour_basis%spec(1)%num:1 ) + do concurrent ( ka = ja + 1:neighbour_basis%spec(1)%num:1 ) + idx = nint( & + (ja - 1) * (neighbour_basis%spec(1)%num - ja / 2.0) + & + (ka - ja) & + ) + angle_list(idx) = get_angle( & + [ neighbour_basis%spec(1)%atom(ja,:3) ], & + [ neighbour_basis%spec(1)%atom(ka,:3) ] & + ) + distance(idx) = & + ( & + modu(neighbour_basis%spec(1)%atom(ja,:3)) ** 2 * & + modu(neighbour_basis%spec(1)%atom(ka,:3)) ** 2 & + ) + end do + end do + this%df_3body(:,is) = this%df_3body(:,is) + & + get_distrib( angle_list, & + nbins_(2), eta(2), width_(2), & + cutoff_min_(2), & + scale_list = distance & + ) + deallocate( angle_list, distance ) + + + !--------------------------------------------------------------------- + ! calculate the 4-body distribution function for atom (is,ia) + !--------------------------------------------------------------------- + if(neighbour_basis%image_spec(1)%num.eq.0) cycle + associate( & + num_angles => & + triangular_number( neighbour_basis%spec(1)%num - 1 ) * & + neighbour_basis%image_spec(1)%num & + ) + allocate( angle_list(num_angles), distance(num_angles) ) + end associate + idx = 0 + do concurrent ( & + ja = 1:neighbour_basis%spec(1)%num:1, & + la = 1:neighbour_basis%image_spec(1)%num:1 & + ) + do concurrent ( ka = ja + 1:neighbour_basis%spec(1)%num:1 ) + idx = nint( & + (ja - 1) * (neighbour_basis%spec(1)%num - ja / 2.0) + & + (ka - ja - 1) & + ) * neighbour_basis%image_spec(1)%num + la + angle_list(idx) = & + get_improper_dihedral_angle( & + [ neighbour_basis%spec(1)%atom(ja,:3) ], & + [ neighbour_basis%spec(1)%atom(ka,:3) ], & + [ neighbour_basis%image_spec(1)%atom(la,:3) ] & + ) + distance(idx) = & + modu(neighbour_basis%spec(1)%atom(ja,:3)) ** 2 * & + modu(neighbour_basis%spec(1)%atom(ka,:3)) ** 2 * & + modu(neighbour_basis%image_spec(1)%atom(la,:3)) ** 2 + end do + end do + this%df_4body(:,is) = this%df_4body(:,is) + & + get_distrib( angle_list, & + nbins_(3), eta(3), width_(3), & + cutoff_min_(3), & + scale_list = distance & + ) + deallocate( angle_list, distance ) + + end do + end do + + !--------------------------------------------------------------------------- + ! apply the cutoff function to the 2-body distribution function + !--------------------------------------------------------------------------- + do b = 1, nbins_(1) + this%df_2body(b,:) = this%df_2body(b,:) / ( cutoff_min_(1) + & + width_(1) * real(b-1, real32) ) ** 2 + end do + + + !--------------------------------------------------------------------------- + ! renormalise the distribution functions so that area under the curve is 1 + !--------------------------------------------------------------------------- + do i = 1, num_pairs + if(any(abs(this%df_2body(:,i)).gt.1.E-6))then + this%df_2body(:,i) = this%df_2body(:,i) / sum(this%df_2body(:,i)) + end if + end do + do is = 1, basis%nspec + if(any(abs(this%df_3body(:,is)).gt.1.E-6))then + this%df_3body(:,is) = this%df_3body(:,is) / sum(this%df_3body(:,is)) + end if + if(any(abs(this%df_4body(:,is)).gt.1.E-6))then + this%df_4body(:,is) = this%df_4body(:,is) / sum(this%df_4body(:,is)) + end if + end do + + end subroutine calculate +!############################################################################### + + +!############################################################################### + function get_distrib(value_list, nbins, eta, width, cutoff_min, & + scale_list ) result(output) + !! Calculate the angular distribution function for a list of values. + implicit none + + ! Arguments + integer, intent(in) :: nbins + !! Number of bins for the distribution functions. + real(real32), intent(in) :: eta, width, cutoff_min + !! Parameters for the distribution functions. + real(real32), dimension(:), intent(in) :: value_list + !! List of angles. + real(real32), dimension(:), intent(in) :: scale_list + !! List of scaling for each angle (distance**3 or distance**4) + real(real32), dimension(nbins) :: output + !! Distribution function for the list of values. + + ! Local variables + integer :: i, j, b, bin + !! Loop index. + integer :: max_num_steps + !! Maximum number of steps. + integer, dimension(3,2) :: loop_limits + !! Loop limits for the 3-body distribution function. + + + max_num_steps = ceiling( sqrt(16._real32/eta) / width ) + output = 0._real32 + + !--------------------------------------------------------------------------- + ! calculate the distribution function for a list of values + !--------------------------------------------------------------------------- + do i = 1, size(value_list), 1 + + !------------------------------------------------------------------------ + ! get the bin closest to the value + !------------------------------------------------------------------------ + bin = nint( ( value_list(i) - cutoff_min ) / width ) + 1 + + + !------------------------------------------------------------------------ + ! calculate the gaussian for this bond + !------------------------------------------------------------------------ + loop_limits(:,1) = & + [ min(nbins, bin), min(nbins, bin + max_num_steps), 1 ] + loop_limits(:,2) = & + [ max(1, bin - 1), max(1, bin - max_num_steps), -1 ] + + + !------------------------------------------------------------------------ + ! do forward and backward loops to add gaussian from its centre + !------------------------------------------------------------------------ + do concurrent ( j = 1:2 ) + do concurrent ( & + b = loop_limits(1,j):loop_limits(2,j):loop_limits(3,j) ) + output(b) = output(b) + & + exp( -eta * ( value_list(i) - & + ( width * real(b-1, real32) + & + cutoff_min ) ) ** 2._real32 & + ) / scale_list(i) + end do + end do + end do + output = output * sqrt( eta / pi ) / real(size(value_list,1),real32) + + end function get_distrib +!############################################################################### + +end module raffle__distribs \ No newline at end of file diff --git a/src/fortran/lib/mod_evolver.f90 b/src/fortran/lib/mod_distribs_container.f90 similarity index 62% rename from src/fortran/lib/mod_evolver.f90 rename to src/fortran/lib/mod_distribs_container.f90 index 09a3554b..db9d690a 100644 --- a/src/fortran/lib/mod_evolver.f90 +++ b/src/fortran/lib/mod_distribs_container.f90 @@ -1,93 +1,33 @@ -module evolver - !! Module for handling distribution functions. +module raffle__distribs_container + !! Module for handling the distribution function container. !! - !! This module contains the types and subroutines for handling distribution - !! distributions. The distribution functions are used as fingerprints for - !! atomic structures to identify similarities and differences between - !! structures. - use constants, only: real12, pi - use error_handling, only: stop_program - use misc_raffle, only: set, icount, strip_null, sort_str - use misc_maths, only: triangular_number, set_difference - use misc_linalg, only: get_angle, get_vol, get_improper_dihedral_angle, & - cross, modu - use rw_geom, only: basis_type, get_element_properties - use extended_geom, only: extended_basis_type - use elements, only: & + !! This module defines the distribution function container and associated + !! procedures. + !! The container holds the distribution functions for a set of atomic + !! structures, alongside parameters for initialising the distributions. + !! The container also holds the generalised distribution functions, built + !! from the distribution functions of the individual systems. + !! The generalised distribution functions are used to evaluate the viability + !! of a new structure. + use raffle__constants, only: real32, pi + use raffle__io_utils, only: stop_program + use raffle__misc, only: set, icount, strip_null, sort_str + use raffle__misc_maths, only: triangular_number, set_difference + use raffle__geom_rw, only: basis_type, get_element_properties + use raffle__element_utils, only: & element_type, element_bond_type, & element_database, element_bond_database + use raffle__distribs, only: distribs_base_type, distribs_type, get_distrib + use raffle__distribs_host, only: distribs_host_type implicit none private - public :: gvector_container_type, gvector_base_type, gvector_type - - - type :: gvector_base_type - !! Base type for distribution functions. - real(real12), dimension(:,:), allocatable :: df_2body - !! 2-body distribution function. - real(real12), dimension(:,:), allocatable :: df_3body - !! 3-body distribution function. - real(real12), dimension(:,:), allocatable :: df_4body - !! 4-body distribution function. - end type gvector_base_type - - type, extends(gvector_base_type) :: gvector_type - !! Type for distribution functions. - !! - !! This type contains the distribution functions for a single atomic - !! structure. It also contains other structure properties, including: - !! - energy - !! - stoichiometry - !! - elements - !! - number of atoms - integer :: num_atoms = 0 - !! Number of atoms in the structure. - real(real12) :: energy = 0.0_real12 - !! Energy of the structure. - real(real12) :: energy_above_hull = 0.0_real12 - !! Energy above the hull of the structure. - logical :: from_host = .false. - !! Boolean whether the structure is derived from the host. - integer, dimension(:), allocatable :: stoichiometry - !! Stoichiometry of the structure. - character(len=3), dimension(:), allocatable :: element_symbols - !! Elements contained within the structure. - integer, dimension(:), allocatable :: num_pairs, num_per_species - !! Number of pairs and number of pairs per species. - real(real12), dimension(:), allocatable :: weight_pair, weight_per_species - !! Weights for the 2-body and species distribution functions. - contains - procedure, pass(this) :: calculate - end type gvector_type + public :: distribs_container_type - type, extends(gvector_type) :: gvector_host_type - !! Type for host information. - !! - !! This type contains the information regarding the host structure that - !! will be used in the grandparent generator type. - logical :: defined = .false. - !! Boolean whether the host structure has been set. - real(real12) :: interface_energy = 0.0_real12 - !! Energy associated with the formation of the interface in the host. - type(basis_type) :: basis - !! Host structure. - integer, dimension(:,:), allocatable :: pair_index - !! Index for the 2-body distribution function. - integer, dimension(:), allocatable :: element_map - !! Mapping of host elements to distribution function elements. - contains - procedure, pass(this) :: calculate_interface_energy - !! Calculate the interface formation energy of the host. - procedure, pass(this) :: set => set_host - !! Set the host structure for the distribution functions. - procedure, pass(this) :: set_element_map => set_host_element_map - !! Set the mapping of host elements to distribution function elements. - end type gvector_host_type - - type :: gvector_container_type + + type :: distribs_container_type !! Container for distribution functions. !! !! This type contains the distribution functions for a set of atomic @@ -96,7 +36,7 @@ module evolver !! Number of evaluated systems. integer :: num_evaluated_allocated = 0 !! Number of evaluated systems still allocated. - real(real12) :: kBT = 0.2_real12 + real(real32) :: kBT = 0.2_real32 !! Boltzmann constant times temperature. logical :: weight_by_hull = .false. !! Boolean whether to weight the distribution functions by the energy @@ -104,50 +44,50 @@ module evolver !! reference energies is used. integer, dimension(:), allocatable :: host_to_df_species_map !! Mapping of host species to distribution function species. - real(real12) :: & - viability_3body_default = 0.1_real12, & - viability_4body_default = 0.1_real12 + real(real32) :: & + viability_3body_default = 0.1_real32, & + viability_4body_default = 0.1_real32 !! Default viability for the 3- and 4-body distribution functions. logical, dimension(:), allocatable :: & in_dataset_2body, in_dataset_3body, in_dataset_4body !! Whether the 2-, 3-, and 4-body distribution functions are in !! the dataset. - real(real12), dimension(:), allocatable :: & + real(real32), dimension(:), allocatable :: & best_energy_pair, & best_energy_per_species !! Best energy for the 2-body and species distribution functions. integer, dimension(3) :: nbins = -1 !! Number of bins for the 2-, 3-, and 4-body distribution functions. - real(real12), dimension(3) :: & - sigma = [ 0.1_real12, 0.1_real12, 0.1_real12 ] + real(real32), dimension(3) :: & + sigma = [ 0.1_real32, 0.1_real32, 0.1_real32 ] !! Sigma of the gaussians used in the 2-, 3-, and 4-body !! distribution functions. - real(real12), dimension(3) :: & - width = [ 0.025_real12, pi/64._real12, pi/64._real12 ] + real(real32), dimension(3) :: & + width = [ 0.025_real32, pi/64._real32, pi/64._real32 ] !! Width of the bins used in the 2-, 3-, and 4-body distribution functions. - real(real12), dimension(3) :: & - cutoff_min = [ 0.5_real12, 0._real12, 0._real12 ] + real(real32), dimension(3) :: & + cutoff_min = [ 0.5_real32, 0._real32, 0._real32 ] !! Minimum cutoff for the 2-, 3-, and 4-body distribution functions. - real(real12), dimension(3) :: & - cutoff_max = [ 6._real12, pi, pi ] + real(real32), dimension(3) :: & + cutoff_max = [ 6._real32, pi, pi ] !! Maximum cutoff for the 2-, 3-, and 4-body distribution functions. - real(real12), dimension(4) :: & - radius_distance_tol = [ 1.5_real12, 2.5_real12, 3._real12, 6._real12 ] + real(real32), dimension(4) :: & + radius_distance_tol = [ 1.5_real32, 2.5_real32, 3._real32, 6._real32 ] !! Tolerance for the distance between atoms for 3- and 4-body. !! index 1 = lower bound for 3-body !! index 2 = upper bound for 3-body !! index 3 = lower bound for 4-body !! index 4 = upper bound for 4-body - real(real12), dimension(:), allocatable :: & + real(real32), dimension(:), allocatable :: & norm_2body, norm_3body, norm_4body !! Normalisation factors for the 2-, 3-, and 4-body distribution functions. - type(gvector_base_type) :: total !! name it best instead? - !! Total distribution functions for all systems. + type(distribs_base_type) :: gdf !! name it best instead? + !! Generalised distribution functions for all systems. !! Generated from combining the energy-weighted distribution functions !! of all systems - type(gvector_host_type) :: host_system + type(distribs_host_type) :: host_system !! Host structure for the distribution functions. - type(gvector_type), dimension(:), allocatable :: system + type(distribs_type), dimension(:), allocatable :: system !! Distribution functions for each system. type(element_type), dimension(:), allocatable :: element_info !! Information about the elements in the container. @@ -211,10 +151,10 @@ module evolver procedure, pass(this) :: set_best_energy !! Set the best energy and system in the container. - procedure, pass(this) :: initialise_gvectors + procedure, pass(this) :: initialise_gdfs !! Initialise the distribution functions in the container. - procedure, pass(this) :: set_gvector_to_default - !! Set the total distribution function to the default value. + procedure, pass(this) :: set_gdfs_to_default + !! Set the generalised distribution function to the default value. procedure, pass(this) :: evolve !! Evolve the learned distribution function. procedure, pass(this) :: write @@ -233,36 +173,36 @@ module evolver !! Return the index for element_info given one element. procedure, pass(this) :: get_bin !! Return the bin index for a given distance. - end type gvector_container_type + end type distribs_container_type - interface gvector_container_type + interface distribs_container_type !! Interface for the distribution functions container. - module function init_gvector_container( & + module function init_distribs_container( & nbins, width, sigma, cutoff_min, cutoff_max & - ) result(gvector_container) + ) result(distribs_container) !! Initialise the distribution functions container. integer, dimension(3), intent(in), optional :: nbins !! Optional. Number of bins for the 2-, 3-, and 4-body distribution !! functions. - real(real12), dimension(3), intent(in), optional :: width, sigma + real(real32), dimension(3), intent(in), optional :: width, sigma !! Optional. Width and sigma of the gaussians used in the 2-, 3-, and !! 4-body. - real(real12), dimension(3), intent(in), optional :: & + real(real32), dimension(3), intent(in), optional :: & cutoff_min, cutoff_max !! Optional. Minimum and maximum cutoff for the 2-, 3-, and 4-body. - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container !! Instance of the distribution functions container. - end function init_gvector_container - end interface gvector_container_type + end function init_distribs_container + end interface distribs_container_type contains !############################################################################### - module function init_gvector_container( & + module function init_distribs_container( & nbins, width, sigma, & cutoff_min, cutoff_max ) & - result(gvector_container) + result(distribs_container) !! Initialise the distribution functions container. implicit none @@ -270,12 +210,12 @@ module function init_gvector_container( & integer, dimension(3), intent(in), optional :: nbins !! Optional. Number of bins for the 2-, 3-, and 4-body distribution !! functions. - real(real12), dimension(3), intent(in), optional :: width, sigma + real(real32), dimension(3), intent(in), optional :: width, sigma !! Optional. Width and sigma of the gaussians used in the 2-, 3-, and !! 4-body. - real(real12), dimension(3), intent(in), optional :: cutoff_min, cutoff_max + real(real32), dimension(3), intent(in), optional :: cutoff_min, cutoff_max !! Optional. Minimum and maximum cutoff for the 2-, 3-, and 4-body. - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container !! Instance of the distribution functions container. ! Local variables @@ -284,37 +224,39 @@ module function init_gvector_container( & if(present(nbins))then - if(all(nbins .gt. 0)) gvector_container%nbins = nbins + if(all(nbins .gt. 0)) distribs_container%nbins = nbins end if if(present(width))then - if(all(width.ge.0._real12)) gvector_container%width = width + if(all(width.ge.0._real32)) distribs_container%width = width end if if(present(sigma))then - if(all(sigma.ge.0._real12)) gvector_container%sigma = sigma + if(all(sigma.ge.0._real32)) distribs_container%sigma = sigma end if if(present(cutoff_min))then - if(any(cutoff_min.ge.0._real12)) & - gvector_container%cutoff_min = cutoff_min + if(any(cutoff_min.ge.0._real32)) & + distribs_container%cutoff_min = cutoff_min end if if(present(cutoff_max))then - if(all(cutoff_max.ge.0._real12)) & - gvector_container%cutoff_max = cutoff_max + if(all(cutoff_max.ge.0._real32)) & + distribs_container%cutoff_max = cutoff_max end if - if(any(gvector_container%cutoff_max .le. gvector_container%cutoff_min))then + if( & + any(distribs_container%cutoff_max .le. distribs_container%cutoff_min) & + )then write(stop_msg,*) & "cutoff_max <= cutoff_min" // & achar(13) // achar(10) // & - "cutoff min: ", gvector_container%cutoff_min, & + "cutoff min: ", distribs_container%cutoff_min, & achar(13) // achar(10) // & - "cutoff max: ", gvector_container%cutoff_max + "cutoff max: ", distribs_container%cutoff_max call stop_program( stop_msg ) return end if - end function init_gvector_container + end function init_distribs_container !############################################################################### @@ -325,9 +267,9 @@ subroutine set_width(this, width) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. - real(real12), dimension(3), intent(in) :: width + real(real32), dimension(3), intent(in) :: width !! Width of the gaussians used in the 2-, 3-, and 4-body !! distribution functions. @@ -344,9 +286,9 @@ subroutine set_sigma(this, sigma) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. - real(real12), dimension(3), intent(in) :: sigma + real(real32), dimension(3), intent(in) :: sigma !! Sigma of the gaussians used in the 2-, 3-, and 4-body distribution !! functions. @@ -362,9 +304,9 @@ subroutine set_cutoff_min(this, cutoff_min) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. - real(real12), dimension(3), intent(in) :: cutoff_min + real(real32), dimension(3), intent(in) :: cutoff_min !! Minimum cutoff for the 2-, 3-, and 4-body distribution functions. this%cutoff_min = cutoff_min @@ -379,9 +321,9 @@ subroutine set_cutoff_max(this, cutoff_max) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. - real(real12), dimension(3), intent(in) :: cutoff_max + real(real32), dimension(3), intent(in) :: cutoff_max !! Maximum cutoff for the 2-, 3-, and 4-body distribution functions. this%cutoff_max = cutoff_max @@ -396,9 +338,9 @@ subroutine set_radius_distance_tol(this, radius_distance_tol) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. - real(real12), dimension(4), intent(in) :: radius_distance_tol + real(real32), dimension(4), intent(in) :: radius_distance_tol !! Tolerance for the distance between atoms for 3- and 4-body. this%radius_distance_tol = radius_distance_tol @@ -407,80 +349,6 @@ end subroutine set_radius_distance_tol !############################################################################### -!############################################################################### -! set the host stoichiometry, energy, and the final stoichiometry of the - subroutine set_host(this, host) - !! Set the host structure for the distribution functions. - !! - !! distribution function not needed for host - implicit none - - ! Arguments - class(gvector_host_type), intent(inout) :: this - !! Parent. Instance of distribution functions container. - type(basis_type), intent(in) :: host - !! Host structure for the distribution functions. - - ! Local variables - integer :: i, is, js - !! Loop indices. - - call this%basis%copy(host) - this%defined = .true. - allocate(this%pair_index(this%basis%nspec, this%basis%nspec)) - i = 0 - do is = 1, this%basis%nspec - do js = is, this%basis%nspec, 1 - i = i + 1 - this%pair_index(js,is) = i - this%pair_index(is,js) = i - end do - end do - if(allocated(this%df_2body)) deallocate(this%df_2body) - if(allocated(this%df_3body)) deallocate(this%df_3body) - if(allocated(this%df_4body)) deallocate(this%df_4body) - - !! Run set_element_map if total dfs have already been calculated - !! else, this will be run in the create() procedure - if(allocated(this%total%df_2body))then - call this%set_element_map(this%element_info) - end if - - end subroutine set_host -!############################################################################### - - -!############################################################################### - subroutine calculate_interface_energy(this, element_info) - !! Calculate the interface formation energy of the host. - implicit none - - ! Arguments - class(gvector_host_type), intent(inout) :: this - !! Parent. Instance of host type. - type(element_type), dimension(:), intent(in) :: element_info - !! List of elements and properties. - - ! Local variables - integer :: is, idx1 - !! Loop indices. - - this%interface_energy = this%energy - do is = 1, size(this%element_symbols) - idx1 = findloc( [ element_info(:)%name ], & - this%element_symbols(is), dim=1) - if(idx1.lt.1)then - call stop_program( "Species not found in species list" ) - return - end if - this%interface_energy = this%interface_energy - & - this%stoichiometry(is) * element_info(idx1)%energy - end do - - end subroutine calculate_interface_energy -!############################################################################### - - !############################################################################### subroutine create( & this, basis_list, energy_above_hull_list, deallocate_systems & @@ -488,11 +356,11 @@ subroutine create( & !! create the distribution functions from the input file implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. type(basis_type), dimension(:), intent(in) :: basis_list !! List of basis structures. - real(real12), dimension(:), intent(in), optional :: energy_above_hull_list + real(real32), dimension(:), intent(in), optional :: energy_above_hull_list !! List of energies above the hull for the structures. logical, intent(in), optional :: deallocate_systems !! Optional. Boolean whether to deallocate the systems after the @@ -509,7 +377,7 @@ subroutine create( & write(stop_msg,*) "element_database not allocated" // & achar(13) // achar(10) // & "Run the set_element_energies() procedure of " // & - "gvector_container_type before calling create()" + "distribs_container_type before calling create()" call stop_program( stop_msg ) return end if @@ -545,9 +413,9 @@ subroutine create( & this%num_evaluated = 0 this%num_evaluated_allocated = 0 - if(allocated(this%total%df_2body)) deallocate(this%total%df_2body) - if(allocated(this%total%df_3body)) deallocate(this%total%df_3body) - if(allocated(this%total%df_4body)) deallocate(this%total%df_4body) + if(allocated(this%gdf%df_2body)) deallocate(this%gdf%df_2body) + if(allocated(this%gdf%df_3body)) deallocate(this%gdf%df_3body) + if(allocated(this%gdf%df_4body)) deallocate(this%gdf%df_4body) if(allocated(this%norm_2body)) deallocate(this%norm_2body) if(allocated(this%norm_3body)) deallocate(this%norm_3body) if(allocated(this%norm_4body)) deallocate(this%norm_4body) @@ -580,11 +448,11 @@ subroutine update( & !! update the distribution functions from the input file implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. type(basis_type), dimension(:), intent(in) :: basis_list !! List of basis structures. - real(real12), dimension(:), intent(in), optional :: energy_above_hull_list + real(real32), dimension(:), intent(in), optional :: energy_above_hull_list !! List of energies above the hull for the structures. logical, intent(in), optional :: from_host !! Optional. Boolean whether structures are derived from the host. @@ -663,7 +531,7 @@ subroutine update( & write(stop_msg,*) "host not set" // & achar(13) // achar(10) // & "Run the set_host() procedure of parent of" // & - "gvector_container_type before calling create()" + "distribs_container_type before calling create()" call stop_program( stop_msg ) return else @@ -703,7 +571,7 @@ subroutine deallocate_systems(this) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. deallocate(this%system) @@ -721,7 +589,7 @@ subroutine write(this, file) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent. Instance of distribution functions container. character(*), intent(in) :: file !! Filename to write the distribution functions to. @@ -780,7 +648,7 @@ subroutine read(this, file) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. character(*), intent(in) :: file !! Filename to read the distribution functions from. @@ -796,7 +664,7 @@ subroutine read(this, file) !! Number of species and pairs. character(256) :: buffer !! Buffer for reading lines. - type(gvector_type) :: system + type(distribs_type) :: system !! System to read distribution functions into. @@ -818,8 +686,8 @@ subroutine read(this, file) read(buffer, *) system%element_symbols read(unit, *) system%stoichiometry system%num_atoms = sum(system%stoichiometry) - num_pairs = nint( gamma(real(num_species + 2, real12)) / & - ( gamma(real(num_species, real12)) * gamma( 3._real12 ) ) ) + num_pairs = nint( gamma(real(num_species + 2, real32)) / & + ( gamma(real(num_species, real32)) * gamma( 3._real32 ) ) ) allocate(system%df_2body(this%nbins(1),num_pairs)) do j = 1, this%nbins(1) read(unit, *) system%df_2body(j,:) @@ -849,7 +717,7 @@ subroutine write_2body(this, file) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent. Instance of distribution functions container. character(*), intent(in) :: file !! Filename to write the 2-body distribution functions to. @@ -865,9 +733,9 @@ subroutine write_2body(this, file) !! Pair indices. - num_pairs = nint( gamma(real(size(this%element_info) + 2, real12)) / & - ( gamma(real(size(this%element_info), real12)) * & - gamma( 3._real12 ) ) ) + num_pairs = nint( gamma(real(size(this%element_info) + 2, real32)) / & + ( gamma(real(size(this%element_info), real32)) * & + gamma( 3._real32 ) ) ) allocate(idx(2,num_pairs)) i = 0 do is = 1, size(this%element_info) @@ -878,13 +746,13 @@ subroutine write_2body(this, file) end do open(newunit=unit, file=file) - do i = 1, size(this%total%df_2body, dim=2) + do i = 1, size(this%gdf%df_2body, dim=2) write(unit,'("# ",A,2X,A)') & this%element_info(idx(1,i))%name, & this%element_info(idx(2,i))%name - do j = 1, size(this%total%df_2body, dim=1) + do j = 1, size(this%gdf%df_2body, dim=1) write(unit,*) this%cutoff_min(1) + this%width(1) * ( j - 1 ), & - this%total%df_2body(j,i) + this%gdf%df_2body(j,i) end do write(unit,*) end do @@ -900,7 +768,7 @@ subroutine write_3body(this, file) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent. Instance of distribution functions container. character(*), intent(in) :: file !! Filename to write the 3-body distribution functions to. @@ -913,11 +781,11 @@ subroutine write_3body(this, file) open(newunit=unit, file=file) - do i = 1, size(this%total%df_3body, dim=2) + do i = 1, size(this%gdf%df_3body, dim=2) write(unit,'("# ",A)') this%element_info(i)%name - do j = 1, size(this%total%df_3body, dim=1) + do j = 1, size(this%gdf%df_3body, dim=1) write(unit,*) this%cutoff_min(2) + this%width(2) * ( j - 1 ), & - this%total%df_3body(j,i) + this%gdf%df_3body(j,i) end do write(unit,*) end do @@ -933,7 +801,7 @@ subroutine write_4body(this, file) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent. Instance of distribution functions container. character(*), intent(in) :: file !! Filename to write the 4-body distribution functions to. @@ -946,11 +814,11 @@ subroutine write_4body(this, file) open(newunit=unit, file=file) - do i = 1, size(this%total%df_4body, dim=2) + do i = 1, size(this%gdf%df_4body, dim=2) write(unit,'("# ",A)') this%element_info(i)%name - do j = 1, size(this%total%df_4body, dim=1) + do j = 1, size(this%gdf%df_4body, dim=1) write(unit,*) this%cutoff_min(3) + this%width(3) * ( j - 1 ), & - this%total%df_4body(j,i) + this%gdf%df_4body(j,i) end do write(unit,*) end do @@ -966,7 +834,7 @@ subroutine add(this, system) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. class(*), dimension(..), intent(in) :: system !! System to add to the container. @@ -982,21 +850,21 @@ subroutine add(this, system) select rank(system) rank(0) select type(system) - type is (gvector_type) + type is (distribs_type) this%system = [ this%system, system ] type is (basis_type) call this%add_basis(system) class default write(stop_msg,*) "Invalid type for system" // & achar(13) // achar(10) // & - "Expected type gvector_type or basis_type" + "Expected type distribs_type or basis_type" call stop_program( stop_msg ) return end select rank(1) num_structures_previous = size(this%system) select type(system) - type is (gvector_type) + type is (distribs_type) this%system = [ this%system, system ] type is (basis_type) do i = 1, size(system) @@ -1005,7 +873,7 @@ subroutine add(this, system) class default write(stop_msg,*) "Invalid type for system" // & achar(13) // achar(10) // & - "Expected type gvector_type or basis_type" + "Expected type distribs_type or basis_type" call stop_program( stop_msg ) return end select @@ -1029,13 +897,13 @@ subroutine add_basis(this, basis) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent. Instance of distribution functions container. type(basis_type), intent(in) :: basis !! Basis to add to the container. ! Local variables - type(gvector_type) :: system + type(distribs_type) :: system !! System to add to the container. call system%calculate(basis, width = this%width, & @@ -1060,13 +928,13 @@ subroutine set_element_info(this) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. ! Local variables integer :: i !! Loop index. - real(real12) :: radius + real(real32) :: radius !! Element radii. character(len=3), dimension(:), allocatable :: element_list !! List of elements in the container. @@ -1106,13 +974,13 @@ subroutine update_element_info(this) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. ! Local variables integer :: i !! Loop index. - real(real12) :: radius + real(real32) :: radius !! Element radii. character(len=3), dimension(:), allocatable :: element_list !! List of elements in the container. @@ -1176,17 +1044,17 @@ subroutine set_element_energy(this, element, energy) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), intent(in) :: element !! Element name. - real(real12), intent(in) :: energy + real(real32), intent(in) :: energy !! Energy of the element. ! Local variables integer :: idx, idx_db !! Index of the element in the element_info array. - real(real12) :: radius + real(real32) :: radius !! Element radius. character(len=3) :: element_ !! Element name without null characters. @@ -1232,11 +1100,11 @@ subroutine set_element_energies(this, elements, energies) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), dimension(:), intent(in) :: elements !! Element names. - real(real12), dimension(:), intent(in) :: energies + real(real32), dimension(:), intent(in) :: energies !! Energies of the elements. ! Local variables @@ -1256,11 +1124,11 @@ subroutine get_element_energies(this, elements, energies) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), dimension(:), allocatable, intent(out) :: elements !! Element names. - real(real12), dimension(:), allocatable, intent(out) :: energies + real(real32), dimension(:), allocatable, intent(out) :: energies !! Energies of the elements. ! Local variables @@ -1288,12 +1156,12 @@ subroutine get_element_energies_staticmem(this, elements, energies) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), dimension(size(this%element_info,1)), intent(out) :: & elements !! Element names. - real(real12), dimension(size(this%element_info,1)), intent(out) :: energies + real(real32), dimension(size(this%element_info,1)), intent(out) :: energies !! Energies of the elements. ! Local variables @@ -1316,7 +1184,7 @@ subroutine set_bond_info(this) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. ! Local variables @@ -1332,8 +1200,8 @@ subroutine set_bond_info(this) ! allocate the bond information array !--------------------------------------------------------------------------- num_elements = size(this%element_info) - num_pairs = nint(gamma(real(num_elements + 2, real12)) / & - ( gamma(real(num_elements, real12)) * gamma( 3._real12 ) ) ) + num_pairs = nint(gamma(real(num_elements + 2, real32)) / & + ( gamma(real(num_elements, real32)) * gamma( 3._real32 ) ) ) if(allocated(this%bond_info)) deallocate(this%bond_info) allocate(this%bond_info(num_pairs)) @@ -1381,7 +1249,7 @@ subroutine set_bond_radius_to_default(elements) ! Local variables integer :: idx1, idx2 !! Index of the elements in the element database. - real(real12) :: radius, radius1, radius2 + real(real32) :: radius, radius1, radius2 !! Average of covalent radii. @@ -1407,7 +1275,7 @@ subroutine set_bond_radius_to_default(elements) idx2 = size(element_database) end if radius = ( element_database(idx1)%radius + & - element_database(idx2)%radius ) / 2._real12 + element_database(idx2)%radius ) / 2._real32 if(.not.allocated(element_bond_database)) & allocate(element_bond_database(0)) element_bond_database = [ element_bond_database, & @@ -1430,13 +1298,13 @@ subroutine update_bond_info(this) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. ! Local variables integer :: i, j, k, is, js !! Loop index. - real(real12) :: radius, radius1, radius2 + real(real32) :: radius, radius1, radius2 !! Average of covalent radii. character(len=3), dimension(:), allocatable :: element_list !! List of elements in the container. @@ -1496,7 +1364,7 @@ subroutine update_bond_info(this) radius2 = this%element_info(js)%radius if(radius2.le.1.E-6) & call get_element_properties(pair_list(i,2), radius = radius2) - radius = ( radius1 + radius2 ) / 2._real12 + radius = ( radius1 + radius2 ) / 2._real32 element_bond_database = [ element_bond_database, & element_bond_type(elements=[pair_list(i,:)], radius=radius) ] call sort_str(element_bond_database(size(element_bond_database))%element) @@ -1533,11 +1401,11 @@ subroutine set_bond_radius(this, elements, radius) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), dimension(2), intent(in) :: elements !! Element name. - real(real12), intent(in) :: radius + real(real32), intent(in) :: radius !! Bond radius. ! Local variables @@ -1598,11 +1466,11 @@ subroutine set_bond_radii(this, elements, radii) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), dimension(:,:), intent(in) :: elements !! Element names. - real(real12), dimension(:), intent(in) :: radii + real(real32), dimension(:), intent(in) :: radii !! Bond radii. ! Local variables @@ -1624,11 +1492,11 @@ subroutine get_bond_radii(this, elements, radii) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), dimension(:,:), allocatable, intent(out) :: elements !! Element pair names. - real(real12), dimension(:), allocatable, intent(out) :: radii + real(real32), dimension(:), allocatable, intent(out) :: radii !! Radii of the bond pairs. ! Local variables @@ -1656,12 +1524,12 @@ subroutine get_bond_radii_staticmem(this, elements, radii) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), dimension(size(this%bond_info,1),2), intent(out) :: & elements !! Element pair names. - real(real12), dimension(size(this%bond_info,1)), intent(out) :: radii + real(real32), dimension(size(this%bond_info,1)), intent(out) :: radii !! Radii of the bond pairs. ! Local variables @@ -1684,13 +1552,13 @@ subroutine set_best_energy(this) implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. ! Local variables integer :: i, j, is, js, idx1, idx2 !! Loop index. - real(real12) :: energy, energy_per_species, energy_pair + real(real32) :: energy, energy_per_species, energy_pair !! Energy of the system. integer, dimension(:,:), allocatable :: idx_list !! Index list for pairs of elements. @@ -1698,26 +1566,26 @@ subroutine set_best_energy(this) if(.not.allocated(this%best_energy_pair))then allocate( & this%best_energy_pair(size(this%bond_info,1)), & - source = 0._real12 & + source = 0._real32 & ) elseif(size(this%best_energy_pair).ne.size(this%bond_info))then deallocate(this%best_energy_pair) allocate( & this%best_energy_pair(size(this%bond_info,1)), & - source = 0._real12 & + source = 0._real32 & ) end if if(.not.allocated(this%best_energy_per_species))then allocate( & this%best_energy_per_species(size(this%element_info,1)), & - source = 0._real12 & + source = 0._real32 & ) elseif(size(this%best_energy_per_species).ne.size(this%element_info))then deallocate(this%best_energy_per_species) allocate( & this%best_energy_per_species(size(this%element_info,1)), & - source = 0._real12 & + source = 0._real32 & ) end if @@ -1751,7 +1619,7 @@ subroutine set_best_energy(this) this%system(i)%element_symbols(is), dim=1 ) energy_per_species = & energy * this%system(i)%weight_per_species(is) / & - real( sum( this%system(i)%num_per_species(:) ), real12 ) + real( sum( this%system(i)%num_per_species(:) ), real32 ) if( energy_per_species .lt. this%best_energy_per_species(idx1) )then this%best_energy_per_species(idx1) = energy_per_species @@ -1760,12 +1628,12 @@ subroutine set_best_energy(this) idx2 = findloc( [ this%element_info(:)%name ], & this%system(i)%element_symbols(js), dim=1) j = nint( ( size(this%element_info) - & - min( idx1, idx2 ) / 2._real12 ) * & - ( min( idx1, idx2 ) - 1._real12 ) + max( idx1, idx2 ) ) + min( idx1, idx2 ) / 2._real32 ) * & + ( min( idx1, idx2 ) - 1._real32 ) + max( idx1, idx2 ) ) energy_pair = & energy * this%system(i)%weight_pair(idx_list(is,js)) / & - real( sum( this%system(i)%num_per_species(:) ), real12 ) + real( sum( this%system(i)%num_per_species(:) ), real32 ) if( energy_pair .lt. this%best_energy_pair(j) )then this%best_energy_pair(j) = energy_pair @@ -1791,7 +1659,7 @@ pure function get_pair_index(this, species1, species2) result(idx) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), intent(in) :: species1, species2 !! Element names. @@ -1808,10 +1676,10 @@ pure function get_pair_index(this, species1, species2) result(idx) !! nth triangular number: N_n = n(n+1)/2 = ( n^2 + n ) / 2 !! idx = N_n - N_{n-is+1} + ( js - is + 1) !! idx = ( n - is/2 ) * ( is - 1 ) + js - !idx = nint( ( size(this%element_info) - min( is, js ) / 2._real12 ) * & - ! ( is - 1._real12 ) + js ) - idx = nint( ( size(this%element_info) - min( is, js ) / 2._real12 ) * & - ( min( is, js ) - 1._real12 ) + max( is, js ) ) + !idx = nint( ( size(this%element_info) - min( is, js ) / 2._real32 ) * & + ! ( is - 1._real32 ) + js ) + idx = nint( ( size(this%element_info) - min( is, js ) / 2._real32 ) * & + ( min( is, js ) - 1._real32 ) + max( is, js ) ) end function get_pair_index !############################################################################### @@ -1823,7 +1691,7 @@ pure function get_element_index(this, species) result(idx) implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent of the procedure. Instance of distribution functions container. character(len=3), intent(in) :: species !! Element name. @@ -1840,47 +1708,15 @@ end function get_element_index !############################################################################### -!############################################################################### - subroutine set_host_element_map(this, element_info) - !! Set the host element map for the container. - implicit none - - ! Arguments - class(gvector_host_type), intent(inout) :: this - !! Parent of the procedure. Instance of distribution functions container. - type(element_type), dimension(:), intent(in) :: element_info - !! Element information. - - ! Local variables - integer :: is, js - !! Index of the elements in the element_info array. - - if(.not.this%defined)then - call stop_program( "Host not defined" ) - return - end if - if(allocated(this%element_map)) deallocate(this%element_map) - allocate(this%element_map(this%basis%nspec)) - do is = 1, this%basis%nspec - this%element_map(is) = findloc(& - [ element_info(:)%name ], & - this%basis%spec(is)%name, dim=1 & - ) - end do - - end subroutine set_host_element_map -!############################################################################### - - !############################################################################### pure function get_bin(this, value, dim) result(bin) !! Get the bin index for a value in a dimension. implicit none ! Arguments - class(gvector_container_type), intent(in) :: this + class(distribs_container_type), intent(in) :: this !! Parent of the procedure. Instance of distribution functions container. - real(real12), intent(in) :: value + real(real32), intent(in) :: value !! Value to get the bin index for. integer, intent(in) :: dim !! Dimension to get the bin index for. @@ -1901,12 +1737,12 @@ end function get_bin !############################################################################### - subroutine initialise_gvectors(this) - !! Initialise the g-vectors for the container. + subroutine initialise_gdfs(this) + !! Initialise the distribution functions for the container. implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. ! Local variables @@ -1914,29 +1750,29 @@ subroutine initialise_gvectors(this) !! Number of pairs. - num_pairs = nint( gamma(real(size(this%element_info) + 2, real12)) / & - ( gamma(real(size(this%element_info), real12)) * gamma( 3._real12 ) ) ) - allocate(this%total%df_2body(this%nbins(1),num_pairs), & - source = 0._real12 ) - allocate(this%total%df_3body(this%nbins(2),size(this%element_info)), & - source = 0._real12 ) - allocate(this%total%df_4body(this%nbins(3),size(this%element_info)), & - source = 0._real12 ) + num_pairs = nint( gamma(real(size(this%element_info) + 2, real32)) / & + ( gamma(real(size(this%element_info), real32)) * gamma( 3._real32 ) ) ) + allocate(this%gdf%df_2body(this%nbins(1),num_pairs), & + source = 0._real32 ) + allocate(this%gdf%df_3body(this%nbins(2),size(this%element_info)), & + source = 0._real32 ) + allocate(this%gdf%df_4body(this%nbins(3),size(this%element_info)), & + source = 0._real32 ) allocate(this%in_dataset_2body(num_pairs), source = .false. ) allocate(this%in_dataset_3body(size(this%element_info)), source = .false. ) allocate(this%in_dataset_4body(size(this%element_info)), source = .false. ) - end subroutine initialise_gvectors + end subroutine initialise_gdfs !############################################################################### !############################################################################### - subroutine set_gvector_to_default(this, body, index) - !! Initialise the g-vectors for index of body distribution function. + subroutine set_gdfs_to_default(this, body, index) + !! Initialise the gdfs for index of body distribution function. implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. integer, intent(in) :: body !! Body distribution function to initialise. @@ -1944,50 +1780,50 @@ subroutine set_gvector_to_default(this, body, index) !! Index of the pair in the bond_info array. ! Local variables - real(real12) :: eta, weight, height - !! Parameters for the g-vectors. - real(real12), dimension(1) :: bonds + real(real32) :: eta, weight, height + !! Parameters for the distribution functions. + real(real32), dimension(1) :: bonds if( body .eq. 2 )then - weight = exp( -4._real12 ) - height = 1._real12 / this%nbins(1) - eta = 1._real12 / ( 2._real12 * ( this%sigma(1) )**2._real12 ) + weight = exp( -4._real32 ) + height = 1._real32 / this%nbins(1) + eta = 1._real32 / ( 2._real32 * ( this%sigma(1) )**2._real32 ) if(size(this%bond_info).eq.0)then call set_bond_radius_to_default( [ & this%bond_info(index)%element(1), & this%bond_info(index)%element(2) ] & ) end if - bonds = [ 2._real12 * this%bond_info(index)%radius_covalent ] + bonds = [ 2._real32 * this%bond_info(index)%radius_covalent ] if(abs(bonds(1)).lt.1.E-6)then call stop_program( "Bond radius is zero" ) end if - this%total%df_2body(:,index) = weight * height * get_gvector( & + this%gdf%df_2body(:,index) = weight * height * get_distrib( & bonds , & this%nbins(1), eta, this%width(1), & this%cutoff_min(1), & - scale_list = [ 1._real12 ] & + scale_list = [ 1._real32 ] & ) elseif( body .eq. 3 )then - this%total%df_3body(:,index) = 1._real12/this%nbins(2) + this%gdf%df_3body(:,index) = 1._real32/this%nbins(2) elseif( body .eq. 4 )then - this%total%df_4body(:,index) = 1._real12/this%nbins(3) + this%gdf%df_4body(:,index) = 1._real32/this%nbins(3) end if - end subroutine set_gvector_to_default + end subroutine set_gdfs_to_default !############################################################################### !############################################################################### subroutine evolve(this, system) - !! Evolve the g-vectors for the container. + !! Evolve the generalised distribution functions for the container. implicit none ! Arguments - class(gvector_container_type), intent(inout) :: this + class(distribs_container_type), intent(inout) :: this !! Parent of the procedure. Instance of distribution functions container. - type(gvector_type), dimension(..), intent(in), optional :: system + type(distribs_type), dimension(..), intent(in), optional :: system !! Optional. System to add to the container. ! Local variables @@ -1997,22 +1833,22 @@ subroutine evolve(this, system) !! Index of the element in the element_info array. integer :: num_evaluated !! Number of systems evaluated this iteration. - real(real12) :: weight, energy + real(real32) :: weight, energy !! Energy and weight variables for a system. - real(real12), dimension(:), allocatable :: & + real(real32), dimension(:), allocatable :: & best_energy_pair_old, & best_energy_per_species_old !! Old best energies. integer, dimension(:,:), allocatable :: idx_list !! Index list for the element pairs in a system. - real(real12), dimension(:,:), allocatable :: tmp_df - !! Temporary array for the g-vectors. + real(real32), dimension(:,:), allocatable :: tmp_df + !! Temporary array for the distribution functions. logical, dimension(:), allocatable :: tmp_in_dataset integer, dimension(:), allocatable :: host_idx_list - weight = 1._real12 + weight = 1._real32 !--------------------------------------------------------------------------- ! if present, add the system to the container @@ -2030,84 +1866,84 @@ subroutine evolve(this, system) !--------------------------------------------------------------------------- - ! initialise the total gvectors and get best energies from lowest - ! formation energy system + ! initialise the generalised distribution functions and get + ! best energies from lowest formation energy system !--------------------------------------------------------------------------- - if(.not.allocated(this%total%df_2body))then + if(.not.allocated(this%gdf%df_2body))then call this%set_best_energy() - call this%initialise_gvectors() + call this%initialise_gdfs() else best_energy_pair_old = this%best_energy_pair best_energy_per_species_old = this%best_energy_per_species call this%set_best_energy() - do i = 1, size(this%total%df_2body,2) - this%total%df_2body(:,i) = this%total%df_2body(:,i) * & + do i = 1, size(this%gdf%df_2body,2) + this%gdf%df_2body(:,i) = this%gdf%df_2body(:,i) * & exp( this%best_energy_pair(i) / this%kBT ) / & exp( best_energy_pair_old(i) / this%kBT ) end do - do i = 1, size(this%total%df_3body,2) - this%total%df_3body(:,i) = & - this%total%df_3body(:,i) * exp( & + do i = 1, size(this%gdf%df_3body,2) + this%gdf%df_3body(:,i) = & + this%gdf%df_3body(:,i) * exp( & this%best_energy_per_species(i) / this%kBT & ) / exp( best_energy_per_species_old(i) / this%kBT ) - this%total%df_4body(:,i) = & - this%total%df_4body(:,i) * exp( & + this%gdf%df_4body(:,i) = & + this%gdf%df_4body(:,i) * exp( & this%best_energy_per_species(i) / this%kBT & ) / exp( best_energy_per_species_old(i) / this%kBT ) end do - if(size(this%total%df_2body,2).ne.size(this%bond_info))then + if(size(this%gdf%df_2body,2).ne.size(this%bond_info))then allocate(tmp_df(this%nbins(1),size(this%bond_info)), & - source = 0._real12 ) - tmp_df(:,1:size(this%total%df_2body,2)) = this%total%df_2body - deallocate(this%total%df_2body) - call move_alloc( tmp_df, this%total%df_2body ) + source = 0._real32 ) + tmp_df(:,1:size(this%gdf%df_2body,2)) = this%gdf%df_2body + deallocate(this%gdf%df_2body) + call move_alloc( tmp_df, this%gdf%df_2body ) allocate(tmp_in_dataset(size(this%bond_info)), source = .false. ) tmp_in_dataset(1:size(this%in_dataset_2body)) = this%in_dataset_2body deallocate(this%in_dataset_2body) call move_alloc( tmp_in_dataset, this%in_dataset_2body ) end if - if(size(this%total%df_3body,2).ne.size(this%element_info))then + if(size(this%gdf%df_3body,2).ne.size(this%element_info))then allocate(tmp_df(this%nbins(2),size(this%element_info)), & - source = 0._real12 ) - tmp_df(:,1:size(this%total%df_3body,2)) = this%total%df_3body - deallocate(this%total%df_3body) - call move_alloc( tmp_df, this%total%df_3body ) + source = 0._real32 ) + tmp_df(:,1:size(this%gdf%df_3body,2)) = this%gdf%df_3body + deallocate(this%gdf%df_3body) + call move_alloc( tmp_df, this%gdf%df_3body ) allocate(tmp_in_dataset(size(this%element_info)), source = .false. ) tmp_in_dataset(1:size(this%in_dataset_3body)) = this%in_dataset_3body deallocate(this%in_dataset_3body) call move_alloc( tmp_in_dataset, this%in_dataset_3body ) end if - if(size(this%total%df_4body,2).ne.size(this%element_info))then + if(size(this%gdf%df_4body,2).ne.size(this%element_info))then allocate(tmp_df(this%nbins(3),size(this%element_info)), & - source = 0._real12 ) - tmp_df(:,1:size(this%total%df_4body,2)) = this%total%df_4body - deallocate(this%total%df_4body) - call move_alloc( tmp_df, this%total%df_4body ) + source = 0._real32 ) + tmp_df(:,1:size(this%gdf%df_4body,2)) = this%gdf%df_4body + deallocate(this%gdf%df_4body) + call move_alloc( tmp_df, this%gdf%df_4body ) allocate(tmp_in_dataset(size(this%element_info)), source = .false. ) tmp_in_dataset(1:size(this%in_dataset_4body)) = this%in_dataset_4body deallocate(this%in_dataset_4body) call move_alloc( tmp_in_dataset, this%in_dataset_4body ) end if - do j = 1, size(this%total%df_2body,2) + do j = 1, size(this%gdf%df_2body,2) if(.not.this%in_dataset_2body(j))then - this%total%df_2body(:,j) = 0._real12 + this%gdf%df_2body(:,j) = 0._real32 else - this%total%df_2body(:,j) = & - this%total%df_2body(:,j) * this%norm_2body(j) + this%gdf%df_2body(:,j) = & + this%gdf%df_2body(:,j) * this%norm_2body(j) end if end do do is = 1, size(this%element_info) if(.not.this%in_dataset_3body(is))then - this%total%df_3body(:,is) = 0._real12 + this%gdf%df_3body(:,is) = 0._real32 else - this%total%df_3body(:,is) = & - this%total%df_3body(:,is) * this%norm_3body(is) + this%gdf%df_3body(:,is) = & + this%gdf%df_3body(:,is) * this%norm_3body(is) end if if(.not.this%in_dataset_4body(is))then - this%total%df_4body(:,is) = 0._real12 + this%gdf%df_4body(:,is) = 0._real32 else - this%total%df_4body(:,is) = & - this%total%df_4body(:,is) * this%norm_4body(is) + this%gdf%df_4body(:,is) = & + this%gdf%df_4body(:,is) * this%norm_4body(is) end if end do deallocate(this%norm_2body) @@ -2134,7 +1970,7 @@ subroutine evolve(this, system) end if !--------------------------------------------------------------------------- - ! loop over all systems to calculate the total gvectors + ! loop over all systems to calculate the generalised distribution functions !--------------------------------------------------------------------------- num_evaluated = 0 do i = this%num_evaluated_allocated + 1, size(this%system), 1 @@ -2175,7 +2011,7 @@ subroutine evolve(this, system) energy = energy / this%system(i)%num_atoms j = 0 !------------------------------------------------------------------------ - ! loop over all species in the system to add the gvectors + ! loop over all species in the system to add the distributions !------------------------------------------------------------------------ do is = 1, size(this%system(i)%element_symbols) @@ -2190,7 +2026,7 @@ subroutine evolve(this, system) this%system(i)%weight_per_species(is) / & real( & sum( this%system(i)%num_per_species(:) ), & - real12 & + real32 & ) & ) & ) / this%kBT & @@ -2198,15 +2034,15 @@ subroutine evolve(this, system) if(weight.lt.1.E-6) cycle end if - this%total%df_3body(:,idx1) = this%total%df_3body(:,idx1) + & + this%gdf%df_3body(:,idx1) = this%gdf%df_3body(:,idx1) + & set_difference( weight * this%system(i)%df_3body(:,is), & - this%total%df_3body(:,idx1), & + this%gdf%df_3body(:,idx1), & set_min_zero = .true. & ) - this%total%df_4body(:,idx1) = this%total%df_4body(:,idx1) + & + this%gdf%df_4body(:,idx1) = this%gdf%df_4body(:,idx1) + & set_difference( weight * this%system(i)%df_4body(:,is), & - this%total%df_4body(:,idx1), & + this%gdf%df_4body(:,idx1), & set_min_zero = .true. & ) @@ -2214,8 +2050,8 @@ subroutine evolve(this, system) idx2 = findloc( [ this%element_info(:)%name ], & this%system(i)%element_symbols(js), dim=1) j = nint( ( size(this%element_info) - & - min( idx1, idx2 ) / 2._real12 ) * & - ( min( idx1, idx2 ) - 1._real12 ) + max( idx1, idx2 ) ) + min( idx1, idx2 ) / 2._real32 ) * & + ( min( idx1, idx2 ) - 1._real32 ) + max( idx1, idx2 ) ) if(.not.this%weight_by_hull)then weight = exp( & @@ -2225,7 +2061,7 @@ subroutine evolve(this, system) this%system(i)%weight_pair(idx_list(is,js)) / & real( & sum( this%system(i)%num_per_species(:) ), & - real12 & + real32 & ) & ) & ) / this%kBT & @@ -2233,10 +2069,10 @@ subroutine evolve(this, system) if(weight.lt.1.E-6) cycle end if - this%total%df_2body(:,j) = this%total%df_2body(:,j) + & + this%gdf%df_2body(:,j) = this%gdf%df_2body(:,j) + & set_difference( & weight * this%system(i)%df_2body(:,idx_list(is,js)), & - this%total%df_2body(:,j), & + this%gdf%df_2body(:,j), & set_min_zero = .true. & ) @@ -2246,579 +2082,66 @@ subroutine evolve(this, system) end do !---------------------------------------------------------------------------- - ! if not in the dataset, set g-vectors to default + ! if not in the dataset, set distribution functions to default !---------------------------------------------------------------------------- - do j = 1, size(this%total%df_2body,2) - if(all(abs(this%total%df_2body(:,j)).lt.1.E-6))then - call this%set_gvector_to_default(2, j) + do j = 1, size(this%gdf%df_2body,2) + if(all(abs(this%gdf%df_2body(:,j)).lt.1.E-6))then + call this%set_gdfs_to_default(2, j) else this%in_dataset_2body(j) = .true. end if end do do is = 1, size(this%element_info) - if(all(abs(this%total%df_3body(:,is)).lt.1.E-6))then - call this%set_gvector_to_default(3, is) + if(all(abs(this%gdf%df_3body(:,is)).lt.1.E-6))then + call this%set_gdfs_to_default(3, is) else this%in_dataset_3body(is) = .true. end if - if(all(abs(this%total%df_4body(:,is)).lt.1.E-6))then - call this%set_gvector_to_default(4, is) + if(all(abs(this%gdf%df_4body(:,is)).lt.1.E-6))then + call this%set_gdfs_to_default(4, is) else this%in_dataset_4body(is) = .true. end if end do - allocate(this%norm_2body(size(this%total%df_2body,2))) - do j = 1, size(this%total%df_2body,2) - this%norm_2body(j) = maxval(this%total%df_2body(:,j)) + allocate(this%norm_2body(size(this%gdf%df_2body,2))) + do j = 1, size(this%gdf%df_2body,2) + this%norm_2body(j) = maxval(this%gdf%df_2body(:,j)) if(abs(this%norm_2body(j)).lt.1.E-6)then - call stop_program( "Zero norm for 2-body g-vector" ) + call stop_program( "Zero norm for 2-body distribution function" ) return end if - this%total%df_2body(:,j) = & - this%total%df_2body(:,j) / this%norm_2body(j) + this%gdf%df_2body(:,j) = & + this%gdf%df_2body(:,j) / this%norm_2body(j) end do allocate(this%norm_3body(size(this%element_info))) allocate(this%norm_4body(size(this%element_info))) do is = 1, size(this%element_info) - this%norm_3body(is) = maxval(this%total%df_3body(:,is)) + this%norm_3body(is) = maxval(this%gdf%df_3body(:,is)) if(abs(this%norm_3body(is)).lt.1.E-6)then - call stop_program( "Zero norm for 3-body g-vector" ) + call stop_program( "Zero norm for 3-body distribution function" ) return end if - this%norm_4body(is) = maxval(this%total%df_4body(:,is)) + this%norm_4body(is) = maxval(this%gdf%df_4body(:,is)) if(abs(this%norm_4body(is)).lt.1.E-6)then - call stop_program( "Zero norm for 4-body g-vector" ) + call stop_program( "Zero norm for 4-body distribution function" ) return end if - this%total%df_3body(:,is) = & - this%total%df_3body(:,is) / this%norm_3body(is) - this%total%df_4body(:,is) = & - this%total%df_4body(:,is) / this%norm_4body(is) + this%gdf%df_3body(:,is) = & + this%gdf%df_3body(:,is) / this%norm_3body(is) + this%gdf%df_4body(:,is) = & + this%gdf%df_4body(:,is) / this%norm_4body(is) end do this%num_evaluated_allocated = size(this%system) this%num_evaluated = this%num_evaluated + num_evaluated - this%viability_3body_default = sum( this%total%df_3body ) / & - real( size( this%total%df_3body ), real12 ) - this%viability_4body_default = sum( this%total%df_4body ) / & - real( size( this%total%df_4body ), real12 ) + this%viability_3body_default = sum( this%gdf%df_3body ) / & + real( size( this%gdf%df_3body ), real32 ) + this%viability_4body_default = sum( this%gdf%df_4body ) / & + real( size( this%gdf%df_4body ), real32 ) end subroutine evolve !############################################################################### - -!############################################################################### - subroutine calculate(this, basis, & - nbins, width, sigma, cutoff_min, cutoff_max, radius_distance_tol) - !! Calculate the distribution functions for the container. - !! - !! This procedure calculates the 2-, 3-, and 4-body distribution function - !! for a given atomic structure (i.e. basis). - implicit none - - ! Arguments - class(gvector_type), intent(inout) :: this - !! Parent of the procedure. Instance of distribution functions container. - type(basis_type), intent(in) :: basis - !! Atomic structure. - integer, dimension(3), intent(in), optional :: nbins - !! Optional. Number of bins for the distribution functions. - real(real12), dimension(3), intent(in), optional :: width, sigma - !! Optional. Width and sigma for the distribution functions. - real(real12), dimension(3), intent(in), optional :: cutoff_min, cutoff_max - !! Optional. Cutoff minimum and maximum for the distribution functions. - real(real12), dimension(4), intent(in), optional :: radius_distance_tol - !! Tolerance for the distance between atoms for 3- and 4-body. - - ! Local variables - integer, dimension(3) :: nbins_ - !! Number of bins for the distribution functions. - real(real12), dimension(3) :: sigma_ - !! Sigma for the distribution functions. - real(real12), dimension(3) :: width_ - !! Width of the bins for the distribution functions. - real(real12), dimension(3) :: cutoff_min_ - !! Cutoff minimum for the distribution functions. - real(real12), dimension(3) :: cutoff_max_ - !! Cutoff maximum for the distribution functions. - type(element_bond_type), dimension(:), allocatable :: bond_info - !! Bond information for radii. - real(real12), dimension(4) :: radius_distance_tol_ - !! Tolerance for the distance between atoms for 3- and 4-body. - - - integer :: i, b, itmp1, idx - !! Loop index. - integer :: is, js, ia, ja, ka, la - !! Loop index. - integer :: num_pairs - !! Number of pairs and angles. - real(real12) :: bondlength - !! Temporary real variables. - logical :: success - !! Boolean for success. - type(extended_basis_type) :: basis_extd - !! Extended basis of the system. - type(extended_basis_type) :: neighbour_basis - !! Basis for storing neighbour data. - real(real12), dimension(3) :: eta - !! Parameters for the distribution functions. - real(real12), allocatable, dimension(:) :: angle_list, bondlength_list, & - distance - !! Temporary real arrays. - integer, allocatable, dimension(:,:) :: pair_index - !! Index of element pairs. - - - !--------------------------------------------------------------------------- - ! initialise optional variables - !--------------------------------------------------------------------------- - if(present(cutoff_min))then - cutoff_min_ = cutoff_min - else - cutoff_min_ = [0.5_real12, 0._real12, 0._real12] - end if - if(present(cutoff_max))then - cutoff_max_ = cutoff_max - else - cutoff_max_ = [6._real12, pi, pi] - end if - if(present(width))then - width_ = width - else - width_ = [0.25_real12, pi/64._real12, pi/64._real12] - end if - if(present(sigma))then - sigma_ = sigma - else - sigma_ = [0.1_real12, 0.1_real12, 0.1_real12] - end if - if(present(nbins))then - nbins_ = nbins - width_ = ( cutoff_max_ - cutoff_min_ )/real( nbins_ - 1, real12 ) - else - nbins_ = 1 + nint( (cutoff_max_ - cutoff_min_)/width_ ) - end if - if(present(radius_distance_tol))then - radius_distance_tol_ = radius_distance_tol - else - radius_distance_tol_ = [1.5_real12, 2.5_real12, 3._real12, 6._real12] - end if - - - - !--------------------------------------------------------------------------- - ! get the number of pairs of species - ! (this uses a combination calculator with repetition) - !--------------------------------------------------------------------------- - num_pairs = nint(gamma(real(basis%nspec + 2, real12)) / & - ( gamma(real(basis%nspec, real12)) * gamma( 3._real12 ) )) - allocate(this%element_symbols(basis%nspec)) - do is = 1, basis%nspec - this%element_symbols(is) = strip_null(basis%spec(is)%name) - end do - i = 0 - allocate(bond_info(num_pairs)) - allocate(pair_index(basis%nspec,basis%nspec)) - do is = 1, basis%nspec - do js = is, basis%nspec, 1 - i = i + 1 - pair_index(js,is) = i - pair_index(is,js) = i - call bond_info(i)%set( this%element_symbols(is), & - this%element_symbols(js), success & - ) - if(success) cycle - call set_bond_radius_to_default( [ & - this%element_symbols(is), & - this%element_symbols(js) ] & - ) - call bond_info(i)%set( this%element_symbols(is), & - this%element_symbols(js), success & - ) - end do - end do - - - !--------------------------------------------------------------------------- - ! get the stoichiometry, energy, and number of atoms - !--------------------------------------------------------------------------- - this%stoichiometry = basis%spec(:)%num - this%energy = basis%energy - this%num_atoms = basis%natom - - - !--------------------------------------------------------------------------- - ! calculate the gaussian width and allocate the distribution functions - !--------------------------------------------------------------------------- - eta = 1._real12 / ( 2._real12 * sigma_**2._real12 ) - allocate(this%num_pairs(num_pairs), source = 0) - allocate(this%num_per_species(basis%nspec), source = 0) - allocate(this%weight_pair(num_pairs), source = 0._real12) - allocate(this%weight_per_species(basis%nspec), source = 0._real12) - allocate(this%df_2body(nbins_(1), num_pairs), source = 0._real12) - allocate(this%df_3body(nbins_(2), basis%nspec), source = 0._real12) - allocate(this%df_4body(nbins_(3), basis%nspec), source = 0._real12) - - - !--------------------------------------------------------------------------- - ! create the extended basis and neighbour basis - !--------------------------------------------------------------------------- - call basis_extd%copy(basis) - call basis_extd%create_images( max_bondlength = cutoff_max_(1) ) - allocate(bondlength_list(basis_extd%natom+basis_extd%num_images)) - - allocate(neighbour_basis%spec(1)) - allocate(neighbour_basis%image_spec(1)) - allocate(neighbour_basis%spec(1)%atom( & - sum(basis_extd%spec(:)%num)+sum(basis_extd%image_spec(:)%num), 3 & - ) ) - allocate(neighbour_basis%image_spec(1)%atom( & - sum(basis_extd%spec(:)%num)+sum(basis_extd%image_spec(:)%num), 3 & - ) ) - neighbour_basis%nspec = basis%nspec - neighbour_basis%natom = 0 - neighbour_basis%num_images = 0 - neighbour_basis%lat = basis%lat - - - !--------------------------------------------------------------------------- - ! calculate the distribution functions - !--------------------------------------------------------------------------- - do is = 1, basis%nspec - do ia = 1, basis%spec(is)%num - allocate(distance(basis_extd%natom+basis_extd%num_images)) !!! ALLOCATE THIS ONCE AND JUST WRITE OVER ? - neighbour_basis%spec(1)%num = 0 - neighbour_basis%image_spec(1)%num = 0 - do js = 1, basis%nspec - itmp1 = 0 - - !------------------------------------------------------------------ - ! loop over all atoms inside the unit cell - !------------------------------------------------------------------ - atom_loop: do ja = 1, basis_extd%spec(js)%num - - associate( vector => matmul( [ & - basis_extd%spec(js)%atom(ja,1:3) - & - basis_extd%spec(is)%atom(ia,1:3) & - ], basis_extd%lat ) & - ) - bondlength = modu( vector ) - - if( bondlength .lt. cutoff_min_(1) .or. & - bondlength .gt. cutoff_max_(1) ) cycle atom_loop - - ! add 2-body bond to store if within tolerances for 3-body - ! distance - if( & - bondlength .ge. & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(1) .and. & - bondlength .le. & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(2) & - ) then - neighbour_basis%spec(1)%num = & - neighbour_basis%spec(1)%num + 1 - neighbour_basis%spec(1)%atom( & - neighbour_basis%spec(1)%num,1:3) = vector - end if - - ! add 2-body bond to store if within tolerances for 4-body - ! distance - if( bondlength .ge. ( & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(3) ) .and. & - bondlength .le. ( & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(4) ) & - ) then - neighbour_basis%image_spec(1)%num = & - neighbour_basis%image_spec(1)%num + 1 - neighbour_basis%image_spec(1)%atom( & - neighbour_basis%image_spec(1)%num,1:3) = vector - end if - - !if(js.lt.js.or.(is.eq.js.and.ja.le.ia)) cycle - itmp1 = itmp1 + 1 - bondlength_list(itmp1) = bondlength - distance(itmp1) = 1._real12 - - end associate - end do atom_loop - - - !------------------------------------------------------------------ - ! loop over all image atoms outside of the unit cell - !------------------------------------------------------------------ - image_loop: do ja = 1, basis_extd%image_spec(js)%num - associate( vector => matmul( [ & - basis_extd%image_spec(js)%atom(ja,1:3) - & - basis_extd%spec(is)%atom(ia,1:3) & - ], basis_extd%lat ) & - ) - - bondlength = modu( vector ) - - if( bondlength .lt. cutoff_min_(1) .or. & - bondlength .gt. cutoff_max_(1) ) cycle image_loop - - ! add 2-body bond to store if within tolerances for 3-body - ! distance - if( & - bondlength .ge. & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(1) .and. & - bondlength .le. & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(2) & - ) then - neighbour_basis%spec(1)%num = & - neighbour_basis%spec(1)%num + 1 - neighbour_basis%spec(1)%atom( & - neighbour_basis%spec(1)%num,1:3 & - ) = vector - end if - - ! add 2-body bond to store if within tolerances for 4-body - ! distance - if( bondlength .ge. ( & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(3) ) .and. & - bondlength .le. ( & - bond_info(pair_index(is, js))%radius_covalent * & - radius_distance_tol_(4) ) & - ) then - neighbour_basis%image_spec(1)%num = & - neighbour_basis%image_spec(1)%num + 1 - neighbour_basis%image_spec(1)%atom( & - neighbour_basis%image_spec(1)%num,1:3 & - ) = vector - end if - - itmp1 = itmp1 + 1 - bondlength_list(itmp1) = bondlength - distance(itmp1) = 1._real12 - - end associate - end do image_loop - - !------------------------------------------------------------------ - ! calculate the 2-body distribution function contributions from - ! atom (is,ia) for species pair (is,js) - !------------------------------------------------------------------ - if(itmp1.gt.0)then - this%df_2body(:,pair_index(is, js)) = & - this%df_2body(:,pair_index(is, js)) + & - get_gvector( & - bondlength_list(:itmp1), & - nbins_(1), eta(1), width_(1), & - cutoff_min_(1), & - scale_list = distance(:itmp1) & - ) - this%weight_pair(pair_index(is, js)) = & - this%weight_pair(pair_index(is, js)) + & - 4._real12 * sum( & - ( & - bond_info(pair_index(is, js))%radius_covalent / & - bondlength_list(:itmp1) ) ** 2 & - ) - this%num_pairs(pair_index(is, js)) = & - this%num_pairs(pair_index(is, js)) + itmp1 - this%weight_per_species(is) = & - this%weight_per_species(is) + & - 4._real12 * sum( & - ( & - bond_info(pair_index(is, js))%radius_covalent / & - bondlength_list(:itmp1) ) ** 2 & - ) - this%num_per_species(is) = this%num_per_species(is) + itmp1 - end if - - end do - deallocate(distance) - - - !--------------------------------------------------------------------- - ! calculate the 3-body distribution function for atom (is,ia) - !--------------------------------------------------------------------- - if(neighbour_basis%spec(1)%num.le.1) cycle - associate( & - num_angles => & - triangular_number( neighbour_basis%spec(1)%num - 1 ) & - ) - allocate( angle_list(num_angles), distance(num_angles) ) - end associate - do concurrent ( ja = 1:neighbour_basis%spec(1)%num:1 ) - do concurrent ( ka = ja + 1:neighbour_basis%spec(1)%num:1 ) - idx = nint( & - (ja - 1) * (neighbour_basis%spec(1)%num - ja / 2.0) + & - (ka - ja) & - ) - angle_list(idx) = get_angle( & - [ neighbour_basis%spec(1)%atom(ja,:3) ], & - [ neighbour_basis%spec(1)%atom(ka,:3) ] & - ) - distance(idx) = & - ( & - modu(neighbour_basis%spec(1)%atom(ja,:3)) ** 2 * & - modu(neighbour_basis%spec(1)%atom(ka,:3)) ** 2 & - ) - end do - end do - this%df_3body(:,is) = this%df_3body(:,is) + & - get_gvector( angle_list, & - nbins_(2), eta(2), width_(2), & - cutoff_min_(2), & - scale_list = distance & - ) - deallocate( angle_list, distance ) - - - !--------------------------------------------------------------------- - ! calculate the 4-body distribution function for atom (is,ia) - !--------------------------------------------------------------------- - if(neighbour_basis%image_spec(1)%num.eq.0) cycle - associate( & - num_angles => & - triangular_number( neighbour_basis%spec(1)%num - 1 ) * & - neighbour_basis%image_spec(1)%num & - ) - allocate( angle_list(num_angles), distance(num_angles) ) - end associate - idx = 0 - do concurrent ( & - ja = 1:neighbour_basis%spec(1)%num:1, & - la = 1:neighbour_basis%image_spec(1)%num:1 & - ) - do concurrent ( ka = ja + 1:neighbour_basis%spec(1)%num:1 ) - idx = nint( & - (ja - 1) * (neighbour_basis%spec(1)%num - ja / 2.0) + & - (ka - ja - 1) & - ) * neighbour_basis%image_spec(1)%num + la - angle_list(idx) = & - get_improper_dihedral_angle( & - [ neighbour_basis%spec(1)%atom(ja,:3) ], & - [ neighbour_basis%spec(1)%atom(ka,:3) ], & - [ neighbour_basis%image_spec(1)%atom(la,:3) ] & - ) - distance(idx) = & - modu(neighbour_basis%spec(1)%atom(ja,:3)) ** 2 * & - modu(neighbour_basis%spec(1)%atom(ka,:3)) ** 2 * & - modu(neighbour_basis%image_spec(1)%atom(la,:3)) ** 2 - end do - end do - this%df_4body(:,is) = this%df_4body(:,is) + & - get_gvector( angle_list, & - nbins_(3), eta(3), width_(3), & - cutoff_min_(3), & - scale_list = distance & - ) - deallocate( angle_list, distance ) - - end do - end do - - !--------------------------------------------------------------------------- - ! apply the cutoff function to the 2-body distribution function - !--------------------------------------------------------------------------- - do b = 1, nbins_(1) - this%df_2body(b,:) = this%df_2body(b,:) / ( cutoff_min_(1) + & - width_(1) * real(b-1, real12) ) ** 2 - end do - - - !--------------------------------------------------------------------------- - ! renormalise the distribution functions so that area under the curve is 1 - !--------------------------------------------------------------------------- - do i = 1, num_pairs - if(any(abs(this%df_2body(:,i)).gt.1.E-6))then - this%df_2body(:,i) = this%df_2body(:,i) / sum(this%df_2body(:,i)) - end if - end do - do is = 1, basis%nspec - if(any(abs(this%df_3body(:,is)).gt.1.E-6))then - this%df_3body(:,is) = this%df_3body(:,is) / sum(this%df_3body(:,is)) - end if - if(any(abs(this%df_4body(:,is)).gt.1.E-6))then - this%df_4body(:,is) = this%df_4body(:,is) / sum(this%df_4body(:,is)) - end if - end do - - end subroutine calculate -!############################################################################### - - -!############################################################################### - function get_gvector(value_list, nbins, eta, width, cutoff_min, & - scale_list ) result(gvector) - !! Calculate the angular distribution function for a list of values. - implicit none - - ! Arguments - integer, intent(in) :: nbins - !! Number of bins for the distribution functions. - real(real12), intent(in) :: eta, width, cutoff_min - !! Parameters for the distribution functions. - real(real12), dimension(:), intent(in) :: value_list - !! List of angles. - real(real12), dimension(:), intent(in) :: scale_list - !! List of scaling for each angle (distance**3 or distance**4) - real(real12), dimension(nbins) :: gvector - !! Distribution function for the list of values. - - ! Local variables - integer :: i, j, b, bin - !! Loop index. - integer :: max_num_steps - !! Maximum number of steps. - integer, dimension(3,2) :: loop_limits - !! Loop limits for the 3-body distribution function. - - - max_num_steps = ceiling( sqrt(16._real12/eta) / width ) - gvector = 0._real12 - - !--------------------------------------------------------------------------- - ! calculate the gvector for a list of values - !--------------------------------------------------------------------------- - do i = 1, size(value_list), 1 - - !------------------------------------------------------------------------ - ! get the bin closest to the value - !------------------------------------------------------------------------ - bin = nint( ( value_list(i) - cutoff_min ) / width ) + 1 - - - !------------------------------------------------------------------------ - ! calculate the gaussian for this bond - !------------------------------------------------------------------------ - ! gvector_tmp = 0._real12 - loop_limits(:,1) = & - [ min(nbins, bin), min(nbins, bin + max_num_steps), 1 ] - loop_limits(:,2) = & - [ max(1, bin - 1), max(1, bin - max_num_steps), -1 ] - - - !------------------------------------------------------------------------ - ! do forward and backward loops to add gaussian from its centre - !------------------------------------------------------------------------ - do concurrent ( j = 1:2 ) - do concurrent ( & - b = loop_limits(1,j):loop_limits(2,j):loop_limits(3,j) ) - gvector(b) = gvector(b) + & - exp( -eta * ( value_list(i) - & - ( width * real(b-1, real12) + & - cutoff_min ) ) ** 2._real12 & - ) / scale_list(i) - end do - end do - end do - gvector = gvector * sqrt( eta / pi ) / real(size(value_list,1),real12) - - end function get_gvector -!############################################################################### - -end module evolver \ No newline at end of file +end module raffle__distribs_container \ No newline at end of file diff --git a/src/fortran/lib/mod_distribs_host.f90 b/src/fortran/lib/mod_distribs_host.f90 new file mode 100644 index 00000000..19f16d02 --- /dev/null +++ b/src/fortran/lib/mod_distribs_host.f90 @@ -0,0 +1,146 @@ +module raffle__distribs_host + !! Module for handling the host distribution functions. + !! + !! This module contains the type and procedures for handling the host + !! distribution function. Procedures are also provided to calculate the + !! interface energy of the host and to set the mapping of host elements to + !! the element database. + use raffle__constants, only: real32 + use raffle__io_utils, only: stop_program + use raffle__geom_rw, only: basis_type + use raffle__element_utils, only: element_type + use raffle__distribs, only: distribs_type + implicit none + + + private + + public :: distribs_host_type + + + type, extends(distribs_type) :: distribs_host_type + !! Type for host information. + !! + !! This type contains the information regarding the host structure that + !! will be used in the grandparent generator type. + logical :: defined = .false. + !! Boolean whether the host structure has been set. + real(real32) :: interface_energy = 0.0_real32 + !! Energy associated with the formation of the interface in the host. + type(basis_type) :: basis + !! Host structure. + integer, dimension(:,:), allocatable :: pair_index + !! Index for the 2-body distribution function. + integer, dimension(:), allocatable :: element_map + !! Mapping of host elements to distribution function elements. + contains + procedure, pass(this) :: calculate_interface_energy + !! Calculate the interface formation energy of the host. + procedure, pass(this) :: set => set_host + !! Set the host structure for the distribution functions. + procedure, pass(this) :: set_element_map => set_host_element_map + !! Set the mapping of host elements to distribution function elements. + end type distribs_host_type + + + contains + +!############################################################################### + subroutine set_host(this, host) + !! Set the host structure for the distribution functions. + !! + !! distribution function not needed for host + implicit none + + ! Arguments + class(distribs_host_type), intent(inout) :: this + !! Parent. Instance of distribution functions container. + type(basis_type), intent(in) :: host + !! Host structure for the distribution functions. + + ! Local variables + integer :: i, is, js + !! Loop indices. + + call this%basis%copy(host) + this%defined = .true. + allocate(this%pair_index(this%basis%nspec, this%basis%nspec)) + i = 0 + do is = 1, this%basis%nspec + do js = is, this%basis%nspec, 1 + i = i + 1 + this%pair_index(js,is) = i + this%pair_index(is,js) = i + end do + end do + if(allocated(this%df_2body)) deallocate(this%df_2body) + if(allocated(this%df_3body)) deallocate(this%df_3body) + if(allocated(this%df_4body)) deallocate(this%df_4body) + + end subroutine set_host +!############################################################################### + + +!############################################################################### + subroutine calculate_interface_energy(this, element_info) + !! Calculate the interface formation energy of the host. + implicit none + + ! Arguments + class(distribs_host_type), intent(inout) :: this + !! Parent. Instance of host type. + type(element_type), dimension(:), intent(in) :: element_info + !! List of elements and properties. + + ! Local variables + integer :: is, idx1 + !! Loop indices. + + this%interface_energy = this%energy + do is = 1, size(this%element_symbols) + idx1 = findloc( [ element_info(:)%name ], & + this%element_symbols(is), dim=1) + if(idx1.lt.1)then + call stop_program( "Species not found in species list" ) + return + end if + this%interface_energy = this%interface_energy - & + this%stoichiometry(is) * element_info(idx1)%energy + end do + + end subroutine calculate_interface_energy +!############################################################################### + + +!############################################################################### + subroutine set_host_element_map(this, element_info) + !! Set the host element map for the container. + implicit none + + ! Arguments + class(distribs_host_type), intent(inout) :: this + !! Parent of the procedure. Instance of distribution functions container. + type(element_type), dimension(:), intent(in) :: element_info + !! Element information. + + ! Local variables + integer :: is, js + !! Index of the elements in the element_info array. + + if(.not.this%defined)then + call stop_program( "Host not defined" ) + return + end if + if(allocated(this%element_map)) deallocate(this%element_map) + allocate(this%element_map(this%basis%nspec)) + do is = 1, this%basis%nspec + this%element_map(is) = findloc(& + [ element_info(:)%name ], & + this%basis%spec(is)%name, dim=1 & + ) + end do + + end subroutine set_host_element_map +!############################################################################### + +end module raffle__distribs_host \ No newline at end of file diff --git a/src/fortran/lib/mod_elements.f90 b/src/fortran/lib/mod_element_utils.f90 similarity index 82% rename from src/fortran/lib/mod_elements.f90 rename to src/fortran/lib/mod_element_utils.f90 index c0fe7d50..b2c8e478 100644 --- a/src/fortran/lib/mod_elements.f90 +++ b/src/fortran/lib/mod_element_utils.f90 @@ -1,4 +1,4 @@ -module elements +module raffle__element_utils !! Module for storing and handling element and bond data. !! !! This module contains the element and bond types, and the element and bond @@ -6,7 +6,7 @@ module elements !! of the elements and bonds in the system, respectively. !! The element and bond types are used by other modules to store the !! properties relevant to an individual system. - use constants, only: real12 + use raffle__constants, only: real32 implicit none private @@ -16,11 +16,12 @@ module elements type :: element_type + !! Type for storing the properties of an element. character(len=3) :: name - real(real12) :: mass = 0._real12 - real(real12) :: charge = 0._real12 - real(real12) :: radius = 0._real12 - real(real12) :: energy = 0._real12 + real(real32) :: mass = 0._real32 + real(real32) :: charge = 0._real32 + real(real32) :: radius = 0._real32 + real(real32) :: energy = 0._real32 contains procedure, pass(this) :: set => set_element end type element_type @@ -28,9 +29,8 @@ module elements type :: element_bond_type - real(real12) :: radius_covalent - ! real(real12) :: radius_vdw - ! integer, dimension(2) :: coordination + !! Type for storing the properties of a bond between two elements. + real(real32) :: radius_covalent character(3), dimension(2) :: element contains procedure, pass(this) :: set => set_bond @@ -43,7 +43,7 @@ module elements module function init_element_type( & name, mass, charge, energy) result(element) character(len=3), intent(in) :: name - real(real12), intent(in), optional :: mass, charge, energy + real(real32), intent(in), optional :: mass, charge, energy type(element_type) :: element end function init_element_type end interface element_type @@ -54,7 +54,7 @@ end function init_element_type module function init_element_bond_type( & elements, radius) result(bond) character(len=3), dimension(2), intent(in) :: elements - real(real12), intent(in), optional :: radius + real(real32), intent(in), optional :: radius type(element_bond_type) :: bond end function init_element_bond_type end interface element_bond_type @@ -65,12 +65,15 @@ end function init_element_bond_type !############################################################################### module function init_element_type(name, mass, charge, energy) result(element) !! Initialise an instance of the element_type. + !! + !! This function initialises an instance of the element_type with the + !! provided properties. implicit none ! Arguments character(len=3), intent(in) :: name !! Element name. - real(real12), intent(in), optional :: mass, charge, energy + real(real32), intent(in), optional :: mass, charge, energy !! Element mass, charge, and energy. type(element_type) :: element @@ -88,12 +91,15 @@ end function init_element_type !############################################################################### module function init_element_bond_type(elements, radius) result(bond) !! Initialise an instance of the element_bond_type. + !! + !! This function initialises an instance of the element_bond_type with the + !! provided properties. implicit none ! Arguments character(len=3), dimension(2), intent(in) :: elements !! Element names. - real(real12), intent(in), optional :: radius + real(real32), intent(in), optional :: radius !! Element radius. type(element_bond_type) :: bond @@ -109,6 +115,11 @@ end function init_element_bond_type !############################################################################### subroutine set_element(this, name, in_database) !! Set the element properties. + !! + !! This subroutine sets the properties of an element instance with data from + !! the element database. + !! Element properties include the mass, charge, radius, and reference energy + !! of the element. implicit none ! Arguments @@ -148,6 +159,10 @@ end subroutine set_element !############################################################################### subroutine set_bond(this, element_1, element_2, in_database) !! Set the bond properties for a pair of elements. + !! + !! This subroutine sets the properties of a bond instance with data from + !! the bond database. + !! Bond properties include the covalent radius of the bond. implicit none ! Arguments @@ -191,4 +206,4 @@ subroutine set_bond(this, element_1, element_2, in_database) end subroutine set_bond !############################################################################### -end module elements \ No newline at end of file +end module raffle__element_utils \ No newline at end of file diff --git a/src/fortran/lib/mod_error_handling.f90 b/src/fortran/lib/mod_error_handling.f90 deleted file mode 100644 index 8e588e91..00000000 --- a/src/fortran/lib/mod_error_handling.f90 +++ /dev/null @@ -1,33 +0,0 @@ -module error_handling - implicit none - logical :: test_error_handling = .false. - - private - - public :: test_error_handling - public :: stop_program - - -contains - - module subroutine stop_program(message, exit_code) - !! Stop the program and print an error message. - implicit none - character(len=*), intent(in) :: message - integer, intent(in), optional :: exit_code - - integer :: exit_code_ - - if(present(exit_code)) then - exit_code_ = exit_code - else - exit_code_ = 1 - end if - - write(0,*) 'ERROR: ', trim(message) - if(.not.test_error_handling)then - stop exit_code_ - end if - end subroutine stop_program - -end module error_handling \ No newline at end of file diff --git a/src/fortran/lib/mod_evaluator.f90 b/src/fortran/lib/mod_evaluator.f90 index 518f89a6..11e76256 100644 --- a/src/fortran/lib/mod_evaluator.f90 +++ b/src/fortran/lib/mod_evaluator.f90 @@ -1,17 +1,14 @@ -module evaluator +module raffle__evaluator !! Module to build viability map of a structure !! !! This module handles the viability map for a structure, which is a map of !! the system with each point in the map representing the suitability of !! that point for a new atom. The map is built by checking the bond lengths, !! bond angles and dihedral angles between the test point and all atoms. - use constants, only: real12, pi - use misc_linalg, only: modu, get_distance, get_angle, get_dihedral_angle, & - get_improper_dihedral_angle - use rw_geom, only: basis_type - use extended_geom, only: extended_basis_type - use edit_geom, only: get_min_dist_between_point_and_atom - use evolver, only: gvector_container_type + use raffle__constants, only: real32 + use raffle__misc_linalg, only: modu, get_angle, get_improper_dihedral_angle + use raffle__geom_extd, only: extended_basis_type + use raffle__distribs_container, only: distribs_container_type implicit none @@ -22,27 +19,31 @@ module evaluator contains !############################################################################### - function evaluate_point( gvector_container, & + function evaluate_point( distribs_container, & position, species, basis, atom_ignore_list, & - radius_list ) & - result(output) - !! Build a map of basis and returns the value of the map at a given point + radius_list & + ) result(output) + !! Return the viability of a point in a basis for a specified species + !! + !! This function evaluates the viability of a point in a basis for a + !! specified species. The viability is determined by the bond lengths, + !! bond angles and dihedral angles between the test point and all atoms. implicit none ! Arguments integer, intent(in) :: species !! Index of the query element. - type(gvector_container_type), intent(in) :: gvector_container + type(distribs_container_type), intent(in) :: distribs_container !! Distribution function (gvector) container. type(extended_basis_type), intent(in) :: basis !! Basis of the system. - real(real12), dimension(3), intent(in) :: position + real(real32), dimension(3), intent(in) :: position !! Position of the test point. integer, dimension(:,:), intent(in) :: atom_ignore_list !! List of atoms to ignore (i.e. indices of atoms not yet placed). - real(real12), dimension(:), intent(in) :: radius_list + real(real32), dimension(:), intent(in) :: radius_list !! List of radii for each pair of elements. - real(real12) :: output + real(real32) :: output !! Suitability of the test point. ! Local variables @@ -50,11 +51,11 @@ function evaluate_point( gvector_container, & !! Loop counters. integer :: num_2body, num_3body, num_4body !! Number of 2-, 3- and 4-body interactions. - real(real12) :: viability_2body + real(real32) :: viability_2body !! Viability of the test point for 2-body interactions. - real(real12) :: viability_3body, viability_4body + real(real32) :: viability_3body, viability_4body !! Viability of the test point for 3- and 4-body interactions. - real(real12) :: bondlength + real(real32) :: bondlength integer, dimension(:,:), allocatable :: pair_index !! Index of element pairs. type(extended_basis_type) :: neighbour_basis @@ -62,18 +63,20 @@ function evaluate_point( gvector_container, & ! Initialisation - output = 0._real12 - viability_2body = 0._real12 + output = 0._real32 + viability_2body = 0._real32 !--------------------------------------------------------------------------- ! get list of element pair indices + ! (i.e. the index for bond_info for each element pair) !--------------------------------------------------------------------------- allocate(pair_index(basis%nspec, basis%nspec), source = 0) do is = 1, basis%nspec do js = 1, basis%nspec - pair_index(is, js) = gvector_container%get_pair_index( & - basis%spec(is)%name, basis%spec(js)%name ) + pair_index(is, js) = distribs_container%get_pair_index( & + basis%spec(is)%name, basis%spec(js)%name & + ) end do end do @@ -87,9 +90,6 @@ function evaluate_point( gvector_container, & neighbour_basis%lat = basis%lat num_2body = 0 species_loop: do is = 1, basis%nspec - ! 2-body map - ! check bondlength between test point and all other atoms - !------------------------------------------------------------------------ allocate(neighbour_basis%spec(is)%atom( & basis%spec(is)%num+basis%image_spec(is)%num, & size(basis%spec(is)%atom,2) & @@ -100,6 +100,10 @@ function evaluate_point( gvector_container, & ) ) neighbour_basis%spec(is)%num = 0 neighbour_basis%image_spec(is)%num = 0 + !------------------------------------------------------------------------ + ! 2-body map + ! check bondlength between test point and all other atoms + !------------------------------------------------------------------------ atom_loop: do ia = 1, basis%spec(is)%num ! Check if the atom is in the ignore list ! If it is, skip the atom. @@ -108,18 +112,18 @@ function evaluate_point( gvector_container, & end do associate( position_store => [ basis%spec(is)%atom(ia,1:3) ] ) bondlength = modu( matmul(position - position_store, basis%lat) ) - if( bondlength .gt. gvector_container%cutoff_max(1) ) & + if( bondlength .gt. distribs_container%cutoff_max(1) ) & cycle atom_loop if( bondlength .lt. ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(1) ) & + distribs_container%radius_distance_tol(1) ) & )then ! If the bond length is less than the minimum allowed bond, ! return 0 (i.e. the point is not viable). return elseif( bondlength .le. ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(2) ) & + distribs_container%radius_distance_tol(2) ) & )then ! If the bond length is within the tolerance of the covalent ! radius of the pair, add the atom to the list of @@ -132,13 +136,13 @@ function evaluate_point( gvector_container, & if( bondlength .ge. ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(3) & + distribs_container%radius_distance_tol(3) & ) .and. & bondlength .le. min( & - gvector_container%cutoff_max(1), & + distribs_container%cutoff_max(1), & ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(4) & + distribs_container%radius_distance_tol(4) & ) & ) & )then @@ -151,32 +155,35 @@ function evaluate_point( gvector_container, & ) = matmul(position_store, basis%lat) end if - ! Add the contribution of the bond length to the viability map. + !------------------------------------------------------------------ + ! Add the contribution of the bond length to the viability + !------------------------------------------------------------------ viability_2body = viability_2body + & - gvector_container%total%df_2body( & - gvector_container%get_bin(bondlength, dim = 1), & - pair_index(species,is) & - ) + evaluate_2body_contributions( & + distribs_container, bondlength, pair_index(species,is) & + ) num_2body = num_2body + 1 end associate end do atom_loop + !------------------------------------------------------------------------ ! Repeat the process for the image atoms. ! i.e. atoms that are not in the unit cell but are within the cutoff ! distance. + !------------------------------------------------------------------------ image_loop: do ia = 1, basis%image_spec(is)%num, 1 associate( position_store => [ basis%image_spec(is)%atom(ia,1:3) ] ) bondlength = modu( matmul(position - position_store, basis%lat) ) - if( bondlength .gt. gvector_container%cutoff_max(1) ) & + if( bondlength .gt. distribs_container%cutoff_max(1) ) & cycle image_loop if( bondlength .lt. ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(1) ) & + distribs_container%radius_distance_tol(1) ) & )then return elseif( bondlength .le. ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(2) ) & + distribs_container%radius_distance_tol(2) ) & )then neighbour_basis%spec(is)%num = neighbour_basis%spec(is)%num + 1 neighbour_basis%spec(is)%atom( & @@ -186,13 +193,13 @@ function evaluate_point( gvector_container, & if( bondlength .ge. ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(3) & + distribs_container%radius_distance_tol(3) & ) .and. & bondlength .le. min( & - gvector_container%cutoff_max(1), & + distribs_container%cutoff_max(1), & ( & radius_list(pair_index(species,is)) * & - gvector_container%radius_distance_tol(4) & + distribs_container%radius_distance_tol(4) & ) & ) & )then @@ -203,24 +210,30 @@ function evaluate_point( gvector_container, & ) = matmul(position_store, basis%lat) end if + !------------------------------------------------------------------ + ! Add the contribution of the bond length to the viability + !------------------------------------------------------------------ viability_2body = viability_2body + & - gvector_container%total%df_2body( & - gvector_container%get_bin(bondlength, dim = 1), & - pair_index(species,is) & + evaluate_2body_contributions( & + distribs_container, bondlength, pair_index(species,is) & ) num_2body = num_2body + 1 end associate end do image_loop end do species_loop neighbour_basis%natom = sum(neighbour_basis%spec(:)%num) - ! Normalise the viability map + + + !--------------------------------------------------------------------------- + ! Normalise the bond length viability + !--------------------------------------------------------------------------- if(num_2body.eq.0)then ! This does not matter as, if there are no 2-body bonds, the point is ! not meant to be included in the viability set. ! The evaluator cannot comment on the viability of the point. - viability_2body = 0.5_real12 + viability_2body = 0.5_real32 else - viability_2body = viability_2body / real( num_2body, real12 ) + viability_2body = viability_2body / real( num_2body, real32 ) end if @@ -232,10 +245,11 @@ function evaluate_point( gvector_container, & ! and neighbour_basis%image_spec for the third atom num_3body = 0 num_4body = 0 - viability_3body = 1._real12 - viability_4body = 1._real12 + viability_3body = 1._real32 + viability_4body = 1._real32 do is = 1, neighbour_basis%nspec do ia = 1, neighbour_basis%spec(is)%num + !--------------------------------------------------------------------- ! 3-body map ! check bondangle between test point and all other atoms !--------------------------------------------------------------------- @@ -245,7 +259,7 @@ function evaluate_point( gvector_container, & ) num_3body = num_3body + 1 viability_3body = viability_3body * & - evaluate_3body_contributions( gvector_container, & + evaluate_3body_contributions( distribs_container, & position_1, & position_2, & neighbour_basis, species, [is, ia], num_3body & @@ -255,12 +269,13 @@ function evaluate_point( gvector_container, & if(js.eq.is .and. ja.le.ia) cycle if(all(neighbour_basis%image_spec(:)%num.eq.0))cycle num_4body = num_4body + 1 + !------------------------------------------------------------ ! 4-body map ! check improperdihedral angle between test point and all ! other atoms !------------------------------------------------------------ viability_4body = viability_4body * & - evaluate_4body_contributions( gvector_container, & + evaluate_4body_contributions( distribs_container, & position_1, & position_2, & [neighbour_basis%spec(js)%atom(ja,1:3)], & @@ -271,23 +286,30 @@ function evaluate_point( gvector_container, & end associate end do end do - ! Normalise the viability map + + + !--------------------------------------------------------------------------- + ! Normalise the angular viabilities + !--------------------------------------------------------------------------- if(num_3body.eq.0)then - viability_3body = gvector_container%viability_3body_default + viability_3body = distribs_container%viability_3body_default else viability_3body = viability_3body ** ( & - 1._real12 / real(num_3body,real12) & + 1._real32 / real(num_3body,real32) & ) end if if(num_4body.eq.0)then - viability_4body = gvector_container%viability_4body_default + viability_4body = distribs_container%viability_4body_default else viability_4body = viability_4body ** ( & - 1._real12 / real(num_4body,real12) & + 1._real32 / real(num_4body,real32) & ) end if - - ! Combine the 2-, 3- and 4-body maps + + + !--------------------------------------------------------------------------- + ! Combine the 2-, 3- and 4-body viabilities to get the overall viability + !--------------------------------------------------------------------------- output = viability_2body * viability_3body * viability_4body end function evaluate_point @@ -295,16 +317,43 @@ end function evaluate_point !############################################################################### - function evaluate_3body_contributions( gvector_container, & + function evaluate_2body_contributions( distribs_container, & + bondlength, pair_index & + ) result(output) + !! Return the contribution to the viability from 2-body interactions + implicit none + + ! Arguments + type(distribs_container_type), intent(in) :: distribs_container + !! Distribution function (gvector) container. + real(real32), intent(in) :: bondlength + !! Bond length. + integer, intent(in) :: pair_index + !! Index of the element pair. + real(real32) :: output + !! Contribution to the viability. + + + output = distribs_container%gdf%df_2body( & + distribs_container%get_bin(bondlength, dim = 1), & + pair_index & + ) + + end function evaluate_2body_contributions +!############################################################################### + + +!############################################################################### + function evaluate_3body_contributions( distribs_container, & position_1, position_2, basis, species, current_idx, num_3body & ) result(output) - !! Return the contribution to the viability map from 3-body interactions + !! Return the contribution to the viability from 3-body interactions implicit none ! Arguments - type(gvector_container_type), intent(in) :: gvector_container + type(distribs_container_type), intent(in) :: distribs_container !! Distribution function (gvector) container. - real(real12), dimension(3), intent(in) :: position_1, position_2 + real(real32), dimension(3), intent(in) :: position_1, position_2 !! Positions of the atoms. type(extended_basis_type), intent(in) :: basis !! Basis of the system. @@ -314,8 +363,8 @@ function evaluate_3body_contributions( gvector_container, & !! Index of the 1st-atom query element. integer, intent(inout) :: num_3body !! Number of 3-body interactions. - real(real12) :: output - !! Contribution to the viability map. + real(real32) :: output + !! Contribution to the viability. ! Local variables integer :: js, ja @@ -326,35 +375,28 @@ function evaluate_3body_contributions( gvector_container, & !! Number of 3-body interactions local to the current atom pair. - output = 1._real12 + output = 1._real32 num_3body_local = sum(basis%spec(current_idx(1):)%num) - current_idx(2) species_loop: do js = current_idx(1), basis%nspec, 1 atom_loop: do ja = 1, basis%spec(js)%num if(js.eq.current_idx(1) .and. ja.le.current_idx(2))cycle associate( position_store => [ basis%spec(js)%atom(ja,1:3) ] ) - bin = gvector_container%get_bin( & + bin = distribs_container%get_bin( & get_angle( position_2, & position_1, & position_store ), & dim = 2 & ) - !!! THIS IS A TEMPORARY CHECK - !!! IF IT IS NEVER ENCOUNTERED, WE CAN REMOVE IT - !!! AND WHEN REMOVING, WE CAN MAKE ALL PROCEDURES HERE PURE - if(bin.eq.0)then - write(0,*) "Error: bin = 0, IF NOT TRIGGERED, WE CAN REMOVE THIS IF" - stop 1 - end if output = output * & - gvector_container%total%df_3body( & + distribs_container%gdf%df_3body( & bin, & - gvector_container%host_system%element_map(species) & - ) ** ( 1._real12 / real( num_3body_local, real12 ) ) + distribs_container%host_system%element_map(species) & + ) ** ( 1._real32 / real( num_3body_local, real32 ) ) end associate end do atom_loop end do species_loop if(num_3body_local.eq.0)then - output = 1._real12 + output = 1._real32 num_3body = num_3body - 1 end if @@ -363,22 +405,22 @@ end function evaluate_3body_contributions !############################################################################### - function evaluate_4body_contributions( gvector_container, & + function evaluate_4body_contributions( distribs_container, & position_1, position_2, position_3, basis, species ) result(output) - !! Return the contribution to the viability map from 4-body interactions + !! Return the contribution to the viability from 4-body interactions implicit none ! Arguments - type(gvector_container_type), intent(in) :: gvector_container + type(distribs_container_type), intent(in) :: distribs_container !! Distribution function (gvector) container. - real(real12), dimension(3), intent(in) :: position_1, position_2, position_3 + real(real32), dimension(3), intent(in) :: position_1, position_2, position_3 !! Positions of the atoms. type(extended_basis_type), intent(in) :: basis !! Basis of the system. integer, intent(in) :: species !! Index of the query element. - real(real12) :: output - !! Contribution to the viability map. + real(real32) :: output + !! Contribution to the viability. ! Local variables integer :: ks, ka @@ -389,13 +431,13 @@ function evaluate_4body_contributions( gvector_container, & !! Number of 4-body interactions local to the current atom triplet. - output = 1._real12 + output = 1._real32 num_4body_local = sum(basis%image_spec(:)%num) if(num_4body_local.eq.0) return species_loop: do ks = 1, basis%nspec, 1 atom_loop: do ka = 1, basis%image_spec(ks)%num associate( position_store => [ basis%image_spec(ks)%atom(ka,1:3) ] ) - bin = gvector_container%get_bin( & + bin = distribs_container%get_bin( & get_improper_dihedral_angle( & position_1, & position_2, & @@ -404,18 +446,11 @@ function evaluate_4body_contributions( gvector_container, & ), & dim = 3 & ) - !!! THIS IS A TEMPORARY CHECK - !!! IF IT IS NEVER ENCOUNTERED, WE CAN REMOVE IT - !!! AND WHEN REMOVING, WE CAN MAKE ALL PROCEDURES HERE PURE - if(bin.eq.0)then - write(0,*) "Error: bin = 0, IF NOT TRIGGERED, WE CAN REMOVE THIS IF" - stop 1 - end if output = output * & - gvector_container%total%df_4body( & + distribs_container%gdf%df_4body( & bin, & - gvector_container%host_system%element_map(species) & - ) ** ( 1._real12 / real( num_4body_local, real12 ) ) + distribs_container%host_system%element_map(species) & + ) ** ( 1._real32 / real( num_4body_local, real32 ) ) end associate end do atom_loop end do species_loop @@ -423,4 +458,4 @@ function evaluate_4body_contributions( gvector_container, & end function evaluate_4body_contributions !############################################################################### -end module evaluator \ No newline at end of file +end module raffle__evaluator \ No newline at end of file diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index ccf07054..44997e58 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1,25 +1,25 @@ -module generator +module raffle__generator !! Module for generating random structures from host structures. !! !! This module contains the raffle generator type, which is used to generate !! random structures from a host structure. The raffle generator uses !! distribution functions to determine the placement of atoms in the !! provided host structure. - use error_handling, only: stop_program - use constants, only: real12 - use misc_linalg, only: modu - use misc_raffle, only: strip_null, set - use rw_geom, only: basis_type - use extended_geom, only: extended_basis_type - use evolver, only: gvector_container_type - - use constants, only: verbose_global => verbose - use misc_raffle, only: shuffle - use edit_geom, only: basis_merge - use add_atom, only: & - add_atom_void, add_atom_rand, & - add_atom_growth, add_atom_walk, & - add_atom_min, & + use raffle__io_utils, only: stop_program + use raffle__constants, only: real32 + use raffle__misc_linalg, only: modu + use raffle__misc, only: strip_null, set + use raffle__geom_rw, only: basis_type + use raffle__geom_extd, only: extended_basis_type + use raffle__distribs_container, only: distribs_container_type + + use raffle__misc, only: shuffle + use raffle__geom_utils, only: basis_merge + use raffle__place_methods, only: & + place_method_void, place_method_rand, & + place_method_growth, place_method_walk, & + place_method_min + use raffle__viability, only: & get_gridpoints_and_viability, update_gridpoints_and_viability #ifdef ENABLE_ATHENA @@ -55,16 +55,20 @@ module generator !! Host structure. integer, dimension(3) :: grid = [0, 0, 0] !! Grid to divide the host structure into along each axis. - real(real12), dimension(3) :: & - grid_offset = [0.5_real12, 0.5_real12, 0.5_real12] + real(real32), dimension(3) :: & + grid_offset = [0.5_real32, 0.5_real32, 0.5_real32] !! Offset of the gridpoints. - real(real12) :: grid_spacing = 0.1_real12 + real(real32) :: grid_spacing = 0.1_real32 !! Spacing of the gridpoints. - type(gvector_container_type) :: distributions + type(distribs_container_type) :: distributions !! Distribution function container for the 2-, 3-, and 4-body interactions. integer :: max_attempts = 10000 !! Limit for the number of attempts to place an atom. - real(real12), dimension(5) :: method_probab + real(real32) :: & + walk_step_size_coarse = 1._real32, & + walk_step_size_fine = 0.1_real32 + !! Step size for the walk and grow methods. + real(real32), dimension(5) :: method_probab !! Probability of each placement method. type(basis_type), dimension(:), allocatable :: structures !! Generated structures. @@ -91,10 +95,10 @@ module function init_raffle_generator( & host, & width, sigma, cutoff_min, cutoff_max) result(generator) type(basis_type), intent(in), optional :: host - real(real12), dimension(3), intent(in), optional :: width - real(real12), dimension(3), intent(in), optional :: sigma - real(real12), dimension(3), intent(in), optional :: cutoff_min - real(real12), dimension(3), intent(in), optional :: cutoff_max + real(real32), dimension(3), intent(in), optional :: width + real(real32), dimension(3), intent(in), optional :: sigma + real(real32), dimension(3), intent(in), optional :: cutoff_min + real(real32), dimension(3), intent(in), optional :: cutoff_max type(raffle_generator_type) :: generator end function init_raffle_generator end interface raffle_generator_type @@ -107,21 +111,22 @@ module function init_raffle_generator( & host, width, sigma, cutoff_min, cutoff_max ) & result(generator) !! Initialise an instance of the raffle generator. + !! !! Set up run-independent parameters. implicit none ! Arguments type(basis_type), intent(in), optional :: host !! Basis of the host structure. - real(real12), dimension(3), intent(in), optional :: width + real(real32), dimension(3), intent(in), optional :: width !! Width of the gaussians used in the 2-, 3-, and 4-body !! distribution functions. - real(real12), dimension(3), intent(in), optional :: sigma + real(real32), dimension(3), intent(in), optional :: sigma !! Width of the gaussians used in the 2-, 3-, and 4-body !! distribution functions. - real(real12), dimension(3), intent(in), optional :: cutoff_min + real(real32), dimension(3), intent(in), optional :: cutoff_min !! Minimum cutoff for the 2-, 3-, and 4-body distribution functions. - real(real12), dimension(3), intent(in), optional :: cutoff_max + real(real32), dimension(3), intent(in), optional :: cutoff_max !! Maximum cutoff for the 2-, 3-, and 4-body distribution functions. ! Local variables @@ -149,6 +154,8 @@ end function init_raffle_generator !############################################################################### subroutine set_host(this, host) !! Set the host structure. + !! + !! This procedure sets the host structure for the raffle generator. implicit none ! Arguments @@ -176,6 +183,10 @@ end subroutine set_host !############################################################################### subroutine set_grid(this, grid, grid_spacing, grid_offset) !! Set the grid for the raffle generator. + !! + !! This procedure sets the grid for the raffle generator. The grid is used + !! to divide the host structure into bins along each axis on which + !! atom placement viability will be evaluated implicit none ! Arguments @@ -183,9 +194,9 @@ subroutine set_grid(this, grid, grid_spacing, grid_offset) !! Instance of the raffle generator. integer, dimension(3), intent(in), optional :: grid !! Number of bins to divide the host structure into along each axis. - real(real12), intent(in), optional :: grid_spacing + real(real32), intent(in), optional :: grid_spacing !! Spacing of the bins. - real(real12), dimension(3), intent(in), optional :: grid_offset + real(real32), dimension(3), intent(in), optional :: grid_offset !! Offset of the gridpoints. ! Local variables @@ -236,6 +247,11 @@ end subroutine reset_grid subroutine generate(this, num_structures, & stoichiometry, method_probab, seed, verbose) !! Generate random structures. + !! + !! This procedure generates random structures from the contained host + !! structure and the stoichiometry argument. The number of structures to + !! generate is specified by the num_structures argument. + !! The ratio of placement methods to be sampled is defined by method_probab. implicit none ! Arguments @@ -245,7 +261,7 @@ subroutine generate(this, num_structures, & !! Number of structures to generate. type(stoichiometry_type), dimension(:), intent(in) :: stoichiometry !! Stoichiometry of the structures to generate. - real(real12), dimension(5), intent(in), optional :: method_probab + real(real32), dimension(5), intent(in), optional :: method_probab !! Probability of each placement method. integer, intent(in), optional :: seed !! Seed for the random number generator. @@ -259,7 +275,7 @@ subroutine generate(this, num_structures, & !! Number of seeds for the random number generator. integer :: num_insert_atoms, num_insert_species !! Number of atoms and species to insert (from stoichiometry). - real(real12) :: total_probab + real(real32) :: total_probab !! Total probability of the placement methods. logical :: success !! Boolean comparison of element symbols. @@ -267,9 +283,9 @@ subroutine generate(this, num_structures, & !! Verbosity level. type(basis_type) :: basis_template !! Basis of the structure to generate (i.e. allocated species and atoms). - real(real12), dimension(5) :: & + real(real32), dimension(5) :: & method_probab_ = & - [1.0_real12, 0.1_real12, 0.5_real12, 0.5_real12, 1.0_real12] + [1.0_real32, 0.1_real32, 0.5_real32, 0.5_real32, 1.0_real32] !! Default probability of each placement method. integer, dimension(:), allocatable :: seed_arr @@ -294,7 +310,7 @@ subroutine generate(this, num_structures, & !--------------------------------------------------------------------------- if(verbose_.gt.0) write(*,*) "Setting method probabilities" if(present(method_probab)) method_probab_ = method_probab - total_probab = real(sum(method_probab_), real12) + total_probab = real(sum(method_probab_), real32) method_probab_ = method_probab_ / total_probab do i = 2, 5, 1 method_probab_(i) = method_probab_(i) + method_probab_(i-1) @@ -350,7 +366,7 @@ subroutine generate(this, num_structures, & do i = 1, basis_template%nspec allocate( & basis_template%spec(i)%atom(basis_template%spec(i)%num,3), & - source = 0._real12 & + source = 0._real32 & ) end do if(.not.allocated(this%host%spec))then @@ -361,6 +377,14 @@ subroutine generate(this, num_structures, & basis_template%lat = this%host%lat + !--------------------------------------------------------------------------- + ! ensure host element map is set + !--------------------------------------------------------------------------- + call this%distributions%host_system%set_element_map( & + this%distributions%element_info & + ) + + !--------------------------------------------------------------------------- ! generate the placement list ! placement list is the list of number of atoms of each species that can be @@ -431,8 +455,15 @@ end subroutine generate module function generate_structure( & this, & basis_initial, & - placement_list, method_probab, verbose ) result(basis) + placement_list, method_probab, verbose & + ) result(basis) !! Generate a single random structure. + !! + !! This function generates a single random structure from a host structure + !! by placing atoms according to the ratio of placement methods. + !! The input host structure will already have all host and insert species + !! and atoms allocated. The placement list specifies the atoms in the + !! host structure to be replaced by insert atoms. implicit none ! Arguments @@ -442,7 +473,7 @@ module function generate_structure( & !! Initial basis to build upon. integer, dimension(:,:), intent(in) :: placement_list !! List of possible placements. - real(real12), dimension(5) :: method_probab + real(real32), dimension(5) :: method_probab !! Probability of each placement method. type(extended_basis_type) :: basis !! Generated basis. @@ -454,22 +485,22 @@ module function generate_structure( & !! Loop counters. integer :: num_insert_atoms !! Number of atoms to insert. - real(real12) :: rtmp1 + real(real32) :: rtmp1 !! Random number. logical :: viable !! Boolean for viable placement. integer, dimension(size(placement_list,1),size(placement_list,2)) :: & placement_list_shuffled !! Shuffled placement list. - real(real12), dimension(3) :: point + real(real32), dimension(3) :: point !! Coordinate of the atom to place. - real(real12), dimension(5) :: method_probab_ + real(real32), dimension(5) :: method_probab_ !! Temporary probability of each placement method. !! This is used to update the probability of the global minimum method if !! no viable gridpoints are found. integer, dimension(:), allocatable :: species_index_list !! List of species indices to add. - real(real12), dimension(:,:), allocatable :: gridpoint_viability + real(real32), dimension(:,:), allocatable :: gridpoint_viability !! Viable gridpoints for placing atoms. character(len=256) :: stop_msg !! Error message. @@ -491,9 +522,7 @@ module function generate_structure( & !--------------------------------------------------------------------------- placement_list_shuffled = placement_list call shuffle(placement_list_shuffled,1) - !! @note - !! NEED TO SORT OUT RANDOM SEED - !! @endnote + !--------------------------------------------------------------------------- ! generate species index list to add @@ -520,12 +549,15 @@ module function generate_structure( & !--------------------------------------------------------------------------- - ! place the atoms + ! place the atoms according to the method probabilities !--------------------------------------------------------------------------- iplaced = 0 void_ticker = 0 viable = .false. placement_loop: do while (iplaced.lt.num_insert_atoms) + !------------------------------------------------------------------------ + ! check if there are any viable gridpoints remaining + !------------------------------------------------------------------------ if(viable)then if(allocated(gridpoint_viability)) & call update_gridpoints_and_viability( & @@ -554,10 +586,14 @@ module function generate_structure( & end if end if viable = .false. + !------------------------------------------------------------------------ + ! choose a placement method + ! call a random number and query the method probabilities + !------------------------------------------------------------------------ call random_number(rtmp1) if(rtmp1.le.method_probab_(1)) then if(verbose.gt.0) write(*,*) "Add Atom Void" - point = add_atom_void( this%grid, & + point = place_method_void( this%grid, & this%grid_offset, & basis, & placement_list_shuffled(iplaced+1:,:), viable & @@ -565,7 +601,8 @@ module function generate_structure( & else if(rtmp1.le.method_probab_(2)) then if(verbose.gt.0) write(*,*) "Add Atom Random" - point = add_atom_rand( & + point = place_method_rand( & + this%distributions, & basis, & placement_list_shuffled(iplaced+1:,:), & [ this%distributions%bond_info(:)%radius_covalent ], & @@ -573,22 +610,23 @@ module function generate_structure( & viable & ) if(.not. viable) cycle placement_loop - else if(rtmp1.le.method_probab_(3)) then if(verbose.gt.0) write(*,*) "Add Atom Walk" - point = add_atom_walk( & + point = place_method_walk( & this%distributions, & basis, & placement_list_shuffled(iplaced+1:,:), & [ this%distributions%bond_info(:)%radius_covalent ], & this%max_attempts, & + this%walk_step_size_coarse, this%walk_step_size_fine, & viable & ) if(.not. viable) void_ticker = void_ticker + 1 else if(rtmp1.le.method_probab_(4)) then if(iplaced.eq.0)then if(verbose.gt.0) write(*,*) "Add Atom Random (growth seed)" - point = add_atom_rand( & + point = place_method_rand( & + this%distributions, & basis, & placement_list_shuffled(iplaced+1:,:), & [ this%distributions%bond_info(:)%radius_covalent ], & @@ -597,7 +635,7 @@ module function generate_structure( & ) else if(verbose.gt.0) write(*,*) "Add Atom Growth" - point = add_atom_growth( & + point = place_method_growth( & this%distributions, & basis%spec(placement_list_shuffled(iplaced,1))%atom( & placement_list_shuffled(iplaced,2),:3 & @@ -607,13 +645,14 @@ module function generate_structure( & placement_list_shuffled(iplaced+1:,:), & [ this%distributions%bond_info(:)%radius_covalent ], & this%max_attempts, & + this%walk_step_size_coarse, this%walk_step_size_fine, & viable & ) end if if(.not. viable) void_ticker = void_ticker + 1 else if(rtmp1.le.method_probab_(5)) then if(verbose.gt.0) write(*,*) "Add Atom Minimum" - point = add_atom_min( gridpoint_viability, & + point = place_method_min( gridpoint_viability, & placement_list_shuffled(iplaced+1,1), & species_index_list, & viable & @@ -637,13 +676,20 @@ module function generate_structure( & method_probab_(5) = method_probab_(4) end if end if + !------------------------------------------------------------------------ + ! check if the placement method returned a viable point + ! if not, cycle the loop + !------------------------------------------------------------------------ if(.not. viable) then if(void_ticker.gt.10) & - point = add_atom_void( this%grid, this%grid_offset, basis, & + point = place_method_void( this%grid, this%grid_offset, basis, & placement_list_shuffled(iplaced+1:,:), viable) void_ticker = 0 if(.not.viable) cycle placement_loop end if + !------------------------------------------------------------------------ + ! place the atom and update the image atoms in the basis + !------------------------------------------------------------------------ iplaced = iplaced + 1 basis%spec(placement_list_shuffled(iplaced,1))%atom( & placement_list_shuffled(iplaced,2),:3) = point(:3) @@ -688,11 +734,12 @@ function evaluate(this, basis) result(viability) !! Instance of the raffle generator. type(basis_type), intent(in) :: basis !! Basis of the structure to evaluate. - real(real12) :: viability + real(real32) :: viability !! Viability of the generated structures. - viability = 0.0_real12 - stop "Not yet set up" + viability = 0.0_real32 + call stop_program("Evaluate procedure not yet set up") + return end function evaluate !############################################################################### @@ -713,4 +760,4 @@ subroutine allocate_structures(this, num_structures) end subroutine allocate_structures !############################################################################### -end module generator \ No newline at end of file +end module raffle__generator \ No newline at end of file diff --git a/src/fortran/lib/mod_extended_geom.f90 b/src/fortran/lib/mod_geom_extd.f90 similarity index 86% rename from src/fortran/lib/mod_extended_geom.f90 rename to src/fortran/lib/mod_geom_extd.f90 index cf34da2e..e96e7e44 100644 --- a/src/fortran/lib/mod_extended_geom.f90 +++ b/src/fortran/lib/mod_geom_extd.f90 @@ -1,12 +1,12 @@ -module extended_geom +module raffle__geom_extd !! Module to extend the basis set to include images of atoms. !! !! This module is designed to extend the basis set to include images of atoms !! within a specified distance of the unit cell. This is useful for !! calculating interactions between atoms that are not within the unit cell. - use constants, only: real12, pi - use misc_linalg, only: modu, cross, inverse_3x3 - use rw_geom, only: basis_type, species_type + use raffle__constants, only: real32, pi + use raffle__misc_linalg, only: modu, cross, inverse_3x3 + use raffle__geom_rw, only: basis_type, species_type implicit none @@ -17,7 +17,7 @@ module extended_geom type, extends(basis_type) :: extended_basis_type !! Extended basis set type - real(real12) :: max_extension + real(real32) :: max_extension !! Maximum distance to extend the basis set integer :: num_images !! Number of images in the extended basis set @@ -40,7 +40,7 @@ subroutine create_images(this, max_bondlength, atom_ignore_list) ! Arguments class(extended_basis_type), intent(inout) :: this !! Parent of the procedure. Instance of the extended basis. - real(real12), intent(in) :: max_bondlength + real(real32), intent(in) :: max_bondlength !! Maximum distance to extend the basis set. integer, dimension(:,:), intent(in), optional :: atom_ignore_list !! List of atoms to ignore when creating images. @@ -50,7 +50,7 @@ subroutine create_images(this, max_bondlength, atom_ignore_list) !! Loop indices. integer :: amax, bmax, cmax !! Maximum number of lattice vectors to consider. - real(real12), dimension(3) :: vtmp1 + real(real32), dimension(3) :: vtmp1 !! Temporary vector for storing atom positions. type(species_type), dimension(this%nspec) :: image_species !! Temporary store for the images. @@ -94,12 +94,12 @@ subroutine create_images(this, max_bondlength, atom_ignore_list) if(all(atom_ignore_list_(i,:).eq.[is,ia])) cycle atom_loop end do do i=-amax,amax+1,1 - vtmp1(1) = this%spec(is)%atom(ia,1) + real(i, real12) + vtmp1(1) = this%spec(is)%atom(ia,1) + real(i, real32) do j=-bmax,bmax+1,1 - vtmp1(2) = this%spec(is)%atom(ia,2) + real(j, real12) + vtmp1(2) = this%spec(is)%atom(ia,2) + real(j, real32) do k=-cmax,cmax+1,1 if( i .eq. 0 .and. j .eq. 0 .and. k .eq. 0 ) cycle - vtmp1(3) = this%spec(is)%atom(ia,3) + real(k, real12) + vtmp1(3) = this%spec(is)%atom(ia,3) + real(k, real32) if( get_distance_from_unit_cell(vtmp1, this%lat) .le. & max_bondlength ) then ! add the image to the list @@ -143,7 +143,7 @@ subroutine update_images(this, max_bondlength, is, ia) ! Arguments class(extended_basis_type), intent(inout) :: this !! Parent of the procedure. Instance of the extended basis. - real(real12), intent(in) :: max_bondlength + real(real32), intent(in) :: max_bondlength !! Maximum distance to extend the basis set. integer, intent(in) :: is, ia !! Species and atom index to update. @@ -156,7 +156,7 @@ subroutine update_images(this, max_bondlength, is, ia) !! Maximum number of lattice vectors to consider. type(species_type) :: image_species !! Temporary store for the images. - real(real12), dimension(3) :: vtmp1 + real(real32), dimension(3) :: vtmp1 !! Temporary vector for storing atom positions. @@ -186,12 +186,12 @@ subroutine update_images(this, max_bondlength, is, ia) do i=-amax,amax+1,1 - vtmp1(1) = this%spec(is)%atom(ia,1) + real(i, real12) + vtmp1(1) = this%spec(is)%atom(ia,1) + real(i, real32) do j=-bmax,bmax+1,1 - vtmp1(2) = this%spec(is)%atom(ia,2) + real(j, real12) + vtmp1(2) = this%spec(is)%atom(ia,2) + real(j, real32) do k=-cmax,cmax+1,1 if( i .eq. 0 .and. j .eq. 0 .and. k .eq. 0 ) cycle - vtmp1(3) = this%spec(is)%atom(ia,3) + real(k, real12) + vtmp1(3) = this%spec(is)%atom(ia,3) + real(k, real32) if( get_distance_from_unit_cell(vtmp1, this%lat) .le. & max_bondlength ) then ! add the image to the list @@ -227,33 +227,33 @@ function get_distance_from_unit_cell( & implicit none ! Arguments - real(real12), intent(in) :: point(3) + real(real32), intent(in) :: point(3) !! Query point. - real(real12), intent(in) :: lattice(3,3) + real(real32), intent(in) :: lattice(3,3) !! Lattice vectors. - real(real12), intent(out), optional :: closest_point(3) + real(real32), intent(out), optional :: closest_point(3) !! Closest point on the unit cell surface. logical, optional, intent(in) :: is_cartesian !! Boolean whether the point is in cartesian coordinates. - real(real12) :: distance + real(real32) :: distance !! Distance of the point from the unit cell. ! Local variables integer :: i, j, k !! Loop indices. - real(real12), dimension(3) :: point_ + real(real32), dimension(3) :: point_ !! Point in cartesian coordinates. - real(real12), dimension(3,3) :: inverse_lattice + real(real32), dimension(3,3) :: inverse_lattice !! Inverse of the lattice vectors. - real(real12), dimension(3) :: normal + real(real32), dimension(3) :: normal !! Normal vector to the plane. - real(real12), dimension(3) :: plane_point + real(real32), dimension(3) :: plane_point !! Point on the plane. - real(real12), dimension(3) :: projection, closest_point_ + real(real32), dimension(3) :: projection, closest_point_ !! Projection of the point onto the plane. - real(real12), dimension(3) :: inverse_projection + real(real32), dimension(3) :: inverse_projection !! Inverse projection of the point onto the plane. - real(real12) :: min_distance + real(real32) :: min_distance !! Minimum distance to the unit cell. logical :: is_outside !! Boolean whether the point is outside the unit cell. @@ -279,7 +279,7 @@ function get_distance_from_unit_cell( & point_ = matmul(point, lattice) end if - min_distance = huge(1._real12) + min_distance = huge(1._real32) ! get projection of point onto each face of the lattice ! get the length of the projection vector @@ -289,9 +289,9 @@ function get_distance_from_unit_cell( & ! distances face_loop: do i = 1, 3 index_list = cshift(index_list, 1) - plane_point = 0._real12 + plane_point = 0._real32 direction_loop: do j = 1, 2 - normal = (-1._real12)**j * cross( & + normal = (-1._real32)**j * cross( & [ lattice(index_list(2),:3) ], & [ lattice(index_list(3),:3) ] & ) @@ -300,7 +300,7 @@ function get_distance_from_unit_cell( & ! check if point minus projection is negative ! if so, it is on the wrong side of the plane and should be ignored - if( dot_product(point_ - projection, normal) .lt. 0._real12 )then + if( dot_product(point_ - projection, normal) .lt. 0._real32 )then plane_point = plane_point + lattice(index_list(1),:) cycle direction_loop end if @@ -309,17 +309,17 @@ function get_distance_from_unit_cell( & ! check if projection is outside the surface inverse_projection = matmul(projection, inverse_lattice) - if( any( inverse_projection .lt. 0._real12 ) .or. & - any( inverse_projection .gt. 1._real12 ) ) then + if( any( inverse_projection .lt. 0._real32 ) .or. & + any( inverse_projection .gt. 1._real32 ) ) then ! projection is outside the surface ! check if the projection is outside the edges ! if it is, then the closest point is the edge or corner ! if it is not, then the closest point is the projection do k = 1, 3 - if( inverse_projection(k) .lt. 0._real12 ) then - inverse_projection(k) = 0._real12 - else if( inverse_projection(k) .gt. 1._real12 ) then - inverse_projection(k) = 1._real12 + if( inverse_projection(k) .lt. 0._real32 ) then + inverse_projection(k) = 0._real32 + else if( inverse_projection(k) .gt. 1._real32 ) then + inverse_projection(k) = 1._real32 end if end do end if @@ -338,7 +338,7 @@ function get_distance_from_unit_cell( & if( is_outside ) then distance = min_distance else - distance = 0._real12 + distance = 0._real32 end if if( present(closest_point) ) then @@ -359,19 +359,19 @@ function project_point_onto_plane(point, plane_point, normal) result(output) implicit none ! Arguments - real(real12), dimension(3), intent(in) :: point + real(real32), dimension(3), intent(in) :: point !! Point to project. - real(real12), dimension(3), intent(in) :: plane_point + real(real32), dimension(3), intent(in) :: plane_point !! Point on the plane. - real(real12), dimension(3), intent(in) :: normal + real(real32), dimension(3), intent(in) :: normal !! Normal vector to the plane. - real(real12), dimension(3) :: output + real(real32), dimension(3) :: output !! Projected point. ! Local variables - real(real12) :: distance + real(real32) :: distance !! Distance of the point from the plane. - real(real12), dimension(3) :: vector_to_plane + real(real32), dimension(3) :: vector_to_plane !! Vector from the point to the plane. vector_to_plane = point - plane_point @@ -383,4 +383,4 @@ function project_point_onto_plane(point, plane_point, normal) result(output) end function project_point_onto_plane !############################################################################### -end module extended_geom \ No newline at end of file +end module raffle__geom_extd \ No newline at end of file diff --git a/src/fortran/lib/mod_rw_geom.f90 b/src/fortran/lib/mod_geom_rw.f90 similarity index 82% rename from src/fortran/lib/mod_rw_geom.f90 rename to src/fortran/lib/mod_geom_rw.f90 index 0382bd17..34ba60c0 100644 --- a/src/fortran/lib/mod_rw_geom.f90 +++ b/src/fortran/lib/mod_geom_rw.f90 @@ -1,11 +1,11 @@ -module rw_geom +module raffle__geom_rw !! Module to store, read and write geometry files !! !! This module contains the procedures to read and write geometry files. !! It also contains the derived types used to store the geometry data. - use constants, only: pi,real12 - use misc_raffle, only: to_upper, to_lower, jump, icount - use misc_linalg, only: modu, inverse_3x3 + use raffle__constants, only: pi,real32 + use raffle__misc, only: to_upper, to_lower, jump, icount + use raffle__misc_linalg, only: modu, inverse_3x3 implicit none @@ -30,13 +30,13 @@ module rw_geom type species_type !! Derived type to store information about a species/element. - real(real12), allocatable ,dimension(:,:) :: atom + real(real32), allocatable ,dimension(:,:) :: atom !! The atomic positions of the species. - real(real12) :: mass + real(real32) :: mass !! The mass of the species. - real(real12) :: charge + real(real32) :: charge !! The charge of the species. - real(real12) :: radius + real(real32) :: radius !! The radius of the species. character(len=3) :: name !! The name of the species. @@ -51,9 +51,9 @@ module rw_geom !! The number of species in the basis. integer :: natom = 0 !! The number of atoms in the basis. - real(real12) :: energy = 0._real12 + real(real32) :: energy = 0._real32 !! The energy of the basis. - real(real12) :: lat(3,3) = 0._real12 + real(real32) :: lat(3,3) = 0._real32 !! The lattice vectors of the basis. logical :: lcart = .false. !! Boolean whether the basis is in cartesian coordinates. @@ -120,7 +120,7 @@ subroutine allocate_species( & !! Optional. The symbols of the species. integer, dimension(:), intent(in), optional :: species_count !! Optional. The number of atoms of each species. - real(real12), dimension(:,:), intent(in), optional :: atoms + real(real32), dimension(:,:), intent(in), optional :: atoms !! Optional. The atomic positions of the species. ! Local variables @@ -214,7 +214,7 @@ subroutine geom_read(UNIT, basis, length, iostat) end if if(length_.eq.4)then do i=1,basis%nspec - basis%spec(i)%atom(:,4)=1._real12 + basis%spec(i)%atom(:,4)=1._real32 end do end if do i = 1, basis%nspec @@ -282,7 +282,7 @@ subroutine VASP_geom_read(UNIT, basis, length, iostat) !! The I/O status of the read. integer :: pos, count !! Temporary integer variables. - real(real12) :: scal + real(real32) :: scal !! The scaling factor of the lattice. character(len=100) :: lspec !! The species names and number of each atomic species. @@ -370,7 +370,7 @@ subroutine VASP_geom_read(UNIT, basis, length, iostat) !--------------------------------------------------------------------------- do i=1,basis%nspec allocate(basis%spec(i)%atom(basis%spec(i)%num,length_)) - basis%spec(i)%atom(:,:)=0._real12 + basis%spec(i)%atom(:,:)=0._real32 do j=1,basis%spec(i)%num read(UNIT,*) (basis%spec(i)%atom(j,k),k=1,3) end do @@ -430,7 +430,7 @@ subroutine VASP_geom_write(UNIT, basis, cartesian) end if write(UNIT,'(A)') trim(adjustl(basis%sysname)) - write(UNIT,'(F15.9)') 1._real12 + write(UNIT,'(F15.9)') 1._real32 do i=1,3 write(UNIT,'(3(F15.9))') basis%lat(i,:) end do @@ -471,7 +471,7 @@ subroutine QE_geom_read(UNIT,basis,length) !! The dimension of the basis atom positions. integer, dimension(1000) :: tmp_natom !! Temporary array to store the number of atoms of each species. - real(real12), dimension(3) :: tmpvec + real(real32), dimension(3) :: tmpvec !! Temporary array to store the atomic positions. character(len=3) :: ctmp !! Temporary character variable. @@ -678,7 +678,7 @@ subroutine CASTEP_geom_read(UNIT, basis, length) !! cartesian coordinates. integer, dimension(1000) :: tmp_natom !! Temporary array to store the number of atoms of each species. - real(real12), dimension(3) :: abc, angle, dvtmp1 + real(real32), dimension(3) :: abc, angle, dvtmp1 !! Temporary arrays to store the lattice vectors. character(len=3), dimension(1000) :: tmp_spec !! Temporary array to store the species names. @@ -834,7 +834,7 @@ subroutine CASTEP_geom_write(UNIT, basis, labc, cartesian) ! Local variables integer :: i, j !! Loop index. - real(real12), dimension(2,3) :: abc_angle + real(real32), dimension(2,3) :: abc_angle !! Temporary arrays to store the lattice vectors. character(4) :: string_lat, string_bas !! Strings specifying lattice and basis format @@ -907,9 +907,9 @@ subroutine XYZ_geom_read(UNIT, basis, length, iostat) !! Loop index. integer, allocatable, dimension(:) :: tmp_num !! Temporary array to store the number of atoms of each species. - real(real12), dimension(3) :: vec + real(real32), dimension(3) :: vec !! Temporary array to store the atomic positions. - real(real12), allocatable, dimension(:,:,:) :: tmp_bas + real(real32), allocatable, dimension(:,:,:) :: tmp_bas !! Temporary array to store the atomic positions. character(len=3) :: ctmp !! Temporary character variable. @@ -1037,9 +1037,9 @@ subroutine extXYZ_geom_read(UNIT, basis, length, iostat) !! Index variables. integer, allocatable, dimension(:) :: tmp_num !! Temporary array to store the number of atoms of each species. - real(real12), dimension(3) :: vec + real(real32), dimension(3) :: vec !! Temporary array to store the atomic positions. - real(real12), allocatable, dimension(:,:,:) :: tmp_bas + real(real32), allocatable, dimension(:,:,:) :: tmp_bas !! Temporary array to store the atomic positions. character(len=3) :: ctmp !! Temporary character variable. @@ -1189,7 +1189,7 @@ subroutine convert(this) ! Local variables integer :: is, ia !! Loop index. - real(real12), dimension(3,3) :: lattice + real(real32), dimension(3,3) :: lattice !! The reciprocal lattice vectors. @@ -1217,25 +1217,25 @@ function convert_abc_to_lat(abc,angle,radians) result(lattice) implicit none ! Arguments - real(real12), dimension(3), intent(in) :: abc, angle + real(real32), dimension(3), intent(in) :: abc, angle !! lattice constants logical, intent(in), optional :: radians !! Optional. Boolean whether angles are in radians. - real(real12), dimension(3,3) :: lattice + real(real32), dimension(3,3) :: lattice !! The lattice matrix. ! Local variables - real(real12), dimension(3) :: in_angle + real(real32), dimension(3) :: in_angle !! The lattice angles in radians. in_angle = angle if(present(radians))then - if(.not.radians) in_angle = angle*pi/180._real12 + if(.not.radians) in_angle = angle*pi/180._real32 end if - lattice=0._real12 + lattice=0._real32 lattice(1,1)=abc(1) lattice(2,:2)=(/abc(2)*cos(in_angle(3)),abc(2)*sin(in_angle(3))/) @@ -1243,9 +1243,9 @@ function convert_abc_to_lat(abc,angle,radians) result(lattice) lattice(3,1) = abc(3)*cos(in_angle(2)) lattice(3,2) = abc(3)*(cos(in_angle(1)) - cos(in_angle(2))*& cos(in_angle(3)))/sin(in_angle(3)) - lattice(3,3) = sqrt(abc(3)**2._real12 - & - lattice(3,1)**2._real12 - & - lattice(3,2)**2._real12) + lattice(3,3) = sqrt(abc(3)**2._real32 - & + lattice(3,1)**2._real32 - & + lattice(3,2)**2._real32) end function convert_abc_to_lat !############################################################################### @@ -1257,11 +1257,11 @@ function convert_lat_to_abc(lattice, radians) result(abc_angle) implicit none ! Arguments - real(real12), dimension(3,3), intent(in) :: lattice + real(real32), dimension(3,3), intent(in) :: lattice !! The lattice matrix. logical, intent(in), optional :: radians !! Optional. Boolean whether to return angles in radians. - real(real12), dimension(2,3) :: abc_angle + real(real32), dimension(2,3) :: abc_angle !! The lattice constants and angles. ! Local variables @@ -1282,7 +1282,7 @@ function convert_lat_to_abc(lattice, radians) result(abc_angle) (abc_angle(1,1)*abc_angle(1,2))) if(present(radians))then - if(.not.radians) abc_angle(2,:)=abc_angle(2,:)*180._real12/pi + if(.not.radians) abc_angle(2,:)=abc_angle(2,:)*180._real32/pi end if end function convert_lat_to_abc @@ -1299,7 +1299,7 @@ function get_lattice_constants(this, radians) result(output) !! Parent. The basis. logical, intent(in), optional :: radians !! Optional. Boolean whether to return angles in radians. - real(real12), dimension(2,3) :: output + real(real32), dimension(2,3) :: output !! The lattice constants and angles. ! Local variables @@ -1374,7 +1374,7 @@ subroutine copy(this, basis, length) this%spec(i)%atom(:,:3) = basis%spec(i)%atom(:,:3) elseif(length_input.lt.length_)then this%spec(i)%atom(:,:3) = basis%spec(i)%atom(:,:3) - this%spec(i)%atom(:,4) = 1._real12 + this%spec(i)%atom(:,4) = 1._real32 end if this%spec(i)%num = basis%spec(i)%num this%spec(i)%name = basis%spec(i)%name @@ -1404,495 +1404,495 @@ subroutine get_element_properties(element, charge, mass, radius) ! Arguments character(len=3), intent(in) :: element !! Element name. - real(real12), intent(out), optional :: charge + real(real32), intent(out), optional :: charge !! Charge of the element. - real(real12), intent(out), optional :: mass + real(real32), intent(out), optional :: mass !! Mass of the element. - real(real12), intent(out), optional :: radius + real(real32), intent(out), optional :: radius !! Radius of the element. ! Local variables - real(real12) :: mass_, charge_, radius_ + real(real32) :: mass_, charge_, radius_ !! Mass, charge and radius of the element. select case(element) case('H') - mass_ = 1.00784_real12 - charge_ = 1.0_real12 - radius_ = 0.31_real12 + mass_ = 1.00784_real32 + charge_ = 1.0_real32 + radius_ = 0.31_real32 case('He') - mass_ = 4.0026_real12 - charge_ = 2.0_real12 - radius_ = 0.28_real12 + mass_ = 4.0026_real32 + charge_ = 2.0_real32 + radius_ = 0.28_real32 case('Li') - mass_ = 6.94_real12 - charge_ = 3.0_real12 - radius_ = 1.28_real12 + mass_ = 6.94_real32 + charge_ = 3.0_real32 + radius_ = 1.28_real32 case('Be') - mass_ = 9.0122_real12 - charge_ = 4.0_real12 - radius_ = 0.96_real12 + mass_ = 9.0122_real32 + charge_ = 4.0_real32 + radius_ = 0.96_real32 case('B') - mass_ = 10.81_real12 - charge_ = 5.0_real12 - radius_ = 0.84_real12 + mass_ = 10.81_real32 + charge_ = 5.0_real32 + radius_ = 0.84_real32 case('C') - mass_ = 12.011_real12 - charge_ = 6.0_real12 - radius_ = 0.76_real12 + mass_ = 12.011_real32 + charge_ = 6.0_real32 + radius_ = 0.76_real32 case('N') - mass_ = 14.007_real12 - charge_ = 7.0_real12 - radius_ = 0.71_real12 + mass_ = 14.007_real32 + charge_ = 7.0_real32 + radius_ = 0.71_real32 case('O') - mass_ = 15.999_real12 - charge_ = 8.0_real12 - radius_ = 0.66_real12 + mass_ = 15.999_real32 + charge_ = 8.0_real32 + radius_ = 0.66_real32 case('F') - mass_ = 18.998_real12 - charge_ = 9.0_real12 - radius_ = 0.57_real12 + mass_ = 18.998_real32 + charge_ = 9.0_real32 + radius_ = 0.57_real32 case('Ne') - mass_ = 20.180_real12 - charge_ = 10.0_real12 - radius_ = 0.58_real12 + mass_ = 20.180_real32 + charge_ = 10.0_real32 + radius_ = 0.58_real32 case('Na') - mass_ = 22.989_real12 - charge_ = 11.0_real12 - radius_ = 1.66_real12 + mass_ = 22.989_real32 + charge_ = 11.0_real32 + radius_ = 1.66_real32 case('Mg') - mass_ = 24.305_real12 - charge_ = 12.0_real12 - radius_ = 1.41_real12 + mass_ = 24.305_real32 + charge_ = 12.0_real32 + radius_ = 1.41_real32 case('Al') - mass_ = 26.982_real12 - charge_ = 13.0_real12 - radius_ = 1.21_real12 + mass_ = 26.982_real32 + charge_ = 13.0_real32 + radius_ = 1.21_real32 case('Si') - mass_ = 28.085_real12 - charge_ = 14.0_real12 - radius_ = 1.11_real12 + mass_ = 28.085_real32 + charge_ = 14.0_real32 + radius_ = 1.11_real32 case('P') - mass_ = 30.974_real12 - charge_ = 15.0_real12 - radius_ = 1.07_real12 + mass_ = 30.974_real32 + charge_ = 15.0_real32 + radius_ = 1.07_real32 case('S') - mass_ = 32.06_real12 - charge_ = 16.0_real12 - radius_ = 1.05_real12 + mass_ = 32.06_real32 + charge_ = 16.0_real32 + radius_ = 1.05_real32 case('Cl') - mass_ = 35.453_real12 - charge_ = 17.0_real12 - radius_ = 1.02_real12 + mass_ = 35.453_real32 + charge_ = 17.0_real32 + radius_ = 1.02_real32 case('Ar') - mass_ = 39.948_real12 - charge_ = 18.0_real12 - radius_ = 1.06_real12 + mass_ = 39.948_real32 + charge_ = 18.0_real32 + radius_ = 1.06_real32 case('K') - mass_ = 39.098_real12 - charge_ = 19.0_real12 - radius_ = 2.03_real12 + mass_ = 39.098_real32 + charge_ = 19.0_real32 + radius_ = 2.03_real32 case('Ca') - mass_ = 40.078_real12 - charge_ = 20.0_real12 - radius_ = 1.74_real12 + mass_ = 40.078_real32 + charge_ = 20.0_real32 + radius_ = 1.74_real32 case('Sc') - mass_ = 44.956_real12 - charge_ = 21.0_real12 - radius_ = 1.44_real12 + mass_ = 44.956_real32 + charge_ = 21.0_real32 + radius_ = 1.44_real32 case('Ti') - mass_ = 47.867_real12 - charge_ = 22.0_real12 - radius_ = 1.32_real12 + mass_ = 47.867_real32 + charge_ = 22.0_real32 + radius_ = 1.32_real32 case('V') - mass_ = 50.942_real12 - charge_ = 23.0_real12 - radius_ = 1.22_real12 + mass_ = 50.942_real32 + charge_ = 23.0_real32 + radius_ = 1.22_real32 case('Cr') - mass_ = 51.996_real12 - charge_ = 24.0_real12 - radius_ = 1.18_real12 + mass_ = 51.996_real32 + charge_ = 24.0_real32 + radius_ = 1.18_real32 case('Mn') - mass_ = 54.938_real12 - charge_ = 25.0_real12 - radius_ = 1.17_real12 + mass_ = 54.938_real32 + charge_ = 25.0_real32 + radius_ = 1.17_real32 case('Fe') - mass_ = 55.845_real12 - charge_ = 26.0_real12 - radius_ = 1.17_real12 + mass_ = 55.845_real32 + charge_ = 26.0_real32 + radius_ = 1.17_real32 case('Co') - mass_ = 58.933_real12 - charge_ = 27.0_real12 - radius_ = 1.16_real12 + mass_ = 58.933_real32 + charge_ = 27.0_real32 + radius_ = 1.16_real32 case('Ni') - mass_ = 58.693_real12 - charge_ = 28.0_real12 - radius_ = 1.15_real12 + mass_ = 58.693_real32 + charge_ = 28.0_real32 + radius_ = 1.15_real32 case('Cu') - mass_ = 63.546_real12 - charge_ = 29.0_real12 - radius_ = 1.17_real12 + mass_ = 63.546_real32 + charge_ = 29.0_real32 + radius_ = 1.17_real32 case('Zn') - mass_ = 65.38_real12 - charge_ = 30.0_real12 - radius_ = 1.25_real12 + mass_ = 65.38_real32 + charge_ = 30.0_real32 + radius_ = 1.25_real32 case('Ga') - mass_ = 69.723_real12 - charge_ = 31.0_real12 - radius_ = 1.26_real12 + mass_ = 69.723_real32 + charge_ = 31.0_real32 + radius_ = 1.26_real32 case('Ge') - mass_ = 72.63_real12 - charge_ = 32.0_real12 - radius_ = 1.22_real12 + mass_ = 72.63_real32 + charge_ = 32.0_real32 + radius_ = 1.22_real32 case('As') - mass_ = 74.922_real12 - charge_ = 33.0_real12 - radius_ = 1.19_real12 + mass_ = 74.922_real32 + charge_ = 33.0_real32 + radius_ = 1.19_real32 case('Se') - mass_ = 78.971_real12 - charge_ = 34.0_real12 - radius_ = 1.16_real12 + mass_ = 78.971_real32 + charge_ = 34.0_real32 + radius_ = 1.16_real32 case('Br') - mass_ = 79.904_real12 - charge_ = 35.0_real12 - radius_ = 1.14_real12 + mass_ = 79.904_real32 + charge_ = 35.0_real32 + radius_ = 1.14_real32 case('Kr') - mass_ = 83.798_real12 - charge_ = 36.0_real12 - radius_ = 1.12_real12 + mass_ = 83.798_real32 + charge_ = 36.0_real32 + radius_ = 1.12_real32 case('Rb') - mass_ = 85.468_real12 - charge_ = 37.0_real12 - radius_ = 2.16_real12 + mass_ = 85.468_real32 + charge_ = 37.0_real32 + radius_ = 2.16_real32 case('Sr') - mass_ = 87.62_real12 - charge_ = 38.0_real12 - radius_ = 1.91_real12 + mass_ = 87.62_real32 + charge_ = 38.0_real32 + radius_ = 1.91_real32 case('Y') - mass_ = 88.906_real12 - charge_ = 39.0_real12 - radius_ = 1.62_real12 + mass_ = 88.906_real32 + charge_ = 39.0_real32 + radius_ = 1.62_real32 case('Zr') - mass_ = 91.224_real12 - charge_ = 40.0_real12 - radius_ = 1.45_real12 + mass_ = 91.224_real32 + charge_ = 40.0_real32 + radius_ = 1.45_real32 case('Nb') - mass_ = 92.906_real12 - charge_ = 41.0_real12 - radius_ = 1.34_real12 + mass_ = 92.906_real32 + charge_ = 41.0_real32 + radius_ = 1.34_real32 case('Mo') - mass_ = 95.95_real12 - charge_ = 42.0_real12 - radius_ = 1.3_real12 + mass_ = 95.95_real32 + charge_ = 42.0_real32 + radius_ = 1.3_real32 case('Tc') - mass_ = 98.0_real12 - charge_ = 43.0_real12 - radius_ = 1.27_real12 + mass_ = 98.0_real32 + charge_ = 43.0_real32 + radius_ = 1.27_real32 case('Ru') - mass_ = 101.07_real12 - charge_ = 44.0_real12 - radius_ = 1.25_real12 + mass_ = 101.07_real32 + charge_ = 44.0_real32 + radius_ = 1.25_real32 case('Rh') - mass_ = 102.91_real12 - charge_ = 45.0_real12 - radius_ = 1.25_real12 + mass_ = 102.91_real32 + charge_ = 45.0_real32 + radius_ = 1.25_real32 case('Pd') - mass_ = 106.42_real12 - charge_ = 46.0_real12 - radius_ = 1.28_real12 + mass_ = 106.42_real32 + charge_ = 46.0_real32 + radius_ = 1.28_real32 case('Ag') - mass_ = 107.87_real12 - charge_ = 47.0_real12 - radius_ = 1.34_real12 + mass_ = 107.87_real32 + charge_ = 47.0_real32 + radius_ = 1.34_real32 case('Cd') - mass_ = 112.41_real12 - charge_ = 48.0_real12 - radius_ = 1.48_real12 + mass_ = 112.41_real32 + charge_ = 48.0_real32 + radius_ = 1.48_real32 case('In') - mass_ = 114.82_real12 - charge_ = 49.0_real12 - radius_ = 1.44_real12 + mass_ = 114.82_real32 + charge_ = 49.0_real32 + radius_ = 1.44_real32 case('Sn') - mass_ = 118.71_real12 - charge_ = 50.0_real12 - radius_ = 1.41_real12 + mass_ = 118.71_real32 + charge_ = 50.0_real32 + radius_ = 1.41_real32 case('Sb') - mass_ = 121.76_real12 - charge_ = 51.0_real12 - radius_ = 1.38_real12 + mass_ = 121.76_real32 + charge_ = 51.0_real32 + radius_ = 1.38_real32 case('Te') - mass_ = 127.6_real12 - charge_ = 52.0_real12 - radius_ = 1.35_real12 + mass_ = 127.6_real32 + charge_ = 52.0_real32 + radius_ = 1.35_real32 case('I') - mass_ = 126.9_real12 - charge_ = 53.0_real12 - radius_ = 1.33_real12 + mass_ = 126.9_real32 + charge_ = 53.0_real32 + radius_ = 1.33_real32 case('Xe') - mass_ = 131.29_real12 - charge_ = 54.0_real12 - radius_ = 1.31_real12 + mass_ = 131.29_real32 + charge_ = 54.0_real32 + radius_ = 1.31_real32 case('Cs') - mass_ = 132.91_real12 - charge_ = 55.0_real12 - radius_ = 2.35_real12 + mass_ = 132.91_real32 + charge_ = 55.0_real32 + radius_ = 2.35_real32 case('Ba') - mass_ = 137.33_real12 - charge_ = 56.0_real12 - radius_ = 1.98_real12 + mass_ = 137.33_real32 + charge_ = 56.0_real32 + radius_ = 1.98_real32 case('La') - mass_ = 138.91_real12 - charge_ = 57.0_real12 - radius_ = 1.69_real12 + mass_ = 138.91_real32 + charge_ = 57.0_real32 + radius_ = 1.69_real32 case('Ce') - mass_ = 140.12_real12 - charge_ = 58.0_real12 - radius_ = 1.65_real12 + mass_ = 140.12_real32 + charge_ = 58.0_real32 + radius_ = 1.65_real32 case('Pr') - mass_ = 140.91_real12 - charge_ = 59.0_real12 - radius_ = 1.65_real12 + mass_ = 140.91_real32 + charge_ = 59.0_real32 + radius_ = 1.65_real32 case('Nd') - mass_ = 144.24_real12 - charge_ = 60.0_real12 - radius_ = 1.64_real12 + mass_ = 144.24_real32 + charge_ = 60.0_real32 + radius_ = 1.64_real32 case('Pm') - mass_ = 145.0_real12 - charge_ = 61.0_real12 - radius_ = 1.63_real12 + mass_ = 145.0_real32 + charge_ = 61.0_real32 + radius_ = 1.63_real32 case('Sm') - mass_ = 150.36_real12 - charge_ = 62.0_real12 - radius_ = 1.62_real12 + mass_ = 150.36_real32 + charge_ = 62.0_real32 + radius_ = 1.62_real32 case('Eu') - mass_ = 152.0_real12 - charge_ = 63.0_real12 - radius_ = 1.85_real12 + mass_ = 152.0_real32 + charge_ = 63.0_real32 + radius_ = 1.85_real32 case('Gd') - mass_ = 157.25_real12 - charge_ = 64.0_real12 - radius_ = 1.61_real12 + mass_ = 157.25_real32 + charge_ = 64.0_real32 + radius_ = 1.61_real32 case('Tb') - mass_ = 158.93_real12 - charge_ = 65.0_real12 - radius_ = 1.59_real12 + mass_ = 158.93_real32 + charge_ = 65.0_real32 + radius_ = 1.59_real32 case('Dy') - mass_ = 162.5_real12 - charge_ = 66.0_real12 - radius_ = 1.59_real12 + mass_ = 162.5_real32 + charge_ = 66.0_real32 + radius_ = 1.59_real32 case('Ho') - mass_ = 164.93_real12 - charge_ = 67.0_real12 - radius_ = 1.58_real12 + mass_ = 164.93_real32 + charge_ = 67.0_real32 + radius_ = 1.58_real32 case('Er') - mass_ = 167.26_real12 - charge_ = 68.0_real12 - radius_ = 1.57_real12 + mass_ = 167.26_real32 + charge_ = 68.0_real32 + radius_ = 1.57_real32 case('Tm') - mass_ = 168.93_real12 - charge_ = 69.0_real12 - radius_ = 1.56_real12 + mass_ = 168.93_real32 + charge_ = 69.0_real32 + radius_ = 1.56_real32 case('Yb') - mass_ = 173.05_real12 - charge_ = 70.0_real12 - radius_ = 1.74_real12 + mass_ = 173.05_real32 + charge_ = 70.0_real32 + radius_ = 1.74_real32 case('Lu') - mass_ = 174.97_real12 - charge_ = 71.0_real12 - radius_ = 1.56_real12 + mass_ = 174.97_real32 + charge_ = 71.0_real32 + radius_ = 1.56_real32 case('Hf') - mass_ = 178.49_real12 - charge_ = 72.0_real12 - radius_ = 1.44_real12 + mass_ = 178.49_real32 + charge_ = 72.0_real32 + radius_ = 1.44_real32 case('Ta') - mass_ = 180.95_real12 - charge_ = 73.0_real12 - radius_ = 1.34_real12 + mass_ = 180.95_real32 + charge_ = 73.0_real32 + radius_ = 1.34_real32 case('W') - mass_ = 183.84_real12 - charge_ = 74.0_real12 - radius_ = 1.3_real12 + mass_ = 183.84_real32 + charge_ = 74.0_real32 + radius_ = 1.3_real32 case('Re') - mass_ = 186.21_real12 - charge_ = 75.0_real12 - radius_ = 1.28_real12 + mass_ = 186.21_real32 + charge_ = 75.0_real32 + radius_ = 1.28_real32 case('Os') - mass_ = 190.23_real12 - charge_ = 76.0_real12 - radius_ = 1.26_real12 + mass_ = 190.23_real32 + charge_ = 76.0_real32 + radius_ = 1.26_real32 case('Ir') - mass_ = 192.22_real12 - charge_ = 77.0_real12 - radius_ = 1.27_real12 + mass_ = 192.22_real32 + charge_ = 77.0_real32 + radius_ = 1.27_real32 case('Pt') - mass_ = 195.08_real12 - charge_ = 78.0_real12 - radius_ = 1.3_real12 + mass_ = 195.08_real32 + charge_ = 78.0_real32 + radius_ = 1.3_real32 case('Au') - mass_ = 196.97_real12 - charge_ = 79.0_real12 - radius_ = 1.34_real12 + mass_ = 196.97_real32 + charge_ = 79.0_real32 + radius_ = 1.34_real32 case('Hg') - mass_ = 200.59_real12 - charge_ = 80.0_real12 - radius_ = 1.49_real12 + mass_ = 200.59_real32 + charge_ = 80.0_real32 + radius_ = 1.49_real32 case('Tl') - mass_ = 204.38_real12 - charge_ = 81.0_real12 - radius_ = 1.48_real12 + mass_ = 204.38_real32 + charge_ = 81.0_real32 + radius_ = 1.48_real32 case('Pb') - mass_ = 207.2_real12 - charge_ = 82.0_real12 - radius_ = 1.47_real12 + mass_ = 207.2_real32 + charge_ = 82.0_real32 + radius_ = 1.47_real32 case('Bi') - mass_ = 208.98_real12 - charge_ = 83.0_real12 - radius_ = 1.46_real12 + mass_ = 208.98_real32 + charge_ = 83.0_real32 + radius_ = 1.46_real32 case('Po') - mass_ = 209.0_real12 - charge_ = 84.0_real12 - radius_ = 1.45_real12 + mass_ = 209.0_real32 + charge_ = 84.0_real32 + radius_ = 1.45_real32 case('At') - mass_ = 210.0_real12 - charge_ = 85.0_real12 - radius_ = 1.44_real12 + mass_ = 210.0_real32 + charge_ = 85.0_real32 + radius_ = 1.44_real32 case('Rn') - mass_ = 222.0_real12 - charge_ = 86.0_real12 - radius_ = 1.43_real12 + mass_ = 222.0_real32 + charge_ = 86.0_real32 + radius_ = 1.43_real32 case('Fr') - mass_ = 223.0_real12 - charge_ = 87.0_real12 - radius_ = 2.6_real12 + mass_ = 223.0_real32 + charge_ = 87.0_real32 + radius_ = 2.6_real32 case('Ra') - mass_ = 226.0_real12 - charge_ = 88.0_real12 - radius_ = 2.21_real12 + mass_ = 226.0_real32 + charge_ = 88.0_real32 + radius_ = 2.21_real32 case('Ac') - mass_ = 227.0_real12 - charge_ = 89.0_real12 - radius_ = 1.86_real12 + mass_ = 227.0_real32 + charge_ = 89.0_real32 + radius_ = 1.86_real32 case('Th') - mass_ = 232.04_real12 - charge_ = 90.0_real12 - radius_ = 1.75_real12 + mass_ = 232.04_real32 + charge_ = 90.0_real32 + radius_ = 1.75_real32 case('Pa') - mass_ = 231.04_real12 - charge_ = 91.0_real12 - radius_ = 1.61_real12 + mass_ = 231.04_real32 + charge_ = 91.0_real32 + radius_ = 1.61_real32 case('U') - mass_ = 238.03_real12 - charge_ = 92.0_real12 - radius_ = 1.58_real12 + mass_ = 238.03_real32 + charge_ = 92.0_real32 + radius_ = 1.58_real32 case('Np') - mass_ = 237.0_real12 - charge_ = 93.0_real12 - radius_ = 1.55_real12 + mass_ = 237.0_real32 + charge_ = 93.0_real32 + radius_ = 1.55_real32 case('Pu') - mass_ = 244.0_real12 - charge_ = 94.0_real12 - radius_ = 1.53_real12 + mass_ = 244.0_real32 + charge_ = 94.0_real32 + radius_ = 1.53_real32 case('Am') - mass_ = 243.0_real12 - charge_ = 95.0_real12 - radius_ = 1.51_real12 + mass_ = 243.0_real32 + charge_ = 95.0_real32 + radius_ = 1.51_real32 case('Cm') - mass_ = 247.0_real12 - charge_ = 96.0_real12 - radius_ = 1.69_real12 + mass_ = 247.0_real32 + charge_ = 96.0_real32 + radius_ = 1.69_real32 case('Bk') - mass_ = 247.0_real12 - charge_ = 97.0_real12 - radius_ = 1.48_real12 + mass_ = 247.0_real32 + charge_ = 97.0_real32 + radius_ = 1.48_real32 case('Cf') - mass_ = 251.0_real12 - charge_ = 98.0_real12 - radius_ = 1.47_real12 + mass_ = 251.0_real32 + charge_ = 98.0_real32 + radius_ = 1.47_real32 case('Es') - mass_ = 252.0_real12 - charge_ = 99.0_real12 - radius_ = 1.46_real12 + mass_ = 252.0_real32 + charge_ = 99.0_real32 + radius_ = 1.46_real32 case('Fm') - mass_ = 257.0_real12 - charge_ = 100.0_real12 - radius_ = 1.45_real12 + mass_ = 257.0_real32 + charge_ = 100.0_real32 + radius_ = 1.45_real32 case('Md') - mass_ = 258.0_real12 - charge_ = 101.0_real12 - radius_ = 1.44_real12 + mass_ = 258.0_real32 + charge_ = 101.0_real32 + radius_ = 1.44_real32 case('No') - mass_ = 259.0_real12 - charge_ = 102.0_real12 - radius_ = 1.43_real12 + mass_ = 259.0_real32 + charge_ = 102.0_real32 + radius_ = 1.43_real32 case('Lr') - mass_ = 262.0_real12 - charge_ = 103.0_real12 - radius_ = 1.62_real12 + mass_ = 262.0_real32 + charge_ = 103.0_real32 + radius_ = 1.62_real32 case('Rf') - mass_ = 267.0_real12 - charge_ = 104.0_real12 - radius_ = 1.57_real12 + mass_ = 267.0_real32 + charge_ = 104.0_real32 + radius_ = 1.57_real32 case('Db') - mass_ = 270.0_real12 - charge_ = 105.0_real12 - radius_ = 1.49_real12 + mass_ = 270.0_real32 + charge_ = 105.0_real32 + radius_ = 1.49_real32 case('Sg') - mass_ = 271.0_real12 - charge_ = 106.0_real12 - radius_ = 1.43_real12 + mass_ = 271.0_real32 + charge_ = 106.0_real32 + radius_ = 1.43_real32 case('Bh') - mass_ = 270.0_real12 - charge_ = 107.0_real12 - radius_ = 1.41_real12 + mass_ = 270.0_real32 + charge_ = 107.0_real32 + radius_ = 1.41_real32 case('Hs') - mass_ = 277.0_real12 - charge_ = 108.0_real12 - radius_ = 1.34_real12 + mass_ = 277.0_real32 + charge_ = 108.0_real32 + radius_ = 1.34_real32 case('Mt') - mass_ = 276.0_real12 - charge_ = 109.0_real12 - radius_ = 1.29_real12 + mass_ = 276.0_real32 + charge_ = 109.0_real32 + radius_ = 1.29_real32 case('Ds') - mass_ = 281.0_real12 - charge_ = 110.0_real12 - radius_ = 1.28_real12 + mass_ = 281.0_real32 + charge_ = 110.0_real32 + radius_ = 1.28_real32 case('Rg') - mass_ = 280.0_real12 - charge_ = 111.0_real12 - radius_ = 1.21_real12 + mass_ = 280.0_real32 + charge_ = 111.0_real32 + radius_ = 1.21_real32 case('Cn') - mass_ = 285.0_real12 - charge_ = 112.0_real12 - radius_ = 1.22_real12 + mass_ = 285.0_real32 + charge_ = 112.0_real32 + radius_ = 1.22_real32 case('Nh') - mass_ = 284.0_real12 - charge_ = 113.0_real12 - radius_ = 1.21_real12 + mass_ = 284.0_real32 + charge_ = 113.0_real32 + radius_ = 1.21_real32 case('Fl') - mass_ = 289.0_real12 - charge_ = 114.0_real12 - radius_ = 1.21_real12 + mass_ = 289.0_real32 + charge_ = 114.0_real32 + radius_ = 1.21_real32 case('Mc') - mass_ = 288.0_real12 - charge_ = 115.0_real12 - radius_ = 1.21_real12 + mass_ = 288.0_real32 + charge_ = 115.0_real32 + radius_ = 1.21_real32 case('Lv') - mass_ = 293.0_real12 - charge_ = 116.0_real12 - radius_ = 1.21_real12 + mass_ = 293.0_real32 + charge_ = 116.0_real32 + radius_ = 1.21_real32 case('Ts') - mass_ = 294.0_real12 - charge_ = 117.0_real12 - radius_ = 1.21_real12 + mass_ = 294.0_real32 + charge_ = 117.0_real32 + radius_ = 1.21_real32 case('Og') - mass_ = 294.0_real12 - charge_ = 118.0_real12 - radius_ = 1.21_real12 + mass_ = 294.0_real32 + charge_ = 118.0_real32 + radius_ = 1.21_real32 case default ! handle unknown element - mass_ = 0.0_real12 - charge_ = 0.0_real12 - radius_ = 0.0_real12 + mass_ = 0.0_real32 + charge_ = 0.0_real32 + radius_ = 0.0_real32 end select !--------------------------------------------------------------------------- @@ -1905,4 +1905,4 @@ subroutine get_element_properties(element, charge, mass, radius) end subroutine get_element_properties !############################################################################### -end module rw_geom \ No newline at end of file +end module raffle__geom_rw \ No newline at end of file diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 new file mode 100644 index 00000000..5ace258c --- /dev/null +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -0,0 +1,132 @@ +module raffle__geom_utils + !! Module to contain all geometry-manipulation related procedures + !! + !! This module contains procedures that are used to manipulate the geometry + !! of the system. The geometry type used is defined in the rw_geom module. + use raffle__constants, only: pi,real32 + use raffle__geom_rw, only: basis_type + use raffle__misc_linalg, only: modu, get_angle + implicit none + + + private + + public :: basis_merge + + +contains + +!############################################################################### + function basis_merge(basis1,basis2,length,map1,map2) result(output) + !! Merge two supplied bases + !! + !! Merge two bases assuming that the lattice is the same + implicit none + + ! Arguments + type(basis_type) :: output + !! Output merged basis. + class(basis_type), intent(in) :: basis1, basis2 + !! Input bases to merge. + integer, intent(in), optional :: length + !! Number of dimensions for atomic positions (default 3). + integer, allocatable, dimension(:,:,:), optional, intent(inout) :: map1,map2 + !! Maps for atoms in the two bases. + + ! Local variables + integer :: i, j, k, itmp, dim + !! Loop counters. + logical :: lmap + !! Boolean for map presence. + integer, allocatable, dimension(:) :: match + !! Array to match species. + integer, allocatable, dimension(:,:,:) :: new_map + !! New map for merged basis. + + + + !--------------------------------------------------------------------------- + ! set up number of species + !--------------------------------------------------------------------------- + dim=3 + if(present(length)) dim=length + + allocate(match(basis2%nspec)) + match=0 + output%nspec=basis1%nspec + do i=1,basis2%nspec + if(.not.any(basis2%spec(i)%name.eq.basis1%spec(:)%name))then + output%nspec=output%nspec+1 + end if + end do + allocate(output%spec(output%nspec)) + output%spec(:basis1%nspec)%num=basis1%spec(:)%num + output%spec(:basis1%nspec)%name=basis1%spec(:)%name + + + write(output%sysname,'(A,"+",A)') & + trim(basis1%sysname),trim(basis2%sysname) + k=basis1%nspec + spec1check: do i=1,basis2%nspec + do j=1,basis1%nspec + if(basis2%spec(i)%name.eq.basis1%spec(j)%name)then + output%spec(j)%num=output%spec(j)%num+basis2%spec(i)%num + match(i)=j + cycle spec1check + end if + end do + k=k+1 + match(i)=k + output%spec(k)%num=basis2%spec(i)%num + output%spec(k)%name=basis2%spec(i)%name + end do spec1check + + + !--------------------------------------------------------------------------- + ! if map is present, sets up new map + !--------------------------------------------------------------------------- + lmap = .false. + if_map: if(present(map1).and.present(map2))then + if(all(map1.eq.-1)) exit if_map + lmap = .true. + allocate(new_map(& + output%nspec,& + maxval(output%spec(:)%num,dim=1),2)) + new_map = 0 + end if if_map + + + !--------------------------------------------------------------------------- + ! set up atoms in merged basis + !--------------------------------------------------------------------------- + do i=1,basis1%nspec + allocate(output%spec(i)%atom(output%spec(i)%num,dim)) + output%spec(i)%atom(:,:)=0._real32 + output%spec(i)%atom(1:basis1%spec(i)%num,:3)=basis1%spec(i)%atom(:,:3) + if(lmap) new_map(i,:basis1%spec(i)%num,:)=map1(i,:basis1%spec(i)%num,:) + end do + do i=1,basis2%nspec + if(match(i).gt.basis1%nspec)then + allocate(output%spec(match(i))%atom(output%spec(match(i))%num,dim)) + output%spec(match(i))%atom(:,:)=0._real32 + output%spec(match(i))%atom(:,:3)=basis2%spec(i)%atom(:,:3) + if(lmap) new_map(match(i),:basis2%spec(i)%num,:) = & + map2(i,:basis2%spec(i)%num,:) + else + itmp=basis1%spec(match(i))%num + output%spec(match(i))%atom(itmp+1:basis2%spec(i)%num+itmp,:3) = & + basis2%spec(i)%atom(:,:3) + if(lmap) new_map(match(i),itmp+1:basis2%spec(i)%num+itmp,:) = & + map2(i,:basis2%spec(i)%num,:) + end if + end do + output%natom=sum(output%spec(:)%num) + + + if(lmap) call move_alloc(new_map,map1) + + return + end function basis_merge +!############################################################################### + +end module raffle__geom_utils diff --git a/src/fortran/lib/mod_io_utils.F90 b/src/fortran/lib/mod_io_utils.F90 new file mode 100644 index 00000000..9b23acf5 --- /dev/null +++ b/src/fortran/lib/mod_io_utils.F90 @@ -0,0 +1,66 @@ +module raffle__io_utils + !! Module for handling errors and io calls in the program. + !! + !! This module provides the expected procedure for stopping a program. + !! If in testing mode, the stop can be suppressed. + implicit none + logical :: test_error_handling = .false. + + character(len=*), parameter :: raffle__version__ = "0.4.0" + + private + + public :: raffle__version__ + public :: test_error_handling + public :: stop_program + public :: print_version, print_build_info + + +contains + +!############################################################################### + subroutine stop_program(message, exit_code) + !! Stop the program and print an error message. + implicit none + character(len=*), intent(in) :: message + integer, intent(in), optional :: exit_code + + integer :: exit_code_ + + if(present(exit_code)) then + exit_code_ = exit_code + else + exit_code_ = 1 + end if + + write(0,*) 'ERROR: ', trim(message) + if(.not.test_error_handling)then + stop exit_code_ + end if + end subroutine stop_program +!############################################################################### + + +!############################################################################### + subroutine print_version() + !! Print the version number of the program. + implicit none + + write(*,'("version: ",A)') raffle__version__ + end subroutine print_version +!############################################################################### + + +!############################################################################### + subroutine print_build_info() + !! Print the build information of the program. + implicit none + + write(*,'("RAFFLE: pseudoRandom Approach For Finding Local Energy minima")') + write(*,'(" version: ",A)') raffle__version__ + write(*,'(" (build ",A,1X,A,")")') __DATE__, __TIME__ + + end subroutine print_build_info +!############################################################################### + +end module raffle__io_utils \ No newline at end of file diff --git a/src/fortran/lib/mod_misc.f90 b/src/fortran/lib/mod_misc.f90 index a133eaf1..b376d084 100644 --- a/src/fortran/lib/mod_misc.f90 +++ b/src/fortran/lib/mod_misc.f90 @@ -1,7 +1,7 @@ -module misc_raffle +module raffle__misc !! Module contains various miscellaneous functions and subroutines. - use constants, only: real12 - use error_handling, only: stop_program + use raffle__constants, only: real32 + use raffle__io_utils, only: stop_program implicit none @@ -205,7 +205,7 @@ subroutine rsort1D(arr1,arr2,reverse) implicit none ! Arguments - real(real12), dimension(:), intent(inout) :: arr1 + real(real32), dimension(:), intent(inout) :: arr1 !! Array to be sorted. integer, dimension(:),intent(inout),optional :: arr2 !! Optional. Second array to be sorted. @@ -217,7 +217,7 @@ subroutine rsort1D(arr1,arr2,reverse) !! Loop index. integer :: ibuff !! Buffer for swapping elements. - real(real12) :: rbuff + real(real32) :: rbuff !! Buffer for swapping elements. logical :: reverse_ !! Boolean whether to sort in reverse order. @@ -260,7 +260,7 @@ pure recursive subroutine quicksort(arr, low, high) implicit none ! Arguments - real(real12), dimension(:), intent(inout) :: arr + real(real32), dimension(:), intent(inout) :: arr !! Array to be sorted. integer, intent(in) :: low, high !! Lower and upper bounds of the array to be sorted. @@ -268,7 +268,7 @@ pure recursive subroutine quicksort(arr, low, high) ! Local variables integer :: i, j !! Loop indices. - real(real12) :: pivot, temp + real(real32) :: pivot, temp !! Pivot element and temporary buffer. if (low .lt. high) then @@ -307,7 +307,7 @@ subroutine sort2D(arr,dim) implicit none ! Arguments - real(real12), dimension(dim,3) :: arr + real(real32), dimension(dim,3) :: arr !! Array to be sorted. integer, intent(in) :: dim !! Dimension to sort along. @@ -317,7 +317,7 @@ subroutine sort2D(arr,dim) !! Loop indices. integer, dimension(3) :: a123 !! Array to store the order of sorting. - real(real12), dimension(3) :: buff + real(real32), dimension(3) :: buff !! Buffer for swapping elements. a123(:)=(/1,2,3/) @@ -391,9 +391,9 @@ subroutine rset(arr, tol, count_list) implicit none ! Arguments - real(real12), dimension(:), allocatable, intent(inout) :: arr + real(real32), dimension(:), allocatable, intent(inout) :: arr !! Array to be reduced. - real(real12), intent(in), optional :: tol + real(real32), intent(in), optional :: tol !! Tolerance for comparing real numbers. integer, dimension(:), allocatable, intent(out), optional :: count_list !! List of counts for each unique element. @@ -401,9 +401,9 @@ subroutine rset(arr, tol, count_list) ! Local variables integer :: i,n !! Loop index. - real(real12) :: tol_ + real(real32) :: tol_ !! Tolerance for comparing real numbers. - real(real12), dimension(:), allocatable :: tmp_arr + real(real32), dimension(:), allocatable :: tmp_arr !! Temporary array for storing unique elements. integer, dimension(:), allocatable :: count_list_ !! List of counts for each unique element. @@ -412,7 +412,7 @@ subroutine rset(arr, tol, count_list) if(present(tol))then tol_ = tol else - tol_ = 1.E-4_real12 + tol_ = 1.E-4_real32 end if call quicksort(arr, 1, size(arr)) @@ -440,6 +440,11 @@ end subroutine rset !############################################################################### subroutine cset(arr,lcase,lkeep_size) !! Reduce a character array to its unique elements. + !! + !! This subroutine reduces a character array to its unique elements. + !! i.e. each string in the array is compared with the rest of the strings + !! in the array and if a match is found, the string is removed. + !! This results in only the unique strings being preserved. implicit none ! Arguments @@ -502,7 +507,7 @@ subroutine sort_col(arr1,col,reverse) implicit none ! Arguments - real(real12), dimension(:,:), intent(inout) :: arr1 + real(real32), dimension(:,:), intent(inout) :: arr1 !! Array to be sorted. integer, intent(in) :: col !! Column to sort along. @@ -514,7 +519,7 @@ subroutine sort_col(arr1,col,reverse) !! Loop index. logical :: reverse_ !! Boolean whether to sort in reverse order. - real(real12), allocatable, dimension(:) :: dbuff + real(real32), allocatable, dimension(:) :: dbuff !! Buffer for swapping elements. @@ -570,11 +575,11 @@ subroutine rswap(value1,value2) implicit none ! Arguments - real(real12), intent(inout) :: value1, value2 + real(real32), intent(inout) :: value1, value2 !! Reals to be swapped. ! Local variables - real(real12) :: rtmp1 + real(real32) :: rtmp1 !! Temporary buffer for swapping elements. rtmp1 = value1 @@ -610,11 +615,11 @@ subroutine rswap_vec(vec1,vec2) implicit none ! Arguments - real(real12),dimension(:), intent(inout) :: vec1, vec2 + real(real32),dimension(:), intent(inout) :: vec1, vec2 !! Vectors to be swapped. ! Local variables - real(real12),allocatable,dimension(:)::tvec + real(real32),allocatable,dimension(:)::tvec !! Temporary buffer for swapping elements. allocate(tvec(size(vec1))) @@ -645,7 +650,7 @@ subroutine ishuffle(arr,dim,seed) !! Loop indices. integer :: i1s,i2s,i1e,i2e,j1s,j2s,j1e,j2e !! Indices for swapping elements. - real(real12) :: r + real(real32) :: r !! Random number for shuffling. integer, allocatable, dimension(:,:) :: tlist !! Temporary list for swapping elements. @@ -693,7 +698,7 @@ subroutine rshuffle(arr,dim,seed) implicit none ! Arguments - real(real12), dimension(:,:), intent(inout) :: arr + real(real32), dimension(:,:), intent(inout) :: arr !! Array to be shuffled. integer, intent(in) :: dim !! Dimension to shuffle along. @@ -707,9 +712,9 @@ subroutine rshuffle(arr,dim,seed) !! Loop indices. integer :: i1s,i2s,i1e,i2e,j1s,j2s,j1e,j2e !! Indices for swapping elements. - real(real12) :: r + real(real32) :: r !! Random number for shuffling. - real(real12), allocatable, dimension(:,:) :: tlist + real(real32), allocatable, dimension(:,:) :: tlist !! Temporary list for swapping elements. @@ -1098,4 +1103,4 @@ function strip_null(buffer) result(stripped) end function strip_null !############################################################################### -end module misc_raffle +end module raffle__misc diff --git a/src/fortran/lib/mod_misc_linalg.f90 b/src/fortran/lib/mod_misc_linalg.f90 index 5822d93c..631ce152 100644 --- a/src/fortran/lib/mod_misc_linalg.f90 +++ b/src/fortran/lib/mod_misc_linalg.f90 @@ -1,13 +1,13 @@ -module misc_linalg +module raffle__misc_linalg !! Module contains various linear algebra functions and subroutines. - use constants, only: real12, pi + use raffle__constants, only: real32, pi implicit none private - public :: uvec, modu, cross - public :: get_distance, get_angle, get_dihedral_angle, get_area, get_vol + public :: modu, cross + public :: get_distance, get_angle, get_dihedral_angle, get_area public :: get_improper_dihedral_angle public :: inverse_3x3 @@ -27,31 +27,15 @@ module misc_linalg contains -!############################################################################### - pure function uvec(vector) - !! Return the unit vector of a vector of any size. - implicit none - - ! Arguments - real(real12),dimension(:), intent(in)::vector - !! Input vector. - real(real12),allocatable,dimension(:)::uvec - !! Output unit vector. - - uvec = vector / modu(vector) - end function uvec -!############################################################################### - - !############################################################################### pure function modu(vector) !! Return the magnitude of a vector of any size. implicit none ! Arguments - real(real12),dimension(:), intent(in)::vector + real(real32),dimension(:), intent(in) :: vector !! Input vector. - real(real12)::modu + real(real32) :: modu !! Output magnitude. modu = abs( sqrt( sum(vector(:)**2) ) ) @@ -65,9 +49,9 @@ pure function cross(a,b) implicit none ! Arguments - real(real12), dimension(3), intent(in) :: a,b + real(real32), dimension(3), intent(in) :: a b !! Input vectors. - real(real12), dimension(3) :: cross + real(real32), dimension(3) :: cross !! Output cross product. cross(1) = a(2) * b(3) - a(3) * b(2) @@ -84,9 +68,9 @@ pure function get_distance(point1, point2) result(distance) implicit none ! Arguments - real(real12), dimension(3), intent(in) :: point1,point2 + real(real32), dimension(3), intent(in) :: point1, point2 !! Input points. - real(real12) :: distance + real(real32) :: distance !! Output distance. distance = modu( point1 - point2 ) @@ -102,16 +86,16 @@ pure function get_angle_from_vectors(vector1, vector2) result(angle) implicit none ! Arguments - real(real12), dimension(3), intent(in) :: vector1,vector2 + real(real32), dimension(3), intent(in) :: vector1, vector2 !! Input vectors. - real(real12) :: angle + real(real32) :: angle !! Output angle. angle = dot_product(vector1,vector2) / & ( modu(vector1) * modu(vector2) ) - if(angle .ge. 1._real12)then - angle = 0._real12 - elseif(angle .le. -1._real12)then + if(angle .ge. 1._real32)then + angle = 0._real32 + elseif(angle .le. -1._real32)then angle = pi else angle = acos(angle) @@ -128,16 +112,16 @@ pure function get_angle_from_points(point1, point2, point3) result(angle) implicit none ! Arguments - real(real12), dimension(3), intent(in) :: point1, point2, point3 + real(real32), dimension(3), intent(in) :: point1, point2, point3 !! Input points. - real(real12) :: angle + real(real32) :: angle !! Output angle. angle = dot_product( point1 - point2, point3 - point2 ) / & ( modu( point1 - point2 ) * modu( point3 - point2 ) ) - if(angle .ge. 1._real12)then - angle = 0._real12 - elseif(angle .le. -1._real12)then + if(angle .ge. 1._real32)then + angle = 0._real32 + elseif(angle .le. -1._real32)then angle = pi else angle = acos(angle) @@ -157,9 +141,9 @@ pure function get_dihedral_angle_from_vectors( & implicit none ! Arguments - real(real12), dimension(3), intent(in) :: vector1,vector2,vector3 + real(real32), dimension(3), intent(in) :: vector1, vector2, vector3 !! Input vectors. - real(real12) :: angle + real(real32) :: angle !! Output angle. angle = get_angle(cross(vector1, vector2), vector3) @@ -177,8 +161,8 @@ pure function get_dihedral_angle_from_points(point1, point2, point3, point4) & !! i.e. ( point2 - point1 ) x ( point3 - point2 ) . ( point4 - point2 ) !! alt. angle between plane point1point2point3 and vector point2point4 implicit none - real(real12), dimension(3), intent(in) :: point1, point2, point3, point4 - real(real12) :: angle + real(real32), dimension(3), intent(in) :: point1, point2, point3, point4 + real(real32) :: angle angle = get_angle(cross(point2 - point1, point3 - point2), point4 - point2) @@ -197,15 +181,15 @@ pure function get_improper_dihedral_angle_from_vectors( & !! i.e. ( vector1 x vector2 ) . ( vector2 x vector3 ) !! alt. angle between plane vector1vector2 and vector2vector3 implicit none - real(real12), dimension(3), intent(in) :: vector1, vector2, vector3 - real(real12) :: angle + real(real32), dimension(3), intent(in) :: vector1, vector2, vector3 + real(real32) :: angle angle = get_angle( & cross(vector1, vector2), & cross(vector2, vector3) & ) !! map angle back into the range [0, pi] - if(angle .gt. pi) angle = 2._real12 * pi - angle + if(angle .gt. pi) angle = 2._real32 * pi - angle end function get_improper_dihedral_angle_from_vectors @@ -223,8 +207,8 @@ pure function get_improper_dihedral_angle_from_points( & !! ( point4 - point2 ) x ( point3 - point1 ) !! alt. angle between plane point1point2point3 and point1point3point4 implicit none - real(real12), dimension(3), intent(in) :: point1, point2, point3, point4 - real(real12) :: angle + real(real32), dimension(3), intent(in) :: point1, point2, point3, point4 + real(real32) :: angle angle = get_angle( & cross(point2 - point1, point3 - point1), & @@ -235,83 +219,29 @@ end function get_improper_dihedral_angle_from_points !############################################################################### -!############################################################################### - pure function get_area(a,b) result(area) - !! Return the area made by two vectors. - implicit none - - ! Arguments - real(real12), dimension(3), intent(in) :: a,b - !! Input vectors. - real(real12) :: area - !! Output area. - real(real12), dimension(3) :: vec - !! Cross product of a and b. - - vec = cross(a,b) - area = sqrt(dot_product(vec,vec)) - - end function get_area -!############################################################################### - - -!############################################################################### - function get_vol(matrix) result(vol) - !! Return the volume of a matrix. - implicit none - - ! Arguments - real(real12), dimension(3,3), intent(in) :: matrix - !! Input matrix. - - ! Local variables - integer :: n,i,j,k,l - !! Loop indices. - real(real12) :: vol,scale - !! Volume and scale factor. - real(real12), dimension(3) :: a,b,c - !! Vectors of the matrix. - - - a=matrix(1,:) - b=matrix(2,:) - c=matrix(3,:) - vol = 0._real12;scale = 1._real12 - i=1;j=2;k=3 -1 do n=1,3 - vol = vol+scale*a(i)*b(j)*c(k) - l=i;i=j;j=k;k=l - end do - i=2;j=1;k=3;scale=-scale - if(scale<0._real12) goto 1 - - end function get_vol -!############################################################################### - - !############################################################################### pure function inverse_3x3(mat) result(output) implicit none - real(real12) :: det - real(real12), dimension(3,3) :: output - real(real12), dimension(3,3), intent(in) :: mat + real(real32) :: det + real(real32), dimension(3,3) :: output + real(real32), dimension(3,3), intent(in) :: mat det = & mat(1,1) * mat(2,2) * mat(3,3) - mat(1,1) * mat(2,3) * mat(3,2) - & mat(1,2) * mat(2,1) * mat(3,3) + mat(1,2) * mat(2,3) * mat(3,1) + & mat(1,3) * mat(2,1) * mat(3,2) - mat(1,3) * mat(2,2) * mat(3,1) - output(1,1) = +1._real12 / det * (mat(2,2) * mat(3,3) - mat(2,3) * mat(3,2)) - output(2,1) = -1._real12 / det * (mat(2,1) * mat(3,3) - mat(2,3) * mat(3,1)) - output(3,1) = +1._real12 / det * (mat(2,1) * mat(3,2) - mat(2,2) * mat(3,1)) - output(1,2) = -1._real12 / det * (mat(1,2) * mat(3,3) - mat(1,3) * mat(3,2)) - output(2,2) = +1._real12 / det * (mat(1,1) * mat(3,3) - mat(1,3) * mat(3,1)) - output(3,2) = -1._real12 / det * (mat(1,1) * mat(3,2) - mat(1,2) * mat(3,1)) - output(1,3) = +1._real12 / det * (mat(1,2) * mat(2,3) - mat(1,3) * mat(2,2)) - output(2,3) = -1._real12 / det * (mat(1,1) * mat(2,3) - mat(1,3) * mat(2,1)) - output(3,3) = +1._real12 / det * (mat(1,1) * mat(2,2) - mat(1,2) * mat(2,1)) + output(1,1) = +1._real32 / det * (mat(2,2) * mat(3,3) - mat(2,3) * mat(3,2)) + output(2,1) = -1._real32 / det * (mat(2,1) * mat(3,3) - mat(2,3) * mat(3,1)) + output(3,1) = +1._real32 / det * (mat(2,1) * mat(3,2) - mat(2,2) * mat(3,1)) + output(1,2) = -1._real32 / det * (mat(1,2) * mat(3,3) - mat(1,3) * mat(3,2)) + output(2,2) = +1._real32 / det * (mat(1,1) * mat(3,3) - mat(1,3) * mat(3,1)) + output(3,2) = -1._real32 / det * (mat(1,1) * mat(3,2) - mat(1,2) * mat(3,1)) + output(1,3) = +1._real32 / det * (mat(1,2) * mat(2,3) - mat(1,3) * mat(2,2)) + output(2,3) = -1._real32 / det * (mat(1,1) * mat(2,3) - mat(1,3) * mat(2,1)) + output(3,3) = +1._real32 / det * (mat(1,1) * mat(2,2) - mat(1,2) * mat(2,1)) end function inverse_3x3 !############################################################################### -end module misc_linalg +end module raffle__misc_linalg diff --git a/src/fortran/lib/mod_misc_maths.f90 b/src/fortran/lib/mod_misc_maths.f90 index a66a9371..594ea2fe 100644 --- a/src/fortran/lib/mod_misc_maths.f90 +++ b/src/fortran/lib/mod_misc_maths.f90 @@ -1,7 +1,7 @@ -module misc_maths +module raffle__misc_maths !! Module for miscellaneous mathematical functions. - use error_handling, only: stop_program - use constants, only: real12 + use raffle__io_utils, only: stop_program + use raffle__constants, only: real32 implicit none @@ -21,16 +21,16 @@ function lnsum(n) ! Arguments integer :: n !! The upper limit of the range. - real(real12) :: lnsum + real(real32) :: lnsum !! The sum of the logs of the integers from 1 to n. ! Local variables integer :: i !! Loop index. - lnsum = 0._real12 + lnsum = 0._real32 do i = 1, n - lnsum = lnsum + log( real(i, real12) ) + lnsum = lnsum + log( real(i, real32) ) end do return @@ -57,13 +57,13 @@ function set_difference(a, b, set_min_zero) implicit none ! Arguments - real(real12), dimension(:), intent(in) :: a + real(real32), dimension(:), intent(in) :: a !! The first array. - real(real12), dimension(:), intent(in) :: b + real(real32), dimension(:), intent(in) :: b !! The second array. logical, optional :: set_min_zero !! Boolean to set the maximum value of the output array to zero. - real(real12), dimension(size(a)) :: set_difference + real(real32), dimension(size(a)) :: set_difference !! The set difference of the two arrays. ! Local variables @@ -86,7 +86,7 @@ function set_difference(a, b, set_min_zero) if(set_min_zero_)then do i = 1, size(a,1) - set_difference(i) = max(0.0_real12, a(i) - b(i)) + set_difference(i) = max(0.0_real32, a(i) - b(i)) end do else set_difference = a - b @@ -95,4 +95,4 @@ function set_difference(a, b, set_min_zero) end function set_difference !############################################################################### -end module misc_maths +end module raffle__misc_maths diff --git a/src/fortran/lib/mod_ml.f90 b/src/fortran/lib/mod_ml.f90 index 22546e35..06c20f2e 100644 --- a/src/fortran/lib/mod_ml.f90 +++ b/src/fortran/lib/mod_ml.f90 @@ -1,7 +1,7 @@ module machine_learning - use constants, only: real12 - use misc_linalg, only: modu - use rw_geom, only: basis_type + use raffle__constants, only: real32 + use raffle__misc_linalg, only: modu + use raffle__geom_rw, only: basis_type #ifdef ENABLE_ATHENA use athena use athena, only: graph_type, edge_type @@ -52,11 +52,11 @@ subroutine network_setup(num_inputs, num_outputs) ! activation_function = 'tanh' & ! )) ! call network%compile( & - ! optimiser = sgd_optimiser_type(learning_rate=1.E-3_real12, momentum=0.99_real12,& - ! clip_dict=clip_type(clip_min=0._real12, & - ! clip_max=1.E-4_real12), & - ! regulariser=l1l2_regulariser_type(l1=1.E-3_real12, & - ! l2=1.E-3_real12) & + ! optimiser = sgd_optimiser_type(learning_rate=1.E-3_real32, momentum=0.99_real32,& + ! clip_dict=clip_type(clip_min=0._real32, & + ! clip_max=1.E-4_real32), & + ! regulariser=l1l2_regulariser_type(l1=1.E-3_real32, & + ! l2=1.E-3_real32) & ! ), & ! loss_method = 'hubber', accuracy_method = 'rmse', verbose=1, & ! metrics = ['accuracy'] & @@ -81,30 +81,30 @@ subroutine network_setup(num_inputs, num_outputs) metric_dict%active = .false. metric_dict(1)%key = "loss" metric_dict(2)%key = "accuracy" - metric_dict%threshold = 1.E-1_real12 + metric_dict%threshold = 1.E-1_real32 call network%compile(optimiser=sgd_optimiser_type(), & loss_method="mse", metrics=metric_dict, & batch_size = 1, verbose = 0) call network%set_batch_size(1) - network%metrics%threshold = 1.E-3_real12 + network%metrics%threshold = 1.E-3_real32 end subroutine network_setup subroutine network_train(x, y, num_epochs) implicit none - real(real12), dimension(:,:), intent(in) :: x - real(real12), dimension(:), intent(in) :: y + real(real32), dimension(:,:), intent(in) :: x + real(real32), dimension(:), intent(in) :: y integer, intent(in) :: num_epochs - real(real12), dimension(:,:), allocatable :: y_renorm + real(real32), dimension(:,:), allocatable :: y_renorm allocate(y_renorm(1,size(y,1))) - y_renorm(1,:) = -1._real12 * y + y_renorm(1,:) = -1._real32 * y call renormalise_norm(y_renorm(1,:)) write(*,*) y_renorm(1,:) - call network%train(x, y_renorm, num_epochs=num_epochs, plateau_threshold=1.E-3_real12) + call network%train(x, y_renorm, num_epochs=num_epochs, plateau_threshold=1.E-3_real32) !write(*,*) y_renorm @@ -113,7 +113,7 @@ end subroutine network_train subroutine network_train_graph(graphs, labels, num_epochs) implicit none type(graph_type), dimension(:), intent(in) :: graphs - real(real12), dimension(:), intent(in) :: labels + real(real32), dimension(:), intent(in) :: labels integer, intent(in) :: num_epochs integer :: n, s @@ -129,7 +129,7 @@ subroutine network_train_graph(graphs, labels, num_epochs) type is (conv_mpnn_layer_type) call layer%set_graph(graphs(sample_list(s):sample_list(s))) end select - call network%forward(reshape([1._real12], [1,1])) + call network%forward(reshape([1._real32], [1,1])) call network%backward(reshape([labels(sample_list(s))], [1,1])) !call network%model(size(network%model,1))%layer%get_output(output_tmp) !write(*,*) "predicted",output_tmp(1,1), labels(sample_list(s)) @@ -144,8 +144,8 @@ end subroutine network_train_graph function network_predict(x) result(y) implicit none - real(real12), dimension(:,:), intent(in) :: x - real(real12), dimension(1,size(x,2)) :: y + real(real32), dimension(:,:), intent(in) :: x + real(real32), dimension(1,size(x,2)) :: y y = network%predict(x) @@ -154,17 +154,17 @@ end function network_predict function network_predict_graph(graphs) result(y) implicit none type(graph_type), dimension(:), intent(in) :: graphs - real(real12), dimension(size(graphs)) :: y + real(real32), dimension(size(graphs)) :: y integer :: s - real(real12), dimension(:,:), allocatable :: output_tmp + real(real32), dimension(:,:), allocatable :: output_tmp do s = 1, size(graphs) select type(layer => network%model(2)%layer) type is (conv_mpnn_layer_type) call layer%set_graph(graphs(s:s)) end select - call network%forward(reshape([1._real12], [1,1])) + call network%forward(reshape([1._real32], [1,1])) call network%model(size(network%model,1))%layer%get_output(output_tmp) y(s) = output_tmp(1,1) end do @@ -190,11 +190,11 @@ function get_graph_from_basis(basis) result(graph) !! Maximum number of lattice translations. type(edge_type) :: edge !! An edge in the graph. - real(real12) :: rtmp1 + real(real32) :: rtmp1 !! Temporary real. - real(real12) :: cutoff_min, cutoff_max + real(real32) :: cutoff_min, cutoff_max !! Cutoff radii. - real(real12), dimension(3) :: diff, vtmp1 + real(real32), dimension(3) :: diff, vtmp1 !! Difference vector and temporary vector. @@ -209,13 +209,13 @@ function get_graph_from_basis(basis) result(graph) do ia = 1, basis%spec(is)%num iatom = iatom + 1 allocate(graph%vertex(iatom)%feature(graph%num_vertex_features)) - graph%vertex(iatom)%feature = [ basis%spec(is)%charge / 100._real12, & - basis%spec(is)%mass / 52._real12 ] + graph%vertex(iatom)%feature = [ basis%spec(is)%charge / 100._real32, & + basis%spec(is)%mass / 52._real32 ] end do end do - cutoff_min = 0.5_real12 - cutoff_max = 6.0_real12 + cutoff_min = 0.5_real32 + cutoff_max = 6.0_real32 amax = ceiling(cutoff_max/modu(basis%lat(1,:))) bmax = ceiling(cutoff_max/modu(basis%lat(2,:))) cmax = ceiling(cutoff_max/modu(basis%lat(3,:))) @@ -231,13 +231,13 @@ function get_graph_from_basis(basis) result(graph) jatom = jatom + 1 if(is.eq.js.and.ja.lt.ia) cycle atom_loop2 diff = basis%spec(is)%atom(ia,:3) - basis%spec(js)%atom(ja,:3) - diff = diff - ceiling(diff - 0.5_real12) + diff = diff - ceiling(diff - 0.5_real32) do i=-amax,amax+1,1 - vtmp1(1) = diff(1) + real(i, real12) + vtmp1(1) = diff(1) + real(i, real32) do j=-bmax,bmax+1,1 - vtmp1(2) = diff(2) + real(j, real12) + vtmp1(2) = diff(2) + real(j, real32) do k=-cmax,cmax+1,1 - vtmp1(3) = diff(3) + real(k, real12) + vtmp1(3) = diff(3) + real(k, real32) rtmp1 = modu(matmul(vtmp1,basis%lat)) if( rtmp1 .gt. cutoff_min .and. & rtmp1 .lt. cutoff_max )then diff --git a/src/fortran/lib/mod_atom_adder.f90 b/src/fortran/lib/mod_place_methods.f90 similarity index 57% rename from src/fortran/lib/mod_atom_adder.f90 rename to src/fortran/lib/mod_place_methods.f90 index d23b9691..933bb17a 100644 --- a/src/fortran/lib/mod_atom_adder.f90 +++ b/src/fortran/lib/mod_place_methods.f90 @@ -1,41 +1,39 @@ -module add_atom - !! Module to add atoms to a cell. +module raffle__place_methods + !! Module containing the placement methods available within RAFFLE. !! - !! This module contains subroutines to add atoms to a cell using different - !! placement methods. The methods are: + !! This module contains procedures to query points for atom placement. + !! The available placement methods are: !! - void: place the atom in the gridpoint with the largest void space !! - rand: place the atom at a random gridpoint !! - walk: place the atom using a random walk method !! - growth: place the atom using a random walk, with last placement point !! as the starting point - !! - min: place the atom at the gridpoint with the highest suitability - use constants, only: real12, pi - use misc_linalg, only: modu, inverse_3x3 - use rw_geom, only: basis_type - use extended_geom, only: extended_basis_type - use edit_geom, only: & + !! - min: place the atom at the gridpoint with the highest viability + use raffle__constants, only: real32, pi + use raffle__misc_linalg, only: modu, inverse_3x3 + use raffle__geom_extd, only: extended_basis_type + use raffle__dist_calcs, only: & get_min_dist, & - get_min_dist_between_point_and_atom, & get_min_dist_between_point_and_species - use evaluator, only: evaluate_point - use evolver, only: gvector_container_type + use raffle__evaluator, only: evaluate_point + use raffle__distribs_container, only: distribs_container_type implicit none private public :: & - add_atom_void, add_atom_rand, & - add_atom_walk, add_atom_growth, & - add_atom_min - public :: get_gridpoints_and_viability, update_gridpoints_and_viability + place_method_void, place_method_rand, & + place_method_walk, place_method_growth, & + place_method_min contains !############################################################################### - function add_atom_void(grid, grid_offset, basis, atom_ignore_list, viable) & - result(point) + function place_method_void( & + grid, grid_offset, basis, atom_ignore_list, viable & + ) result(point) !! VOID placement method. !! !! This method returns the gridpoint with the lowest neighbour density. @@ -47,33 +45,34 @@ function add_atom_void(grid, grid_offset, basis, atom_ignore_list, viable) & !! Structure to add atom to. integer, dimension(3), intent(in) :: grid !! Number of gridpoints in each direction. - real(real12), dimension(3), intent(in) :: grid_offset + real(real32), dimension(3), intent(in) :: grid_offset !! Offset for gridpoints. integer, dimension(:,:), intent(in) :: atom_ignore_list !! List of atoms to ignore (i.e. indices of atoms not yet placed). logical, intent(out) :: viable !! Boolean to indicate if point is viable. - real(real12), dimension(3) :: point + real(real32), dimension(3) :: point !! Point to add atom to. ! Local variables integer :: i, j, k !! Loop indices. - real(real12), dimension(3) :: best_location + real(real32), dimension(3) :: best_location !! Index of best location to place atom. - real(real12) :: best_location_bond, smallest_bond + real(real32) :: best_location_bond, smallest_bond !! Bond lengths. - real(real12), dimension(3) :: tmpvector + real(real32), dimension(3) :: tmpvector !! Temporary vector for gridpoint. + + viable = .false. !--------------------------------------------------------------------------- ! loop over all gridpoints in the unit cell and find the one with the ... ! ... largest void space !--------------------------------------------------------------------------- - viable = .false. - best_location = 0._real12 - best_location_bond = -huge(1._real12) + best_location = 0._real32 + best_location_bond = -huge(1._real32) do i = 0, grid(1) - 1, 1 do j = 0, grid(2) - 1, 1 do k = 0, grid(3) - 1, 1 @@ -81,7 +80,7 @@ function add_atom_void(grid, grid_offset, basis, atom_ignore_list, viable) & i + grid_offset(1), & j + grid_offset(2), & k + grid_offset(3) & - ] / real(grid,real12) + ] / real(grid,real32) smallest_bond = modu(get_min_dist(& basis, tmpvector, .false., & ignore_list = atom_ignore_list)) @@ -93,17 +92,20 @@ function add_atom_void(grid, grid_offset, basis, atom_ignore_list, viable) & end do end do + + !--------------------------------------------------------------------------- ! return the gridpoint with the largest void space + !--------------------------------------------------------------------------- point = best_location viable = .true. - end function add_atom_void + end function place_method_void !############################################################################### !############################################################################### - function add_atom_rand( & - basis, atom_ignore_list, radius_list, max_attempts, viable& + function place_method_rand( distribs_container, & + basis, atom_ignore_list, radius_list, max_attempts, viable & ) result(point) !! Random placement method. !! @@ -111,23 +113,25 @@ function add_atom_rand( & implicit none ! Arguments + type(distribs_container_type), intent(in) :: distribs_container + !! Distribution function (gvector) container. type(extended_basis_type), intent(inout) :: basis !! Structure to add atom to. integer, dimension(:,:), intent(in) :: atom_ignore_list !! List of atoms to ignore (i.e. indices of atoms not yet placed). - real(real12), dimension(:), intent(in) :: radius_list + real(real32), dimension(:), intent(in) :: radius_list !! List of radii for each pair of elements. integer, intent(in) :: max_attempts !! Limit on number of attempts. logical, intent(out) :: viable !! Boolean to indicate if point is viable. - real(real12), dimension(3) :: point + real(real32), dimension(3) :: point !! Point to add atom to. ! Local variables integer :: i, j, is, js !! Loop indices. - real(real12) :: rtmp1 + real(real32) :: rtmp1 !! random number. logical :: ltmp1 !! logical variable. @@ -136,16 +140,23 @@ function add_atom_rand( & viable = .false. + !--------------------------------------------------------------------------- + ! get list of element pair indices + ! (i.e. the index for bond_info for each element pair) + !--------------------------------------------------------------------------- i = 0 do is = 1, basis%nspec - do js = is, basis%nspec, 1 - i = i + 1 - pair_index(js,is) = i - pair_index(is,js) = i + do js = 1, basis%nspec + pair_index(is, js) = distribs_container%get_pair_index( & + basis%spec(is)%name, basis%spec(js)%name & + ) end do end do - ! find a random gridpoint + + !--------------------------------------------------------------------------- + ! find a random gridpoint that is not too close to any other atom + !--------------------------------------------------------------------------- atom_loop: do i = 1, max_attempts do j = 1, 3 call random_number(rtmp1) @@ -165,14 +176,16 @@ function add_atom_rand( & exit atom_loop end do atom_loop - end function add_atom_rand + end function place_method_rand !############################################################################### !############################################################################### - function add_atom_walk( gvector_container, & + function place_method_walk( distribs_container, & basis, atom_ignore_list, & - radius_list, max_attempts, viable & + radius_list, max_attempts, & + step_size_coarse, step_size_fine, & + viable & ) result(point) !! Random walk placement method. !! @@ -186,19 +199,21 @@ function add_atom_walk( gvector_container, & implicit none ! Arguments - type(gvector_container_type), intent(in) :: gvector_container + type(distribs_container_type), intent(in) :: distribs_container !! Distribution function (gvector) container. type(extended_basis_type), intent(inout) :: basis !! Structure to add atom to. integer, intent(in) :: max_attempts !! Limit on number of attempts. + real(real32), intent(in) :: step_size_coarse, step_size_fine + !! Step sizes for random walk. logical, intent(out) :: viable !! Boolean to indicate if point is viable. integer, dimension(:,:), intent(in) :: atom_ignore_list !! List of atoms to ignore (i.e. indices of atoms not yet placed). - real(real12), dimension(:), intent(in) :: radius_list + real(real32), dimension(:), intent(in) :: radius_list !! List of radii for each pair of elements. - real(real12), dimension(3) :: point + real(real32), dimension(3) :: point !! Point to add atom to. ! Local variables @@ -206,15 +221,15 @@ function add_atom_walk( gvector_container, & !! Loop indices. integer :: nattempt, nstuck !! Number of attempts and number of times stuck at same site - real(real12) :: rtmp1 + real(real32) :: rtmp1 !! Random number. - real(real12), dimension(3) :: rvec1, abc + real(real32), dimension(3) :: rvec1, abc !! Random vector and lattice constants. - real(real12) :: crude_norm + real(real32) :: crude_norm !! Crude normalisation. - real(real12) :: site_value, test_value + real(real32) :: site_value, test_value !! Viability values. - real(real12), dimension(3) :: site_vector, test_vector + real(real32), dimension(3) :: site_vector, test_vector !! Vectors for gridpoints. @@ -231,7 +246,7 @@ function add_atom_walk( gvector_container, & i = i + 1 call random_number(site_vector) - site_value = evaluate_point( gvector_container, & + site_value = evaluate_point( distribs_container, & site_vector, atom_ignore_list(1,1), basis, & atom_ignore_list, radius_list & ) @@ -247,29 +262,40 @@ function add_atom_walk( gvector_container, & !--------------------------------------------------------------------------- nattempt = 0 nstuck = 0 - crude_norm = 0.5_real12 + crude_norm = 0.5_real32 walk_loop : do - call random_number(rtmp1) + !------------------------------------------------------------------------ + ! if we have tried 10 times, then we need to reduce the step size + ! get the new test point and map it back into the unit cell + !------------------------------------------------------------------------ + call random_number(rvec1) if(nattempt.ge.10) then test_vector = site_vector + & - ( rvec1 * 2._real12 - 1._real12 ) * 0.1_real12 / abc + ( rvec1 * 2._real32 - 1._real32 ) * step_size_fine / abc else test_vector = site_vector + & - ( rvec1 * 2._real12 - 1._real12 ) / abc + ( rvec1 * 2._real32 - 1._real32 ) * step_size_coarse / abc end if test_vector = test_vector - floor(test_vector) - test_value = evaluate_point( gvector_container, & + !------------------------------------------------------------------------ + ! evaluate the test point + !------------------------------------------------------------------------ + test_value = evaluate_point( distribs_container, & test_vector, atom_ignore_list(1,1), basis, & atom_ignore_list, radius_list & ) + !------------------------------------------------------------------------ + ! if viability of test point is less than current point, then we + ! are stuck at the current point and need to try again + !------------------------------------------------------------------------ if(test_value.lt.site_value) then nstuck = nstuck + 1 if(nstuck.ge.10) then nattempt = nattempt + 1 if(crude_norm.lt.site_value) & crude_norm = & - ( crude_norm + site_value/real(nattempt) ) / 2._real12 + ( crude_norm + site_value/real(nattempt) ) / 2._real32 ! if we have tried 10 times, and still no luck, then we need to ! reduce the tolerance @@ -292,15 +318,17 @@ function add_atom_walk( gvector_container, & point = site_vector viable=.true. - end function add_atom_walk + end function place_method_walk !############################################################################### !############################################################################### - function add_atom_growth( gvector_container, & + function place_method_growth( distribs_container, & prior_point, prior_species, & basis, atom_ignore_list, & - radius_list, max_attempts, viable & + radius_list, max_attempts, & + step_size_coarse, step_size_fine, & + viable & ) result(point) !! Random walk placement method. !! @@ -314,9 +342,9 @@ function add_atom_growth( gvector_container, & implicit none ! Arguments - type(gvector_container_type), intent(in) :: gvector_container + type(distribs_container_type), intent(in) :: distribs_container !! Distribution function (gvector) container. - real(real12), dimension(3), intent(in) :: prior_point + real(real32), dimension(3), intent(in) :: prior_point !! Point to start walk from. integer, intent(in) :: prior_species !! Species of last atom placed. @@ -324,13 +352,15 @@ function add_atom_growth( gvector_container, & !! Structure to add atom to. integer, intent(in) :: max_attempts !! Limit on number of attempts. + real(real32), intent(in) :: step_size_coarse, step_size_fine + !! Step sizes for random walk. logical, intent(out) :: viable !! Boolean to indicate if point is viable. integer, dimension(:,:), intent(in) :: atom_ignore_list !! List of atoms to ignore (i.e. indices of atoms not yet placed). - real(real12), dimension(:), intent(in) :: radius_list + real(real32), dimension(:), intent(in) :: radius_list !! List of radii for each pair of elements. - real(real12), dimension(3) :: point + real(real32), dimension(3) :: point !! Point to add atom to. ! Local variables @@ -338,17 +368,17 @@ function add_atom_growth( gvector_container, & !! Loop indices. integer :: nattempt, nstuck !! Number of attempts and number of times stuck at same site - real(real12) :: rtmp1, min_radius + real(real32) :: rtmp1, min_radius !! Random number and minimum radius. - real(real12), dimension(3) :: rvec1, abc + real(real32), dimension(3) :: rvec1, abc !! Random vector and lattice constants. - real(real12) :: crude_norm + real(real32) :: crude_norm !! Crude normalisation. - real(real12) :: site_value, test_value + real(real32) :: site_value, test_value !! Viability values. - real(real12), dimension(3) :: site_vector, test_vector + real(real32), dimension(3) :: site_vector, test_vector !! Vectors for gridpoints. - real(real12), dimension(3,3) :: inverse_lattice + real(real32), dimension(3,3) :: inverse_lattice viable = .false. @@ -365,17 +395,11 @@ function add_atom_growth( gvector_container, & !--------------------------------------------------------------------------- ! get the index of the pair of species !--------------------------------------------------------------------------- - idx = nint( & - ( & - basis%nspec - & - min( prior_species, atom_ignore_list(1,1) & - ) / 2._real12 ) * & - ( & - min( prior_species, atom_ignore_list(1,1) ) - & - 1._real12 & - ) + max( prior_species, atom_ignore_list(1,1) ) & + idx = distribs_container%get_pair_index( & + basis%spec(prior_species)%name, & + basis%spec(atom_ignore_list(1,1))%name & ) - min_radius = radius_list(idx) * gvector_container%radius_distance_tol(1) + min_radius = radius_list(idx) * distribs_container%radius_distance_tol(1) !--------------------------------------------------------------------------- @@ -387,7 +411,7 @@ function add_atom_growth( gvector_container, & call random_number(rvec1) ! map rvec1(1) to ring between min_radius and min_radius + 1.0 rvec1(1) = rvec1(1) + min_radius ! r - rvec1(2) = rvec1(2) * 2._real12 * pi ! theta + rvec1(2) = rvec1(2) * 2._real32 * pi ! theta rvec1(3) = rvec1(3) * pi ! phi ! convert from spherical to cartesian rvec1 = [ & @@ -399,7 +423,7 @@ function add_atom_growth( gvector_container, & rvec1 = matmul(rvec1, inverse_lattice) site_vector = prior_point + rvec1 ! now evaluate the point and check if it passes the initial criteria - site_value = evaluate_point( gvector_container, & + site_value = evaluate_point( distribs_container, & site_vector, atom_ignore_list(1,1), basis, & atom_ignore_list, radius_list & ) @@ -415,29 +439,40 @@ function add_atom_growth( gvector_container, & !--------------------------------------------------------------------------- nattempt = 0 nstuck = 0 - crude_norm = 0.5_real12 + crude_norm = 0.5_real32 walk_loop : do - call random_number(rtmp1) + !------------------------------------------------------------------------ + ! if we have tried 10 times, then we need to reduce the step size + ! get the new test point and map it back into the unit cell + !------------------------------------------------------------------------ + call random_number(rvec1) if(nattempt.ge.10) then test_vector = site_vector + & - ( rvec1 * 2._real12 - 1._real12 ) * 0.1_real12 / abc + ( rvec1 * 2._real32 - 1._real32 ) * step_size_fine / abc else test_vector = site_vector + & - ( rvec1 * 2._real12 - 1._real12 ) / abc + ( rvec1 * 2._real32 - 1._real32 ) * step_size_coarse / abc end if test_vector = test_vector - floor(test_vector) - test_value = evaluate_point( gvector_container, & + !------------------------------------------------------------------------ + ! evaluate the test point + !------------------------------------------------------------------------ + test_value = evaluate_point( distribs_container, & test_vector, atom_ignore_list(1,1), basis, & atom_ignore_list, radius_list & ) + !------------------------------------------------------------------------ + ! if viability of test point is less than current point, then we + ! are stuck at the current point and need to try again + !------------------------------------------------------------------------ if(test_value.lt.site_value) then nstuck = nstuck + 1 if(nstuck.ge.10) then nattempt = nattempt + 1 if(crude_norm.lt.site_value) & crude_norm = & - ( crude_norm + site_value/real(nattempt) ) / 2._real12 + ( crude_norm + site_value/real(nattempt) ) / 2._real32 ! if we have tried 10 times, and still no luck, then we need to ! reduce the tolerance @@ -460,12 +495,13 @@ function add_atom_growth( gvector_container, & point = site_vector viable=.true. - end function add_atom_growth + end function place_method_growth !############################################################################### !############################################################################### - function add_atom_min(points, species, & + function place_method_min( & + points, species, & species_index_list, viable & ) result(point) !! Global minimum placement method. @@ -481,9 +517,9 @@ function add_atom_min(points, species, & !! Species index to add atom to. integer, dimension(:), intent(in) :: species_index_list !! List of species indices to add atoms to. - real(real12), dimension(:,:), intent(in) :: points + real(real32), dimension(:,:), intent(in) :: points !! List of gridpoints to consider. - real(real12), dimension(3) :: point + real(real32), dimension(3) :: point !! Point to add atom to. ! Local variables @@ -495,7 +531,9 @@ function add_atom_min(points, species, & viable = .false. - ! find the gridpoint with the highest suitability + !--------------------------------------------------------------------------- + ! find the gridpoint with the highest viability + !--------------------------------------------------------------------------- species_index = findloc(species_index_list, species, 1) best_gridpoint = maxloc(points(3+species_index,:), dim=1) if(best_gridpoint.eq.0)then @@ -504,204 +542,13 @@ function add_atom_min(points, species, & return end if - ! return the gridpoint with the highest suitability - point = points(1:3,best_gridpoint) - viable = .true. - - end function add_atom_min -!############################################################################### - - -!############################################################################### - function get_gridpoints_and_viability(gvector_container, grid, basis, & - species_index_list, & - radius_list, atom_ignore_list, grid_offset) result(points) - !! Return a list of viable gridpoints and their viability for each species. - !! - !! This function returns the viability of all viable gridpoints. - implicit none - - ! Arguments - type(gvector_container_type), intent(in) :: gvector_container - !! Distribution function (gvector) container. - type(extended_basis_type), intent(in) :: basis - !! Structure to add atom to. - integer, dimension(3), intent(in) :: grid - !! Number of gridpoints in each direction. - real(real12), dimension(:), intent(in) :: radius_list - !! List of radii for each pair of elements. - integer, dimension(:), intent(in) :: species_index_list - !! List of species indices to add atoms to. - integer, dimension(:,:), intent(in) :: atom_ignore_list - !! List of atoms to ignore (i.e. indices of atoms not yet placed). - real(real12), dimension(3), intent(in) :: grid_offset - !! Offset for gridpoints. - real(real12), dimension(:,:), allocatable :: points - !! List of gridpoints. - - ! Local variables - integer :: i, j, k, l, is, ia - !! Loop indices. - integer :: num_points - !! Number of gridpoints. - real(real12) :: min_radius - !! Minimum radius. - real(real12), dimension(:,:), allocatable :: points_tmp - !! Temporary list of gridpoints. - - - !--------------------------------------------------------------------------- - ! loop over all gridpoints in the unit cell and check if they are too ... - ! ... close to an existing atom. If they are, remove them from the list ... - ! ... of viable gridpoints - !--------------------------------------------------------------------------- - min_radius = minval(radius_list) * gvector_container%radius_distance_tol(1) - allocate(points_tmp(3,product(grid))) - num_points = 0 - grid_loop1: do i = 0, grid(1) - 1, 1 - grid_loop2: do j = 0, grid(2) - 1, 1 - grid_loop3: do k = 0, grid(3) - 1, 1 - do is = 1, basis%nspec - atom_loop: do ia = 1, basis%spec(is)%num - do l = 1, size(atom_ignore_list,dim=1), 1 - if(all(atom_ignore_list(l,:).eq.[is,ia])) cycle atom_loop - end do - if( get_min_dist_between_point_and_atom( & - basis, & - [ & - i + grid_offset(1), & - j + grid_offset(2), & - k + grid_offset(3) & - ] / & - real(grid,real12), & - [is,ia] & - ) .lt. & - min_radius & - ) cycle grid_loop3 - end do atom_loop - end do - num_points = num_points + 1 - points_tmp(:,num_points) = [ & - i + grid_offset(1), & - j + grid_offset(2), & - k + grid_offset(3) & - ] / real(grid,real12) - end do grid_loop3 - end do grid_loop2 - end do grid_loop1 - allocate(points( 3 + basis%nspec, num_points), source = 0._real12) - points(1:3,:) = points_tmp(1:3,1:num_points) - - deallocate(points_tmp) - - !--------------------------------------------------------------------------- - ! run evaluate_point for a set of points in the unit cell + ! return the gridpoint with the highest viability !--------------------------------------------------------------------------- - !do concurrent( i = 1:size(gridpoints,dim=2) ) - do i = 1, size(points,dim=2) - do is = 1, size(species_index_list,1) - points(3+is,i) = & - evaluate_point( gvector_container, & - points(1:3,i), species_index_list(is), basis, & - atom_ignore_list, radius_list & - ) - end do - end do - - end function get_gridpoints_and_viability -!############################################################################### - - -!############################################################################### - subroutine update_gridpoints_and_viability(points, gvector_container, basis, & - species_index_list, & - atom, radius_list, atom_ignore_list) - !! Update the list of viable gridpoints and their viability for each - !! species. - !! - !! This subroutine updates the viability of all viable gridpoints. - implicit none - - ! Arguments - real(real12), dimension(:,:), allocatable, intent(inout) :: points - !! List of gridpoints. - type(gvector_container_type), intent(in) :: gvector_container - !! Distribution function (gvector) container. - type(extended_basis_type), intent(in) :: basis - !! Structure to add atom to. - integer, dimension(2), intent(in) :: atom - !! Index of atom to add. - real(real12), dimension(:), intent(in) :: radius_list - !! List of radii for each pair of elements. - integer, dimension(:), intent(in) :: species_index_list - !! List of species indices to add atoms to. - integer, dimension(:,:), intent(in) :: atom_ignore_list - !! List of atoms to ignore (i.e. indices of atoms not yet placed). - - ! Local variables - integer :: i, j, is - !! Loop indices. - integer :: num_points - !! Number of gridpoints. - real(real12) :: min_radius - !! Minimum radius. - real(real12) :: distance - !! Distance between atom and gridpoint. - logical, dimension(size(points,dim=2)) :: viable - !! Temporary list of gridpoints. - real(real12), dimension(:,:), allocatable :: points_tmp - !! Temporary list of gridpoints. - - - !--------------------------------------------------------------------------- - ! run evaluate_point for a set of points in the unit cell - !--------------------------------------------------------------------------- - if(.not.allocated(points)) return - num_points = size(points,dim=2) + point = points(1:3,best_gridpoint) viable = .true. - !do concurrent( i = 1:size(gridpoints,dim=2) ) - min_radius = minval(radius_list) * gvector_container%radius_distance_tol(1) - associate( atom_pos => [ basis%spec(atom(1))%atom(atom(2),1:3) ] ) - do i = 1, num_points - distance = modu( matmul( atom_pos - points(1:3,i), basis%lat ) ) - if( distance .lt. min_radius )then - points(4:,i) = 0._real12 - viable(i) = .false. - cycle - elseif( distance .gt. gvector_container%cutoff_max(1) )then - points(4:,i) = 0._real12 - cycle - end if - do is = 1, size(species_index_list,1) - points(3+is,i) = & - evaluate_point( gvector_container, & - points(1:3,i), species_index_list(is), basis, & - atom_ignore_list, radius_list & - ) - end do - end do - end associate - - num_points = count(viable) - if(num_points.lt.1)then - deallocate(points) - return - end if - allocate(points_tmp(3+basis%nspec,num_points)) - - i = 0 - j = 0 - do while (i .lt. num_points) - j = j + 1 - if(.not.viable(j)) cycle - i = i + 1 - points_tmp(:,i) = points(:,j) - end do - deallocate(points) - allocate(points, source = points_tmp) - - end subroutine update_gridpoints_and_viability + + end function place_method_min !############################################################################### -end module add_atom \ No newline at end of file +end module raffle__place_methods \ No newline at end of file diff --git a/src/fortran/lib/mod_viability.f90 b/src/fortran/lib/mod_viability.f90 new file mode 100644 index 00000000..1ca9858c --- /dev/null +++ b/src/fortran/lib/mod_viability.f90 @@ -0,0 +1,214 @@ +module raffle__viability + !! Module to determine the viability of a set of gridpoints + !! + !! This module contains procedures to determine the viability of a set of + !! points and update the viability based on new atoms being added to the cell. + use raffle__constants, only: real32 + use raffle__misc_linalg, only: modu + use raffle__geom_extd, only: extended_basis_type + use raffle__dist_calcs, only: get_min_dist_between_point_and_atom + use raffle__evaluator, only: evaluate_point + use raffle__distribs_container, only: distribs_container_type + implicit none + + + private + + public :: get_gridpoints_and_viability, update_gridpoints_and_viability + + +contains + +!############################################################################### + function get_gridpoints_and_viability(distribs_container, grid, basis, & + species_index_list, & + radius_list, atom_ignore_list, grid_offset) result(points) + !! Return a list of viable gridpoints and their viability for each species. + !! + !! This function returns the viability of all viable gridpoints. + implicit none + + ! Arguments + type(distribs_container_type), intent(in) :: distribs_container + !! Distribution function (gvector) container. + type(extended_basis_type), intent(in) :: basis + !! Structure to add atom to. + integer, dimension(3), intent(in) :: grid + !! Number of gridpoints in each direction. + real(real32), dimension(:), intent(in) :: radius_list + !! List of radii for each pair of elements. + integer, dimension(:), intent(in) :: species_index_list + !! List of species indices to add atoms to. + integer, dimension(:,:), intent(in) :: atom_ignore_list + !! List of atoms to ignore (i.e. indices of atoms not yet placed). + real(real32), dimension(3), intent(in) :: grid_offset + !! Offset for gridpoints. + real(real32), dimension(:,:), allocatable :: points + !! List of gridpoints. + + ! Local variables + integer :: i, j, k, l, is, ia + !! Loop indices. + integer :: num_points + !! Number of gridpoints. + real(real32) :: min_radius + !! Minimum radius. + real(real32), dimension(:,:), allocatable :: points_tmp + !! Temporary list of gridpoints. + + + !--------------------------------------------------------------------------- + ! loop over all gridpoints in the unit cell and check if they are too ... + ! ... close to an existing atom. If they are, remove them from the list ... + ! ... of viable gridpoints + !--------------------------------------------------------------------------- + min_radius = minval(radius_list) * distribs_container%radius_distance_tol(1) + allocate(points_tmp(3,product(grid))) + num_points = 0 + grid_loop1: do i = 0, grid(1) - 1, 1 + grid_loop2: do j = 0, grid(2) - 1, 1 + grid_loop3: do k = 0, grid(3) - 1, 1 + do is = 1, basis%nspec + atom_loop: do ia = 1, basis%spec(is)%num + do l = 1, size(atom_ignore_list,dim=1), 1 + if(all(atom_ignore_list(l,:).eq.[is,ia])) cycle atom_loop + end do + if( get_min_dist_between_point_and_atom( & + basis, & + [ & + i + grid_offset(1), & + j + grid_offset(2), & + k + grid_offset(3) & + ] / & + real(grid,real32), & + [is,ia] & + ) .lt. & + min_radius & + ) cycle grid_loop3 + end do atom_loop + end do + num_points = num_points + 1 + points_tmp(:,num_points) = [ & + i + grid_offset(1), & + j + grid_offset(2), & + k + grid_offset(3) & + ] / real(grid,real32) + end do grid_loop3 + end do grid_loop2 + end do grid_loop1 + allocate(points( 3 + basis%nspec, num_points), source = 0._real32) + points(1:3,:) = points_tmp(1:3,1:num_points) + + deallocate(points_tmp) + + + !--------------------------------------------------------------------------- + ! run evaluate_point for a set of points in the unit cell + !--------------------------------------------------------------------------- + !do concurrent( i = 1:size(gridpoints,dim=2) ) + do i = 1, size(points,dim=2) + do is = 1, size(species_index_list,1) + points(3+is,i) = & + evaluate_point( distribs_container, & + points(1:3,i), species_index_list(is), basis, & + atom_ignore_list, radius_list & + ) + end do + end do + + end function get_gridpoints_and_viability +!############################################################################### + + +!############################################################################### + subroutine update_gridpoints_and_viability(points, distribs_container, basis, & + species_index_list, & + atom, radius_list, atom_ignore_list) + !! Update the list of viable gridpoints and their viability for each + !! species. + !! + !! This subroutine updates the viability of all viable gridpoints. + implicit none + + ! Arguments + real(real32), dimension(:,:), allocatable, intent(inout) :: points + !! List of gridpoints. + type(distribs_container_type), intent(in) :: distribs_container + !! Distribution function (gvector) container. + type(extended_basis_type), intent(in) :: basis + !! Structure to add atom to. + integer, dimension(2), intent(in) :: atom + !! Index of atom to add. + real(real32), dimension(:), intent(in) :: radius_list + !! List of radii for each pair of elements. + integer, dimension(:), intent(in) :: species_index_list + !! List of species indices to add atoms to. + integer, dimension(:,:), intent(in) :: atom_ignore_list + !! List of atoms to ignore (i.e. indices of atoms not yet placed). + + ! Local variables + integer :: i, j, is + !! Loop indices. + integer :: num_points + !! Number of gridpoints. + real(real32) :: min_radius + !! Minimum radius. + real(real32) :: distance + !! Distance between atom and gridpoint. + logical, dimension(size(points,dim=2)) :: viable + !! Temporary list of gridpoints. + real(real32), dimension(:,:), allocatable :: points_tmp + !! Temporary list of gridpoints. + + + !--------------------------------------------------------------------------- + ! run evaluate_point for a set of points in the unit cell + !--------------------------------------------------------------------------- + if(.not.allocated(points)) return + num_points = size(points,dim=2) + viable = .true. + !do concurrent( i = 1:size(gridpoints,dim=2) ) + min_radius = minval(radius_list) * distribs_container%radius_distance_tol(1) + associate( atom_pos => [ basis%spec(atom(1))%atom(atom(2),1:3) ] ) + do i = 1, num_points + distance = modu( matmul( atom_pos - points(1:3,i), basis%lat ) ) + if( distance .lt. min_radius )then + points(4:,i) = 0._real32 + viable(i) = .false. + cycle + elseif( distance .gt. distribs_container%cutoff_max(1) )then + points(4:,i) = 0._real32 + cycle + end if + do is = 1, size(species_index_list,1) + points(3+is,i) = & + evaluate_point( distribs_container, & + points(1:3,i), species_index_list(is), basis, & + atom_ignore_list, radius_list & + ) + end do + end do + end associate + + num_points = count(viable) + if(num_points.lt.1)then + deallocate(points) + return + end if + allocate(points_tmp(3+basis%nspec,num_points)) + + i = 0 + j = 0 + do while (i .lt. num_points) + j = j + 1 + if(.not.viable(j)) cycle + i = i + 1 + points_tmp(:,i) = points(:,j) + end do + deallocate(points) + allocate(points, source = points_tmp) + + end subroutine update_gridpoints_and_viability +!############################################################################### + +end module raffle__viability \ No newline at end of file diff --git a/src/fortran/raffle.f90 b/src/fortran/raffle.f90 index 507f71fc..d0c6f8a6 100644 --- a/src/fortran/raffle.f90 +++ b/src/fortran/raffle.f90 @@ -1,13 +1,14 @@ module raffle - use constants, only: real12 - use generator, only: raffle_generator_type - use evolver, only: gvector_container_type + use raffle__constants, only: real32 + use raffle__io_utils, only: raffle__version__ + use raffle__generator, only: raffle_generator_type + use raffle__distribs_container, only: distribs_container_type implicit none private - public :: real12 - public :: gvector_container_type + public :: real32 + public :: distribs_container_type public :: raffle_generator_type diff --git a/src/raffle/__init__.py b/src/raffle/__init__.py index f20424d2..82620a22 100644 --- a/src/raffle/__init__.py +++ b/src/raffle/__init__.py @@ -12,7 +12,7 @@ __version__ = "unknown" from .raffle import generator as _generator_class -from .raffle import rw_geom as _rw_geom_class +from .raffle import geom_rw as _geom_rw_class # from .raffle import generator @@ -26,8 +26,8 @@ generator.stoichiometry_array = _generator_class.stoichiometry_array # Assign the class to the simulated 'geom' module -geom.basis_array = _rw_geom_class.basis_array -geom.basis = _rw_geom_class.basis +geom.basis_array = _geom_rw_class.basis_array +geom.basis = _geom_rw_class.basis # Add the simulated 'generator' module to the current package @@ -37,7 +37,7 @@ # Clean up internal imports (remove access to the direct classes) del _generator_class -del _rw_geom_class +del _geom_rw_class del PackageNotFoundError del version del sys diff --git a/src/raffle/raffle.py b/src/raffle/raffle.py index a731fc2f..a835306c 100644 --- a/src/raffle/raffle.py +++ b/src/raffle/raffle.py @@ -4,12 +4,12 @@ import logging import numpy -class Rw_Geom(f90wrap.runtime.FortranModule): +class Geom_Rw(f90wrap.runtime.FortranModule): """ - Module rw_geom + Module geom_rw - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 13-968 """ @@ -19,7 +19,7 @@ class species_type(f90wrap.runtime.FortranDerivedType): Type(name=species_type) - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 26-32 """ @@ -28,7 +28,7 @@ def __init__(self, handle=None): self = species_type() - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 26-32 @@ -41,7 +41,7 @@ def __init__(self, handle=None): Automatically generated constructor for species_type """ f90wrap.runtime.FortranDerivedType.__init__(self) - result = _raffle.f90wrap_rw_geom__species_type_initialise() + result = _raffle.f90wrap_geom_rw__species_type_initialise() self._handle = result[0] if isinstance(result, tuple) else result def __del__(self): @@ -49,7 +49,7 @@ def __del__(self): Destructor for class species_type - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 26-32 Parameters @@ -61,15 +61,15 @@ def __del__(self): Automatically generated destructor for species_type """ if self._alloc: - _raffle.f90wrap_rw_geom__species_type_finalise(this=self._handle) + _raffle.f90wrap_geom_rw__species_type_finalise(this=self._handle) @property def atom(self): """ - Element atom ftype=real(real12) pytype=float + Element atom ftype=real(real32) pytype=float - Defined at ../src/lib/mod_rw_geom.f90 line 27 + Defined at ../src/lib/mod_geom_rw.f90 line 27 """ array_ndim, array_type, array_shape, array_handle = \ @@ -90,10 +90,10 @@ def atom(self, atom): @property def mass(self): """ - Element mass ftype=real(real12) pytype=float + Element mass ftype=real(real32) pytype=float - Defined at ../src/lib/mod_rw_geom.f90 line 28 + Defined at ../src/lib/mod_geom_rw.f90 line 28 """ return _raffle.f90wrap_species_type__get__mass(self._handle) @@ -105,10 +105,10 @@ def mass(self, mass): @property def charge(self): """ - Element charge ftype=real(real12) pytype=float + Element charge ftype=real(real32) pytype=float - Defined at ../src/lib/mod_rw_geom.f90 line 29 + Defined at ../src/lib/mod_geom_rw.f90 line 29 """ return _raffle.f90wrap_species_type__get__charge(self._handle) @@ -116,10 +116,10 @@ def charge(self): @property def radius(self): """ - Element radius ftype=real(real12) pytype=float + Element radius ftype=real(real32) pytype=float - Defined at ../src/lib/mod_rw_geom.f90 line 29 + Defined at ../src/lib/mod_geom_rw.f90 line 29 """ return _raffle.f90wrap_species_type__get__radius(self._handle) @@ -138,7 +138,7 @@ def name(self): Element name ftype=character(len=3) pytype=str - Defined at ../src/lib/mod_rw_geom.f90 line 30 + Defined at ../src/lib/mod_geom_rw.f90 line 30 """ return _raffle.f90wrap_species_type__get__name(self._handle) @@ -153,7 +153,7 @@ def num(self): Element num ftype=integer pytype=int - Defined at ../src/lib/mod_rw_geom.f90 line 31 + Defined at ../src/lib/mod_geom_rw.f90 line 31 """ return _raffle.f90wrap_species_type__get__num(self._handle) @@ -186,7 +186,7 @@ class basis(f90wrap.runtime.FortranDerivedType): Type(name=basis) - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 34-42 """ @@ -195,7 +195,7 @@ def __init__(self, atoms=None, handle=None): self = basis() - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 34-42 @@ -208,7 +208,7 @@ def __init__(self, atoms=None, handle=None): Automatically generated constructor for basis """ f90wrap.runtime.FortranDerivedType.__init__(self) - result = _raffle.f90wrap_rw_geom__basis_type_initialise() + result = _raffle.f90wrap_geom_rw__basis_type_initialise() self._handle = result[0] if isinstance(result, tuple) else result if atoms is not None: @@ -219,7 +219,7 @@ def __del__(self): Destructor for class basis - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 34-42 Parameters @@ -231,7 +231,7 @@ def __del__(self): Automatically generated destructor for basis """ if self._alloc: - _raffle.f90wrap_rw_geom__basis_type_finalise(this=self._handle) + _raffle.f90wrap_geom_rw__basis_type_finalise(this=self._handle) def allocate_species(self, num_species=None, species_symbols=None, species_count=None, \ positions=None): @@ -240,7 +240,7 @@ def allocate_species(self, num_species=None, species_symbols=None, species_count species_count, atoms]) - Defined at ../src/lib/mod_rw_geom.f90 lines \ + Defined at ../src/lib/mod_geom_rw.f90 lines \ 47-74 Parameters @@ -252,7 +252,7 @@ def allocate_species(self, num_species=None, species_symbols=None, species_count atoms : float array """ - _raffle.f90wrap_rw_geom__allocate_species__binding__basis_type(this=self._handle, \ + _raffle.f90wrap_geom_rw__allocate_species__binding__basis_type(this=self._handle, \ num_species=num_species, species_symbols=species_symbols, species_count=species_count, \ atoms=positions) @@ -265,9 +265,9 @@ def _init_array_spec(self): Element spec ftype=type(species_type) pytype=species_type - Defined at ../src/lib/mod_rw_geom.f90 line 35 + Defined at ../src/lib/mod_geom_rw.f90 line 35 - """, Rw_Geom.species_type) + """, Geom_Rw.species_type) return self.spec def toase(self, calculator=None): @@ -337,7 +337,7 @@ def nspec(self): Element nspec ftype=integer pytype=int - Defined at ../src/lib/mod_rw_geom.f90 line 36 + Defined at ../src/lib/mod_geom_rw.f90 line 36 """ return _raffle.f90wrap_basis_type__get__nspec(self._handle) @@ -352,7 +352,7 @@ def natom(self): Element natom ftype=integer pytype=int - Defined at ../src/lib/mod_rw_geom.f90 line 37 + Defined at ../src/lib/mod_geom_rw.f90 line 37 """ return _raffle.f90wrap_basis_type__get__natom(self._handle) @@ -364,10 +364,10 @@ def natom(self, natom): @property def energy(self): """ - Element energy ftype=real(real12) pytype=float + Element energy ftype=real(real32) pytype=float - Defined at ../src/lib/mod_rw_geom.f90 line 38 + Defined at ../src/lib/mod_geom_rw.f90 line 38 """ return _raffle.f90wrap_basis_type__get__energy(self._handle) @@ -379,10 +379,10 @@ def energy(self, energy): @property def lat(self): """ - Element lat ftype=real(real12) pytype=float + Element lat ftype=real(real32) pytype=float - Defined at ../src/lib/mod_rw_geom.f90 line 38 + Defined at ../src/lib/mod_geom_rw.f90 line 38 """ array_ndim, array_type, array_shape, array_handle = \ @@ -406,7 +406,7 @@ def lcart(self): Element lcart ftype=logical pytype=bool - Defined at ../src/lib/mod_rw_geom.f90 line 39 + Defined at ../src/lib/mod_geom_rw.f90 line 39 """ return _raffle.f90wrap_basis_type__get__lcart(self._handle) @@ -421,7 +421,7 @@ def pbc(self): Element pbc ftype=logical pytype=bool - Defined at ../src/lib/mod_rw_geom.f90 line 40 + Defined at ../src/lib/mod_geom_rw.f90 line 40 """ array_ndim, array_type, array_shape, array_handle = \ @@ -445,7 +445,7 @@ def sysname(self): Element sysname ftype=character(len=1024) pytype=str - Defined at ../src/lib/mod_rw_geom.f90 line 41 + Defined at ../src/lib/mod_geom_rw.f90 line 41 """ return _raffle.f90wrap_basis_type__get__sysname(self._handle) @@ -506,7 +506,7 @@ def __init__(self, atoms=None, handle=None): """ f90wrap.runtime.FortranDerivedType.__init__(self) - result = _raffle.f90wrap_rw_geom__basis_type_xnum_array_initialise() + result = _raffle.f90wrap_geom_rw__basis_type_xnum_array_initialise() self._handle = result[0] if isinstance(result, tuple) else result @@ -538,7 +538,7 @@ def __del__(self): Automatically generated destructor for basis_array """ if self._alloc: - _raffle.f90wrap_rw_geom__basis_type_xnum_array_finalise(this=self._handle) + _raffle.f90wrap_geom_rw__basis_type_xnum_array_finalise(this=self._handle) def _init_array_items(self): self.items = f90wrap.runtime.FortranDerivedTypeArray(self, @@ -551,7 +551,7 @@ def _init_array_items(self): Defined at line 0 - """, Rw_Geom.basis) + """, Geom_Rw.basis) return self.items def toase(self): @@ -581,507 +581,72 @@ def deallocate(self): _raffle.f90wrap_basis_type_xnum_array__array_dealloc__items(self._handle) _dt_array_initialisers = [_init_array_items] - - - # @staticmethod - # def geom_read(unit, lat, bas, length=None): - # """ - # geom_read(unit, lat, bas[, length]) - - - # Defined at ../src/lib/mod_rw_geom.f90 lines \ - # 79-111 - - # Parameters - # ---------- - # unit : int - # lat : float array - # bas : basis - # length : int - - # """ - # _raffle.f90wrap_rw_geom__geom_read(unit=unit, lat=lat, bas=bas._handle, \ - # length=length) - - # @staticmethod - # def geom_write(unit, lat, bas): - # """ - # geom_write(unit, lat, bas) - - - # Defined at ../src/lib/mod_rw_geom.f90 lines \ - # 117-139 - - # Parameters - # ---------- - # unit : int - # lat : float array - # bas : basis - - # """ - # _raffle.f90wrap_rw_geom__geom_write(unit=unit, lat=lat, bas=bas._handle) - - # @staticmethod - # def convert_bas(self, latconv): - # """ - # outbas = convert_bas(self, latconv) - - - # Defined at ../src/lib/mod_rw_geom.f90 lines \ - # 821-840 - - # Parameters - # ---------- - # inbas : basis - # latconv : float array - - # Returns - # ------- - # outbas : basis - - # """ - # outbas = _raffle.f90wrap_rw_geom__convert_bas(inbas=self._handle, \ - # latconv=latconv) - # outbas = f90wrap.runtime.lookup_class("raffle.basis").from_handle(outbas, \ - # alloc=True) - # return outbas - - # @staticmethod - # def clone_bas(self, outbas, inlat=None, outlat=None, trans_dim=None): - # """ - # clone_bas(self, outbas[, inlat, outlat, trans_dim]) - - - # Defined at ../src/lib/mod_rw_geom.f90 lines \ - # 897-967 - - # Parameters - # ---------- - # inbas : basis - # outbas : basis - # inlat : float array - # outlat : float array - # trans_dim : bool - - # ----------------------------------------------------------------------------- - # determines whether user wants output basis extra translational dimension - # ----------------------------------------------------------------------------- - # """ - # _raffle.f90wrap_rw_geom__clone_bas(inbas=self._handle, outbas=outbas._handle, \ - # inlat=inlat, outlat=outlat, trans_dim=trans_dim) - - # @property - # def igeom_input(self): - # """ - # Element igeom_input ftype=integer pytype=int - - - # Defined at ../src/lib/mod_rw_geom.f90 line 24 - - # """ - # return _raffle.f90wrap_rw_geom__get__igeom_input() - - # @igeom_input.setter - # def igeom_input(self, igeom_input): - # _raffle.f90wrap_rw_geom__set__igeom_input(igeom_input) - - # @property - # def igeom_output(self): - # """ - # Element igeom_output ftype=integer pytype=int - - - # Defined at ../src/lib/mod_rw_geom.f90 line 24 - - # """ - # return _raffle.f90wrap_rw_geom__get__igeom_output() - - # @igeom_output.setter - # def igeom_output(self, igeom_output): - # _raffle.f90wrap_rw_geom__set__igeom_output(igeom_output) - - # def __str__(self): - # ret = ['{\n'] - # ret.append(' igeom_input : ') - # ret.append(repr(self.igeom_input)) - # ret.append(',\n igeom_output : ') - # ret.append(repr(self.igeom_output)) - # ret.append('}') - # return ''.join(ret) _dt_array_initialisers = [] -rw_geom = Rw_Geom() +geom_rw = Geom_Rw() -class Evolver(f90wrap.runtime.FortranModule): +class Raffle__Distribs_Container(f90wrap.runtime.FortranModule): """ - Module evolver + Module raffle__distribs_container - Defined at ../src/lib/mod_evolver.f90 lines \ - 1-1204 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1-1839 """ - @f90wrap.runtime.register_class("raffle.gvector_base_type") - class gvector_base_type(f90wrap.runtime.FortranDerivedType): - """ - Type(name=gvector_base_type) - - - Defined at ../src/lib/mod_evolver.f90 lines \ - 14-17 - - """ - def __init__(self, handle=None): - """ - self = Gvector_Base_Type() - - - Defined at ../src/lib/mod_evolver.f90 lines \ - 14-17 - - - Returns - ------- - this : Gvector_Base_Type - Object to be constructed - - - Automatically generated constructor for gvector_base_type - """ - f90wrap.runtime.FortranDerivedType.__init__(self) - result = _raffle.f90wrap_evolver__gvector_base_type_initialise() - self._handle = result[0] if isinstance(result, tuple) else result - - def __del__(self): - """ - Destructor for class Gvector_Base_Type - - - Defined at ../src/lib/mod_evolver.f90 lines \ - 14-17 - - Parameters - ---------- - this : Gvector_Base_Type - Object to be destructed - - - Automatically generated destructor for gvector_base_type - """ - if self._alloc: - _raffle.f90wrap_evolver__gvector_base_type_finalise(this=self._handle) - - @property - def df_2body(self): - """ - Element df_2body ftype=real(real12) pytype=float - - - Defined at ../src/lib/mod_evolver.f90 line 15 - - """ - array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_base_type__array__df_2body(self._handle) - if array_handle in self._arrays: - df_2body = self._arrays[array_handle] - else: - df_2body = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, - self._handle, - _raffle.f90wrap_gvector_base_type__array__df_2body) - self._arrays[array_handle] = df_2body - return df_2body - - @df_2body.setter - def df_2body(self, df_2body): - self.df_2body[...] = df_2body - - @property - def df_3body(self): - """ - Element df_3body ftype=real(real12) pytype=float - - - Defined at ../src/lib/mod_evolver.f90 line 16 - - """ - array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_base_type__array__df_3body(self._handle) - if array_handle in self._arrays: - df_3body = self._arrays[array_handle] - else: - df_3body = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, - self._handle, - _raffle.f90wrap_gvector_base_type__array__df_3body) - self._arrays[array_handle] = df_3body - return df_3body - - @df_3body.setter - def df_3body(self, df_3body): - self.df_3body[...] = df_3body - - @property - def df_4body(self): - """ - Element df_4body ftype=real(real12) pytype=float - - - Defined at ../src/lib/mod_evolver.f90 line 17 - - """ - array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_base_type__array__df_4body(self._handle) - if array_handle in self._arrays: - df_4body = self._arrays[array_handle] - else: - df_4body = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, - self._handle, - _raffle.f90wrap_gvector_base_type__array__df_4body) - self._arrays[array_handle] = df_4body - return df_4body - - @df_4body.setter - def df_4body(self, df_4body): - self.df_4body[...] = df_4body - - def __str__(self): - ret = ['{\n'] - ret.append(' df_2body : ') - ret.append(repr(self.df_2body)) - ret.append(',\n df_3body : ') - ret.append(repr(self.df_3body)) - ret.append(',\n df_4body : ') - ret.append(repr(self.df_4body)) - ret.append('}') - return ''.join(ret) - - _dt_array_initialisers = [] - - - @f90wrap.runtime.register_class("raffle.gvector_type") - class gvector_type(f90wrap.runtime.FortranDerivedType): + @f90wrap.runtime.register_class("raffle.distribs_container_type") + class distribs_container_type(f90wrap.runtime.FortranDerivedType): """ - Type(name=gvector_type) + Type(name=distribs_container_type) - Defined at ../src/lib/mod_evolver.f90 lines \ - 19-25 + Defined at \ + ../fortran/lib/mod_distribs_container.f90 \ + lines 25-162 """ def __init__(self, handle=None): """ - self = Gvector_Type() + self = Distribs_Container_Type() - Defined at ../src/lib/mod_evolver.f90 lines \ - 19-25 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 25-162 Returns ------- - this : Gvector_Type + this : Distribs_Container_Type Object to be constructed - Automatically generated constructor for gvector_type + Automatically generated constructor for distribs_container_type """ f90wrap.runtime.FortranDerivedType.__init__(self) - result = _raffle.f90wrap_evolver__gvector_type_initialise() + result = \ + _raffle.f90wrap_raffle__dc__dc_type_initialise() self._handle = result[0] if isinstance(result, tuple) else result def __del__(self): """ - Destructor for class Gvector_Type + Destructor for class Distribs_Container_Type - Defined at ../src/lib/mod_evolver.f90 lines \ - 19-25 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 25-162 Parameters ---------- - this : Gvector_Type + this : Distribs_Container_Type Object to be destructed - Automatically generated destructor for gvector_type + Automatically generated destructor for distribs_container_type """ if self._alloc: - _raffle.f90wrap_evolver__gvector_type_finalise(this=self._handle) - - def calculate(self, lattice, basis, nbins=None, width=None, sigma=None, \ - cutoff_min=None, cutoff_max=None, radius_distance_tol=None): - """ - calculate__binding__gvector_type(self, lattice, basis[, nbins, width, sigma, \ - cutoff_min, cutoff_max]) - - - Defined at ../src/lib/mod_evolver.f90 lines \ - 747-1135 - - Parameters - ---------- - this : unknown - lattice : float array - basis : basis - nbins : int array - width : float array - sigma : float array - cutoff_min : float array - cutoff_max : float array - radius_distance_tol : float array - - -------------------------------------------------------------------------- - initialise optional variables - -------------------------------------------------------------------------- - """ - _raffle.f90wrap_evolver__calculate__binding__gvector_type(this=self._handle, \ - lattice=lattice, basis=basis._handle, nbins=nbins, width=width, sigma=sigma, \ - cutoff_min=cutoff_min, cutoff_max=cutoff_max, radius_distance_tol=radius_distance_tol) - - @property - def num_atoms(self): - """ - Element num_atoms ftype=integer pytype=int - - - Defined at ../src/lib/mod_evolver.f90 line 20 - - """ - return _raffle.f90wrap_gvector_type__get__num_atoms(self._handle) - - @num_atoms.setter - def num_atoms(self, num_atoms): - _raffle.f90wrap_gvector_type__set__num_atoms(self._handle, num_atoms) - - @property - def energy(self): - """ - Element energy ftype=real(real12) pytype=float - - - Defined at ../src/lib/mod_evolver.f90 line 21 - - """ - return _raffle.f90wrap_gvector_type__get__energy(self._handle) - - @energy.setter - def energy(self, energy): - _raffle.f90wrap_gvector_type__set__energy(self._handle, energy) - - @property - def stoichiometry(self): - """ - Element stoichiometry ftype=integer pytype=int - - - Defined at ../src/lib/mod_evolver.f90 line 22 - - """ - array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_type__array__stoichiometry(self._handle) - if array_handle in self._arrays: - stoichiometry = self._arrays[array_handle] - else: - stoichiometry = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, - self._handle, - _raffle.f90wrap_gvector_type__array__stoichiometry) - self._arrays[array_handle] = stoichiometry - return stoichiometry - - @stoichiometry.setter - def stoichiometry(self, stoichiometry): - self.stoichiometry[...] = stoichiometry - - @property - def species(self): - """ - Element species ftype=character(len=3) pytype=str - - - Defined at ../src/lib/mod_evolver.f90 line 23 - - """ - array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_type__array__species(self._handle) - if array_handle in self._arrays: - species = self._arrays[array_handle] - else: - species = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, - self._handle, - _raffle.f90wrap_gvector_type__array__species) - self._arrays[array_handle] = species - return species - - @species.setter - def species(self, species): - self.species[...] = species - - def __str__(self): - ret = ['{\n'] - ret.append(' num_atoms : ') - ret.append(repr(self.num_atoms)) - ret.append(',\n energy : ') - ret.append(repr(self.energy)) - ret.append(',\n stoichiometry : ') - ret.append(repr(self.stoichiometry)) - ret.append(',\n species : ') - ret.append(repr(self.species)) - ret.append('}') - return ''.join(ret) - - _dt_array_initialisers = [] - - - @f90wrap.runtime.register_class("raffle.gvector_container_type") - class gvector_container_type(f90wrap.runtime.FortranDerivedType): - """ - Type(name=gvector_container_type) - - - Defined at ../src/lib/mod_evolver.f90 lines \ - 30-62 - - """ - def __init__(self, handle=None): - """ - self = Gvector_Container_Type() - - - Defined at ../src/lib/mod_evolver.f90 lines \ - 30-62 - - - Returns - ------- - this : Gvector_Container_Type - Object to be constructed - - - Automatically generated constructor for gvector_container_type - """ - f90wrap.runtime.FortranDerivedType.__init__(self) - result = _raffle.f90wrap_evolver__gvector_container_type_initialise() - self._handle = result[0] if isinstance(result, tuple) else result - - def __del__(self): - """ - Destructor for class Gvector_Container_Type - - - Defined at ../src/lib/mod_evolver.f90 lines \ - 30-62 - - Parameters - ---------- - this : Gvector_Container_Type - Object to be destructed - - - Automatically generated destructor for gvector_container_type - """ - if self._alloc: - _raffle.f90wrap_evolver__gvector_container_type_finalise(this=self._handle) + _raffle.f90wrap_raffle__dc__dc_type_finalise(this=self._handle) def set_kBT(self, kBT): """ @@ -1116,11 +681,11 @@ def set_weight_method(self, method): def set_width(self, width): """ - set_width__binding__gvector_container_type(self, width) + set_width__binding__dc_type(self, width) - Defined at ../src/lib/mod_evolver.f90 lines \ - 108-118 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 237-247 Parameters ---------- @@ -1128,16 +693,16 @@ def set_width(self, width): width : float array """ - _raffle.f90wrap_evolver__set_width__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_width__binding__dc_type(this=self._handle, \ width=width) def set_sigma(self, sigma): """ - set_sigma__binding__gvector_container_type(self, sigma) + set_sigma__binding__dc_type(self, sigma) - Defined at ../src/lib/mod_evolver.f90 lines \ - 120-130 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 251-261 Parameters ---------- @@ -1145,16 +710,16 @@ def set_sigma(self, sigma): sigma : float array """ - _raffle.f90wrap_evolver__set_sigma__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_sigma__binding__dc_type(this=self._handle, \ sigma=sigma) def set_cutoff_min(self, cutoff_min): """ - set_cutoff_min__binding__gvector_container_type(self, cutoff_min) + set_cutoff_min__binding__dc_type(self, cutoff_min) - Defined at ../src/lib/mod_evolver.f90 lines \ - 132-140 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 265-273 Parameters ---------- @@ -1162,16 +727,16 @@ def set_cutoff_min(self, cutoff_min): cutoff_min : float array """ - _raffle.f90wrap_evolver__set_cutoff_min__binding__gvector_container7007(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_cutoff_min__binding__dc_type(this=self._handle, \ cutoff_min=cutoff_min) def set_cutoff_max(self, cutoff_max): """ - set_cutoff_max__binding__gvector_container_type(self, cutoff_max) + set_cutoff_max__binding__dc_type(self, cutoff_max) - Defined at ../src/lib/mod_evolver.f90 lines \ - 142-150 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 277-285 Parameters ---------- @@ -1179,32 +744,33 @@ def set_cutoff_max(self, cutoff_max): cutoff_max : float array """ - _raffle.f90wrap_evolver__set_cutoff_max__binding__gvector_container047c(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_cutoff_max__binding__dc_type(this=self._handle, \ cutoff_max=cutoff_max) def set_radius_distance_tol(self, radius_distance_tol): """ - set_radius_distance_tol__binding__gvector_container_type(self, radius_distance_tol) + set_radius_distance_tol__binding__dc_type(self, \ + radius_distance_tol) - Defined at ../src/lib/mod_evolver.f90 lines \ - 142-150 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 289-297 Parameters ---------- this : unknown - cutoff_max : float array + radius_distance_tol : float array """ - _raffle.f90wrap_evolver__set_radius_distance_tol__binding__gvector_1dda(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_radius_distance_tol__binding__dc_type(this=self._handle, \ radius_distance_tol=radius_distance_tol) def create(self, basis_list, energy_above_hull_list=None, deallocate_systems=True): """ - create__binding__gvector_container_type(self, basis_list) + create__binding__dc_type(self, basis_list) - Defined at ../src/lib/mod_evolver.f90 lines \ - 152-162 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 353-440 Parameters ---------- @@ -1216,12 +782,12 @@ def create(self, basis_list, energy_above_hull_list=None, deallocate_systems=Tru """ from ase import Atoms if isinstance(basis_list, Atoms): - basis_list = rw_geom.basis_array(basis_list) + basis_list = geom_rw.basis_array(basis_list) elif isinstance(basis_list, list): if all([isinstance(basis, Atoms) for basis in basis_list]): - basis_list = rw_geom.basis_array(basis_list) + basis_list = geom_rw.basis_array(basis_list) - _raffle.f90wrap_evolver__create__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__create__binding__dc_type(this=self._handle, \ basis_list=basis_list._handle, \ energy_above_hull_list=energy_above_hull_list, \ deallocate_systems=deallocate_systems \ @@ -1229,10 +795,10 @@ def create(self, basis_list, energy_above_hull_list=None, deallocate_systems=Tru def update(self, basis_list, energy_above_hull_list=None, from_host=True, deallocate_systems=True): """ - update__binding__gvector_container_type(self, basis_list) + update__binding__dc_type(self, basis_list) - Defined at ../src/lib/mod_evolver.f90 lines \ - 152-162 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + 445-503 Parameters ---------- @@ -1245,13 +811,13 @@ def update(self, basis_list, energy_above_hull_list=None, from_host=True, deallo """ from ase import Atoms if isinstance(basis_list, Atoms): - basis_list = rw_geom.basis_array(basis_list) + basis_list = geom_rw.basis_array(basis_list) elif isinstance(basis_list, list): if all([isinstance(basis, Atoms) for basis in basis_list]): - basis_list = rw_geom.basis_array(basis_list) + basis_list = geom_rw.basis_array(basis_list) - _raffle.f90wrap_evolver__update__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__update__binding__dc_type(this=self._handle, \ basis_list=basis_list._handle, \ energy_above_hull_list=energy_above_hull_list, \ from_host=from_host, \ @@ -1260,65 +826,43 @@ def update(self, basis_list, energy_above_hull_list=None, from_host=True, deallo def deallocate_systems(self): """ - deallocate_systems__binding__gvector_container_type(self) + deallocate_systems__binding__dc_type(self) - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - lines 323-331 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 497-506 Parameters ---------- this : unknown """ - _raffle.f90wrap_evolver__deallocate_systems__binding__gvector_conta8f02(this=self._handle) + _raffle.f90wrap_raffle__dc__deallocate_systems__binding__dc_type(this=self._handle) - def add_basis(self, lattice, basis): + def add_basis(self, basis): """ - add_basis__binding__gvector_container_type(self, lattice, basis) + add_basis__binding__dc_type(self, basis) - Defined at ../src/lib/mod_evolver.f90 lines \ - 415-430 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 776-797 Parameters ---------- this : unknown - lattice : float array - basis : basis + basis : Basis_Type """ - _raffle.f90wrap_evolver__add_basis__binding__gvector_container_type(this=self._handle, \ - lattice=lattice, basis=basis._handle) + _raffle.f90wrap_raffle__dc__add_basis__binding__dc_type(this=self._handle, \ + basis=basis._handle) - # def set_element_info(self, element_file=None, element_list=None): - # """ - # set_element_info__binding__gvector_container_type(self[, element_file, \ - # element_list]) - - - # Defined at ../src/lib/mod_evolver.f90 lines \ - # 436-466 - - # Parameters - # ---------- - # this : unknown - # element_file : str - # element_list : str array - - # -------------------------------------------------------------------------- - # load the elements database - # -------------------------------------------------------------------------- - # """ - # _raffle.f90wrap_evolver__set_element_info__binding__gvector_containbcb0(this=self._handle, \ - # element_file=element_file, element_list=element_list) - def set_element_energies(self, element_energies): """ - set_element_energies__binding__gvector_container_type(self, element_energies) - - Defined at ../src/lib/mod_evolver.f90 lines \ - 472-526 + set_element_energies__binding__dc_type(self, element_energies) + + + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 944-958 Parameters ---------- @@ -1328,17 +872,17 @@ def set_element_energies(self, element_energies): element_list = list(element_energies.keys()) energies = [element_energies[element] for element in element_list] - _raffle.f90wrap_evolver__set_element_energies__binding__gvector_con0537(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_element_energies__binding__dc_type(this=self._handle, \ elements=element_list, energies=energies) - + def get_element_energies(self): """ - get_element_energies_static__binding__gvector_container_type(self, elements, \ + get_element_energies_static__binding__dc_type(self, elements, \ energies) - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - lines 557-574 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 984-1004 Parameters ---------- @@ -1350,11 +894,11 @@ def get_element_energies(self): """ - num_elements = _raffle.f90wrap_evolver__get__num_elements(self._handle) + num_elements = _raffle.f90wrap_raffle__dc__get__num_elements(self._handle) elements = numpy.zeros((num_elements,), dtype='S3') energies = numpy.zeros((num_elements,), dtype=numpy.float32) - _raffle.f90wrap_evolver__get_element_energies_staticmem__binding__g4f53(this=self._handle, \ + _raffle.f90wrap_raffle__dc__get_element_energies_sm__binding__dc_type(this=self._handle, \ elements=elements, energies=energies) # convert the fortran array to a python dictionary @@ -1365,39 +909,36 @@ def get_element_energies(self): return element_energies - def _set_bond_info(self, bond_file=None): + def set_bond_info(self): """ - set_bond_info__binding__gvector_container_type(self[, bond_file]) + set_bond_info__binding__dc_type(self) - Defined at ../src/lib/mod_evolver.f90 lines \ - 472-526 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1008-1052 Parameters ---------- this : unknown - bond_file : str - -------------------------------------------------------------------------- - load the element bonds database - -------------------------------------------------------------------------- + --------------------------------------------------------------------------- + allocate the bond information array + --------------------------------------------------------------------------- """ - _raffle.f90wrap_evolver__set_bond_info__binding__gvector_container_type(this=self._handle, \ - bond_file=bond_file) + _raffle.f90wrap_raffle__dc__set_bond_info__binding__dc_type(this=self._handle) def set_bond_radius(self, radius_dict): """ - set_bond_radius__binding__gvector_container_type(self, elements, radius) + set_bond_radius__binding__dc_type(self, elements, radius) - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - lines 711-757 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1197-1247 Parameters ---------- this : unknown - elements : str array - radius : float + radius_dict : dict --------------------------------------------------------------------------- remove python formatting @@ -1409,22 +950,21 @@ def set_bond_radius(self, radius_dict): elements = list(radius_dict.keys()[0]) radius = radius_dict.values()[0] - _raffle.f90wrap_evolver__set_bond_radius__binding__gvector_containe7df9(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_bond_radius__binding__dc_type(this=self._handle, \ elements=elements, radius=radius) def set_bond_radii(self, radius_dict): """ - set_bond_radii__binding__gvector_container_type(self, elements, radii) + set_bond_radii__binding__dc_type(self, elements, radii) - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - lines 761-776 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1251-1266 Parameters ---------- this : unknown - elements : str array - radii : float array + radius_dict : dict """ @@ -1437,39 +977,38 @@ def set_bond_radii(self, radius_dict): radii.append(value) - _raffle.f90wrap_evolver__set_bond_radii__binding__gvector_container83c5(this=self._handle, \ + _raffle.f90wrap_raffle__dc__set_bond_radii__binding__dc_type(this=self._handle, \ elements=elements, radii=radii) def get_bond_radii(self): """ - get_bond_radii_staticmem__binding__gvector_container_type(self, elements, radii) + get_bond_radii_staticmem__binding__dc_type(self, elements, \ + radii) - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - lines 808-828 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1292-1312 Parameters ---------- this : unknown - elements : str array - radii : float array Returns ------- - element_energies : dict + bond_radii : dict """ - num_elements = _raffle.f90wrap_evolver__get__num_elements(self._handle) + num_elements = _raffle.f90wrap_raffle__dc__get__num_elements(self._handle) if num_elements == 0: return {} num_pairs = round(num_elements * ( num_elements + 1 ) / 2) elements = numpy.zeros((num_pairs,2,), dtype='S3', order='F') radii = numpy.zeros((num_pairs,), dtype=numpy.float32, order='F') - _raffle.f90wrap_evolver__get_bond_radii_staticmem__binding__gvectord2e1(this=self._handle, \ + _raffle.f90wrap_raffle__dc__get_bond_radii_staticmem__binding__dc_type(this=self._handle, \ elements=elements, radii=radii) - # _raffle.f90wrap_evolver__get_element_energies_staticmem__binding__g4f53(this=self._handle, \ + # _raffle.f90wrap_raffle__dc__get_bond_radii_staticmem__binding__dc_type(this=self._handle, \ # elements=elements, energies=energies) # convert the fortran array to a python dictionary @@ -1480,65 +1019,48 @@ def get_bond_radii(self): return bond_radii - # def _set_best_energy(self): - # """ - # set_best_energy__binding__gvector_container_type(self) - - - # Defined at ../src/lib/mod_evolver.f90 lines \ - # 532-554 - - # Parameters - # ---------- - # this : unknown - - # """ - # _raffle.f90wrap_evolver__set_best_energy__binding__gvector_containe4680(this=self._handle) - - def initialise_gvectors(self): + def initialise_gdfs(self): """ - initialise_gvectors__binding__gvector_container_type(self) + initialise_gdfs__binding__dc_type(self) - Defined at ../src/lib/mod_evolver.f90 lines \ - 600-630 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1474-1493 Parameters ---------- this : unknown """ - _raffle.f90wrap_evolver__initialise_gvectors__binding__gvector_contc1f2(this=self._handle) + _raffle.f90wrap_raffle__dc__initialise_gdfs__binding__dc_type(this=self._handle) - def evolve(self, system=None): + def evolve(self): #, system=None): """ - evolve__binding__gvector_container_type(self[, system, \ - deallocate_systems_after_evolve]) + evolve__binding__dc_type(self) - Defined at ../src/lib/mod_evolver.f90 lines \ - 637-740 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1539-1838 Parameters ---------- this : unknown - system : Gvector_Type array - deallocate_systems_after_evolve : bool - -------------------------------------------------------------------------- - if present, set the deallocate flag - -------------------------------------------------------------------------- + --------------------------------------------------------------------------- + if present, add the system to the container + --------------------------------------------------------------------------- """ - _raffle.f90wrap_evolver__evolve__binding__gvector_container_type(this=self._handle, \ - system=None if system is None else system._handle) + _raffle.f90wrap_raffle__dc__evolve__binding__dc_type(this=self._handle) + # _raffle.f90wrap_raffle__dc__evolve__binding__dc_type(this=self._handle, \ + # system=None if system is None else system._handle) def write(self, file): """ - write__binding__gvector_container_type(self, file) + write__binding__dc_type(self, file) - Defined at ../src/lib/mod_evolver.f90 lines \ - 182-210 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 510-559 Parameters ---------- @@ -1546,16 +1068,16 @@ def write(self, file): file : str """ - _raffle.f90wrap_evolver__write__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__write__binding__dc_type(this=self._handle, \ file=file) def read(self, file): """ - read__binding__gvector_container_type(self, file) + read__binding__dc_type(self, file) - Defined at ../src/lib/mod_evolver.f90 lines \ - 216-260 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 563-620 Parameters ---------- @@ -1563,16 +1085,16 @@ def read(self, file): file : str """ - _raffle.f90wrap_evolver__read__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__read__binding__dc_type(this=self._handle, \ file=file) def write_2body(self, file): """ - write_2body__binding__gvector_container_type(self, file) + write_2body__binding__dc_type(self, file) - Defined at ../src/lib/mod_evolver.f90 lines \ - 266-295 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 624-663 Parameters ---------- @@ -1580,16 +1102,16 @@ def write_2body(self, file): file : str """ - _raffle.f90wrap_evolver__write_2body__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__write_2body__binding__dc_type(this=self._handle, \ file=file) def write_3body(self, file): """ - write_3body__binding__gvector_container_type(self, file) + write_3body__binding__dc_type(self, file) - Defined at ../src/lib/mod_evolver.f90 lines \ - 301-315 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 667-689 Parameters ---------- @@ -1597,16 +1119,16 @@ def write_3body(self, file): file : str """ - _raffle.f90wrap_evolver__write_3body__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__write_3body__binding__dc_type(this=self._handle, \ file=file) def write_4body(self, file): """ - write_4body__binding__gvector_container_type(self, file) + write_4body__binding__dc_type(self, file) - Defined at ../src/lib/mod_evolver.f90 lines \ - 321-335 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 693-715 Parameters ---------- @@ -1614,16 +1136,16 @@ def write_4body(self, file): file : str """ - _raffle.f90wrap_evolver__write_4body__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__write_4body__binding__dc_type(this=self._handle, \ file=file) def get_pair_index(self, species1, species2): """ - idx = get_pair_index__binding__gvector_container_type(self, species1, species2) + idx = get_pair_index__binding__dc_type(self, species1, species2) - Defined at ../src/lib/mod_evolver.f90 lines \ - 560-575 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1408-1430 Parameters ---------- @@ -1637,17 +1159,17 @@ def get_pair_index(self, species1, species2): """ idx = \ - _raffle.f90wrap_evolver__get_pair_index__binding__gvector_container4618(this=self._handle, \ + _raffle.f90wrap_raffle__dc__get_pair_index__binding__dc_type(this=self._handle, \ species1=species1, species2=species2) return idx def get_bin(self, value, dim): """ - bin = get_bin__binding__gvector_container_type(self, value, dim) + bin = get_bin__binding__dc_type(self, value, dim) - Defined at ../src/lib/mod_evolver.f90 lines \ - 581-594 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + lines 1451-1470 Parameters ---------- @@ -1661,7 +1183,7 @@ def get_bin(self, value, dim): """ bin = \ - _raffle.f90wrap_evolver__get_bin__binding__gvector_container_type(this=self._handle, \ + _raffle.f90wrap_raffle__dc__get_bin__binding__dc_type(this=self._handle, \ value=value, dim=dim) return bin @@ -1671,15 +1193,15 @@ def num_evaluated(self): Element num_evaluated ftype=integer pytype=int - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - line 57 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 30 """ - return _raffle.f90wrap_gvector_container_type__get__num_evaluated(self._handle) + return _raffle.f90wrap_distribs_container_type__get__num_evaluated(self._handle) @num_evaluated.setter def num_evaluated(self, num_evaluated): - _raffle.f90wrap_gvector_container_type__set__num_evaluated(self._handle, \ + _raffle.f90wrap_distribs_container_type__set__num_evaluated(self._handle, \ num_evaluated) @property @@ -1688,84 +1210,50 @@ def num_evaluated_allocated(self): Element num_evaluated_allocated ftype=integer pytype=int - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - line 59 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 32 """ return \ - _raffle.f90wrap_gvector_container_type__get__num_evaluated_allocated(self._handle) + _raffle.f90wrap_distribs_container_type__get__num_evaluated_allocated(self._handle) @num_evaluated_allocated.setter def num_evaluated_allocated(self, num_evaluated_allocated): - _raffle.f90wrap_gvector_container_type__set__num_evaluated_allocated(self._handle, \ - num_evaluated_allocated) - - @property - def num_evaluated(self): - """ - Element num_evaluated ftype=integer pytype=int - - - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - line 82 - - """ - return _raffle.f90wrap_gvector_container_type__get__num_evaluated(self._handle) - - @num_evaluated.setter - def num_evaluated(self, num_evaluated): - _raffle.f90wrap_gvector_container_type__set__num_evaluated(self._handle, \ - num_evaluated) - - @property - def num_evaluated_allocated(self): - """ - Element num_evaluated_allocated ftype=integer pytype=int - - - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - line 84 - - """ - return \ - _raffle.f90wrap_gvector_container_type__get__num_evaluated_allocated(self._handle) - - @num_evaluated_allocated.setter - def num_evaluated_allocated(self, num_evaluated_allocated): - _raffle.f90wrap_gvector_container_type__set__num_evaluated_allocated(self._handle, \ + _raffle.f90wrap_distribs_container_type__set__num_evaluated_allocated(self._handle, \ num_evaluated_allocated) @property def kBT(self): """ - Element kBT ftype=real(real12) pytype=float + Element kBT ftype=real(real32) pytype=float - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - line 66 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 34 """ - return _raffle.f90wrap_gvector_container_type__get__kBT(self._handle) + return _raffle.f90wrap_distribs_container_type__get__kbt(self._handle) @kBT.setter def kBT(self, kBT): - _raffle.f90wrap_gvector_container_type__set__kBT(self._handle, kBT) - + _raffle.f90wrap_distribs_container_type__set__kbt(self._handle, kBT) + @property def weight_by_hull(self): """ Element weight_by_hull ftype=logical pytype=bool - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - line 88 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 36 """ - return _raffle.f90wrap_gvector_container_type__get__weight_by_hull(self._handle) + return \ + _raffle.f90wrap_distribs_container_type__get__weight_by_hull(self._handle) @weight_by_hull.setter def weight_by_hull(self, weight_by_hull): - _raffle.f90wrap_gvector_container_type__set__weight_by_hull(self._handle, \ + _raffle.f90wrap_distribs_container_type__set__weight_by_hull(self._handle, \ weight_by_hull) @property @@ -1774,17 +1262,18 @@ def nbins(self): Element nbins ftype=integer pytype=int - Defined at ../src/lib/mod_evolver.f90 line 33 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 54 """ array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_container_type__array__nbins(self._handle) + _raffle.f90wrap_distribs_container_type__array__nbins(self._handle) if array_handle in self._arrays: nbins = self._arrays[array_handle] else: nbins = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _raffle.f90wrap_gvector_container_type__array__nbins) + _raffle.f90wrap_distribs_container_type__array__nbins) self._arrays[array_handle] = nbins return nbins @@ -1795,20 +1284,21 @@ def nbins(self, nbins): @property def sigma(self): """ - Element sigma ftype=real(real12) pytype=float + Element sigma ftype=real(real32) pytype=float - Defined at ../src/lib/mod_evolver.f90 line 34 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 57 """ array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_container_type__array__sigma(self._handle) + _raffle.f90wrap_distribs_container_type__array__sigma(self._handle) if array_handle in self._arrays: sigma = self._arrays[array_handle] else: sigma = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _raffle.f90wrap_gvector_container_type__array__sigma) + _raffle.f90wrap_distribs_container_type__array__sigma) self._arrays[array_handle] = sigma return sigma @@ -1819,20 +1309,21 @@ def sigma(self, sigma): @property def width(self): """ - Element width ftype=real(real12) pytype=float + Element width ftype=real(real32) pytype=float - Defined at ../src/lib/mod_evolver.f90 line 35 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 61 """ array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_container_type__array__width(self._handle) + _raffle.f90wrap_distribs_container_type__array__width(self._handle) if array_handle in self._arrays: width = self._arrays[array_handle] else: width = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _raffle.f90wrap_gvector_container_type__array__width) + _raffle.f90wrap_distribs_container_type__array__width) self._arrays[array_handle] = width return width @@ -1843,20 +1334,21 @@ def width(self, width): @property def cutoff_min(self): """ - Element cutoff_min ftype=real(real12) pytype=float + Element cutoff_min ftype=real(real32) pytype=float - Defined at ../src/lib/mod_evolver.f90 line 36 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 64 """ array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_container_type__array__cutoff_min(self._handle) + _raffle.f90wrap_distribs_container_type__array__cutoff_min(self._handle) if array_handle in self._arrays: cutoff_min = self._arrays[array_handle] else: cutoff_min = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _raffle.f90wrap_gvector_container_type__array__cutoff_min) + _raffle.f90wrap_distribs_container_type__array__cutoff_min) self._arrays[array_handle] = cutoff_min return cutoff_min @@ -1867,20 +1359,21 @@ def cutoff_min(self, cutoff_min): @property def cutoff_max(self): """ - Element cutoff_max ftype=real(real12) pytype=float + Element cutoff_max ftype=real(real32) pytype=float - Defined at ../src/lib/mod_evolver.f90 line 37 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 67 """ array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_container_type__array__cutoff_max(self._handle) + _raffle.f90wrap_distribs_container_type__array__cutoff_max(self._handle) if array_handle in self._arrays: cutoff_max = self._arrays[array_handle] else: cutoff_max = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _raffle.f90wrap_gvector_container_type__array__cutoff_max) + _raffle.f90wrap_distribs_container_type__array__cutoff_max) self._arrays[array_handle] = cutoff_max return cutoff_max @@ -1891,67 +1384,67 @@ def cutoff_max(self, cutoff_max): @property def radius_distance_tol(self): """ - Element radius_distance_tol ftype=real(real12) pytype=float + Element radius_distance_tol ftype=real(real32) pytype=float - Defined at /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_evolver.f90 \ - line 81 + Defined at ../fortran/lib/mod_distribs_container.f90 \ + line 70 """ array_ndim, array_type, array_shape, array_handle = \ - _raffle.f90wrap_gvector_container_type__array__radius_distance_tol(self._handle) + _raffle.f90wrap_distribs_container_type__array__radius_distance_tol(self._handle) if array_handle in self._arrays: radius_distance_tol = self._arrays[array_handle] else: radius_distance_tol = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _raffle.f90wrap_gvector_container_type__array__radius_distance_tol) + _raffle.f90wrap_distribs_container_type__array__radius_distance_tol) self._arrays[array_handle] = radius_distance_tol return radius_distance_tol @radius_distance_tol.setter def radius_distance_tol(self, radius_distance_tol): self.radius_distance_tol[...] = radius_distance_tol - - @property - def total(self): - """ - Element total ftype=type(gvector_base_type) pytype=Gvector_Base_Type + + # @property + # def total(self): + # """ + # Element total ftype=type(distribs_base_type) pytype=Distribs_Base_Type - Defined at ../src/lib/mod_evolver.f90 line 38 + # Defined at ../src/lib/mod_distribs_container.f90 line 38 - """ - total_handle = _raffle.f90wrap_gvector_container_type__get__total(self._handle) - if tuple(total_handle) in self._objs: - total = self._objs[tuple(total_handle)] - else: - total = evolver.gvector_base_type.from_handle(total_handle) - self._objs[tuple(total_handle)] = total - return total - - @total.setter - def total(self, total): - total = total._handle - _raffle.f90wrap_gvector_container_type__set__total(self._handle, total) - - def _init_array_system(self): - self.system = f90wrap.runtime.FortranDerivedTypeArray(self, - _raffle.f90wrap_gvector_container_type__array_getitem__system, - _raffle.f90wrap_gvector_container_type__array_setitem__system, - _raffle.f90wrap_gvector_container_type__array_len__system, - """ - Element system ftype=type(gvector_type) pytype=Gvector_Type + # """ + # total_handle = _raffle.f90wrap_distribs_container_type__get__total(self._handle) + # if tuple(total_handle) in self._objs: + # total = self._objs[tuple(total_handle)] + # else: + # total = distribs.distribs_base_type.from_handle(total_handle) + # self._objs[tuple(total_handle)] = total + # return total + + # @total.setter + # def total(self, total): + # total = total._handle + # _raffle.f90wrap_distribs_container_type__set__total(self._handle, total) + + # def _init_array_system(self): + # self.system = f90wrap.runtime.FortranDerivedTypeArray(self, + # _raffle.f90wrap_distribs_container_type__array_getitem__system, + # _raffle.f90wrap_distribs_container_type__array_setitem__system, + # _raffle.f90wrap_distribs_container_type__array_len__system, + # """ + # Element system ftype=type(distribs_type) pytype=Distribs_Type - Defined at ../src/lib/mod_evolver.f90 line 39 + # Defined at ../src/lib/mod_distribs_container.f90 line 39 - """, Evolver.gvector_type) - return self.system + # """, Distribs.distribs_type) + # return self.system def __str__(self): - ret = ['{\n'] + ret = ['{\n'] ret.append(' num_evaluated : ') ret.append(repr(self.num_evaluated)) ret.append(',\n num_evaluated_allocated : ') @@ -1972,18 +1465,18 @@ def __str__(self): ret.append(repr(self.cutoff_max)) ret.append(',\n radius_distance_tol : ') ret.append(repr(self.radius_distance_tol)) - ret.append(',\n total : ') - ret.append(repr(self.total)) + # ret.append(',\n total : ') + # ret.append(repr(self.total)) ret.append('}') return ''.join(ret) - _dt_array_initialisers = [_init_array_system] + _dt_array_initialisers = []#_init_array_system] _dt_array_initialisers = [] -evolver = Evolver() +raffle__distribs_container = Raffle__Distribs_Container() class Generator(f90wrap.runtime.FortranModule): """ @@ -2252,6 +1745,20 @@ def set_max_attempts(self, max_attempts): """ self.max_attempts = max_attempts + def set_walk_step_size(self, coarse=None, fine=None): + """ + Parameters + ---------- + this : unknown + coarse : float + fine: float + + """ + if coarse is not None: + self.walk_step_size_coarse = coarse + if fine is not None: + self.walk_step_size_fine = fine + def set_host(self, host): """ set_host__binding__raffle_generator(self, host) @@ -2269,7 +1776,7 @@ def set_host(self, host): from ase import Atoms # check if host is ase.Atoms object if isinstance(host, Atoms): - host = rw_geom.basis(atoms=host) + host = geom_rw.basis(atoms=host) _raffle.f90wrap_generator__set_host__binding__rgt(this=self._handle, \ host=host._handle) @@ -2280,8 +1787,7 @@ def set_grid(self, grid=None, grid_spacing=None, grid_offset=None): grid_offset]) - Defined at \ - /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_generator.f90 lines \ + Defined at ../fortran/lib/mod_generator.f90 lines \ 142-173 Parameters @@ -2300,8 +1806,7 @@ def reset_grid(self): reset_grid__binding__raffle_generator(self) - Defined at \ - /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_generator.f90 lines \ + Defined at ../fortran/lib/mod_generator.f90 lines \ 170-176 Parameters @@ -2417,7 +1922,7 @@ def host(self): if tuple(host_handle) in self._objs: host = self._objs[tuple(host_handle)] else: - host = rw_geom.basis.from_handle(host_handle) + host = geom_rw.basis.from_handle(host_handle) self._objs[tuple(host_handle)] = host return host @@ -2457,8 +1962,7 @@ def grid_offset(self): Element grid_offset ftype=real pytype=float - Defined at \ - /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_generator.f90 line \ + Defined at ../fortran/lib/mod_generator.f90 line \ 45 """ @@ -2480,11 +1984,10 @@ def grid_offset(self, grid_offset): @property def grid_spacing(self): """ - Element grid_spacing ftype=real(real12) pytype=float + Element grid_spacing ftype=real(real32) pytype=float - Defined at \ - /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_generator.f90 line \ + Defined at ../fortran/lib/mod_generator.f90 line \ 47 """ @@ -2498,12 +2001,12 @@ def grid_spacing(self, grid_spacing): @property def distributions(self): """ - Element distributions ftype=type(gvector_container_type) \ - pytype=Gvector_Container_Type + Element distributions ftype=type(distribs_container_type) \ + pytype=Distribs_Container_Type - Defined at ../src/lib/mod_generator.f90 line \ - 27 + Defined at ../fortran/lib/mod_generator.f90 line \ + 54 """ distributions_handle = \ @@ -2511,7 +2014,8 @@ def distributions(self): if tuple(distributions_handle) in self._objs: distributions = self._objs[tuple(distributions_handle)] else: - distributions = evolver.gvector_container_type.from_handle(distributions_handle) + distributions = \ + raffle__distribs_container.distribs_container_type.from_handle(distributions_handle) self._objs[tuple(distributions_handle)] = distributions return distributions @@ -2538,10 +2042,48 @@ def max_attempts(self, max_attempts): _raffle.f90wrap_raffle_generator_type__set__max_attempts(self._handle, \ max_attempts) + @property + def walk_step_size_coarse(self): + """ + Element walk_step_size_coarse ftype=real(real12) pytype=float + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_generator.f90 line \ + 60 + + """ + return \ + _raffle.f90wrap_raffle_generator_type__get__walk_step_size_coarse(self._handle) + + @walk_step_size_coarse.setter + def walk_step_size_coarse(self, walk_step_size_coarse): + _raffle.f90wrap_raffle_generator_type__set__walk_step_size_coarse(self._handle, \ + walk_step_size_coarse) + + @property + def walk_step_size_fine(self): + """ + Element walk_step_size_fine ftype=real(real12) pytype=float + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/raffle/src/fortran/lib/mod_generator.f90 line \ + 60 + + """ + return \ + _raffle.f90wrap_raffle_generator_type__get__walk_step_size_fine(self._handle) + + @walk_step_size_fine.setter + def walk_step_size_fine(self, walk_step_size_fine): + _raffle.f90wrap_raffle_generator_type__set__walk_step_size_fine(self._handle, \ + walk_step_size_fine) + @property def method_probab(self): """ - Element method_probab ftype=real(real12) pytype=float + Element method_probab ftype=real(real32) pytype=float Defined at ../src/lib/mod_generator.f90 line \ @@ -2575,7 +2117,7 @@ def _init_array_structures(self): Defined at ../src/lib/mod_generator.f90 line \ 29 - """, Rw_Geom.basis) + """, Geom_Rw.basis) return self.structures def __str__(self): diff --git a/src/wrapper/f90wrap_mod_distribs_container.f90 b/src/wrapper/f90wrap_mod_distribs_container.f90 new file mode 100644 index 00000000..2b85698a --- /dev/null +++ b/src/wrapper/f90wrap_mod_distribs_container.f90 @@ -0,0 +1,915 @@ +! Module raffle__distribs_container defined in file ../src/lib/mod_distribs_container.f90 + +!############################################################################### +! number of evaluated systems +!############################################################################### +subroutine f90wrap_distribs_container_type__get__num_evaluated( & + this, f90wrap_num_evaluated & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_evaluated + + this_ptr = transfer(this, this_ptr) + f90wrap_num_evaluated = this_ptr%p%num_evaluated +end subroutine f90wrap_distribs_container_type__get__num_evaluated + +subroutine f90wrap_distribs_container_type__set__num_evaluated( & + this, f90wrap_num_evaluated & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_evaluated + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_evaluated = f90wrap_num_evaluated +end subroutine f90wrap_distribs_container_type__set__num_evaluated + +subroutine f90wrap_distribs_container_type__get__num_evaluated_allocated( & + this, f90wrap_num_evaluated_allocated & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_evaluated_allocated + + this_ptr = transfer(this, this_ptr) + f90wrap_num_evaluated_allocated = this_ptr%p%num_evaluated_allocated +end subroutine f90wrap_distribs_container_type__get__num_evaluated_allocated + +subroutine f90wrap_distribs_container_type__set__num_evaluated_allocated( & + this, f90wrap_num_evaluated_allocated & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_evaluated_allocated + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_evaluated_allocated = f90wrap_num_evaluated_allocated +end subroutine f90wrap_distribs_container_type__set__num_evaluated_allocated +!############################################################################### + + +!############################################################################### +! set energy scaling +!############################################################################### +subroutine f90wrap_distribs_container_type__get__kBT(this, f90wrap_kBT) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_kBT + + this_ptr = transfer(this, this_ptr) + f90wrap_kBT = this_ptr%p%kBT +end subroutine f90wrap_distribs_container_type__get__kBT + +subroutine f90wrap_distribs_container_type__set__kBT(this, f90wrap_kBT) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_kBT + + this_ptr = transfer(this, this_ptr) + this_ptr%p%kBT = f90wrap_kBT +end subroutine f90wrap_distribs_container_type__set__kBT +!############################################################################### + + +!############################################################################### +! boolean for using hull weighting or empirical method +!############################################################################### +subroutine f90wrap_distribs_container_type__get__weight_by_hull( & + this, f90wrap_weight_by_hull & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_weight_by_hull + + this_ptr = transfer(this, this_ptr) + f90wrap_weight_by_hull = this_ptr%p%weight_by_hull +end subroutine f90wrap_distribs_container_type__get__weight_by_hull + +subroutine f90wrap_distribs_container_type__set__weight_by_hull( & + this, f90wrap_weight_by_hull & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_weight_by_hull + + this_ptr = transfer(this, this_ptr) + this_ptr%p%weight_by_hull = f90wrap_weight_by_hull +end subroutine f90wrap_distribs_container_type__set__weight_by_hull +!############################################################################### + + +!############################################################################### +! viability default values +!############################################################################### +subroutine f90wrap_distribs_container_type__get__viability_3body_default( & + this, f90wrap_viability_3body_default & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_viability_3body_default + + this_ptr = transfer(this, this_ptr) + f90wrap_viability_3body_default = this_ptr%p%viability_3body_default +end subroutine f90wrap_distribs_container_type__get__viability_3body_default + +subroutine f90wrap_distribs_container_type__set__viability_3body_default( & + this, f90wrap_viability_3body_default & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_viability_3body_default + + this_ptr = transfer(this, this_ptr) + this_ptr%p%viability_3body_default = f90wrap_viability_3body_default +end subroutine f90wrap_distribs_container_type__set__viability_3body_default + +subroutine f90wrap_distribs_container_type__get__viability_4body_default( & + this, f90wrap_viability_4body_default & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_viability_4body_default + + this_ptr = transfer(this, this_ptr) + f90wrap_viability_4body_default = this_ptr%p%viability_4body_default +end subroutine f90wrap_distribs_container_type__get__viability_4body_default + +subroutine f90wrap_distribs_container_type__set__viability_4body_default( & + this, f90wrap_viability_4body_default & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_viability_4body_default + + this_ptr = transfer(this, this_ptr) + this_ptr%p%viability_4body_default = f90wrap_viability_4body_default +end subroutine f90wrap_distribs_container_type__set__viability_4body_default +!############################################################################### + + +!############################################################################### +! parameters for the distribution functions +!############################################################################### +subroutine f90wrap_distribs_container_type__array__nbins( & + this, nd, dtype, dshape, dloc & +) + use raffle__distribs_container, only: distribs_container_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer(c_int), intent(out) :: nd + integer(c_int), intent(out) :: dtype + integer(c_int), dimension(10), intent(out) :: dshape + integer*8, intent(out) :: dloc + + nd = 1 + dtype = 5 + this_ptr = transfer(this, this_ptr) + dshape(1:1) = shape(this_ptr%p%nbins) + dloc = loc(this_ptr%p%nbins) +end subroutine f90wrap_distribs_container_type__array__nbins + +subroutine f90wrap_distribs_container_type__array__sigma( & + this, nd, dtype, dshape, dloc & +) + use raffle__distribs_container, only: distribs_container_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer(c_int), intent(out) :: nd + integer(c_int), intent(out) :: dtype + integer(c_int), dimension(10), intent(out) :: dshape + integer*8, intent(out) :: dloc + + nd = 1 + dtype = 11 + this_ptr = transfer(this, this_ptr) + dshape(1:1) = shape(this_ptr%p%sigma) + dloc = loc(this_ptr%p%sigma) +end subroutine f90wrap_distribs_container_type__array__sigma + +subroutine f90wrap_distribs_container_type__array__width( & + this, nd, dtype, dshape, dloc & +) + use raffle__distribs_container, only: distribs_container_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer(c_int), intent(out) :: nd + integer(c_int), intent(out) :: dtype + integer(c_int), dimension(10), intent(out) :: dshape + integer*8, intent(out) :: dloc + + nd = 1 + dtype = 11 + this_ptr = transfer(this, this_ptr) + dshape(1:1) = shape(this_ptr%p%width) + dloc = loc(this_ptr%p%width) +end subroutine f90wrap_distribs_container_type__array__width + +subroutine f90wrap_distribs_container_type__array__cutoff_min( & + this, nd, dtype, dshape, dloc & +) + use raffle__distribs_container, only: distribs_container_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer(c_int), intent(out) :: nd + integer(c_int), intent(out) :: dtype + integer(c_int), dimension(10), intent(out) :: dshape + integer*8, intent(out) :: dloc + + nd = 1 + dtype = 11 + this_ptr = transfer(this, this_ptr) + dshape(1:1) = shape(this_ptr%p%cutoff_min) + dloc = loc(this_ptr%p%cutoff_min) +end subroutine f90wrap_distribs_container_type__array__cutoff_min + +subroutine f90wrap_distribs_container_type__array__cutoff_max( & + this, nd, dtype, dshape, dloc & +) + use raffle__distribs_container, only: distribs_container_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer(c_int), intent(out) :: nd + integer(c_int), intent(out) :: dtype + integer(c_int), dimension(10), intent(out) :: dshape + integer*8, intent(out) :: dloc + + nd = 1 + dtype = 11 + this_ptr = transfer(this, this_ptr) + dshape(1:1) = shape(this_ptr%p%cutoff_max) + dloc = loc(this_ptr%p%cutoff_max) +end subroutine f90wrap_distribs_container_type__array__cutoff_max + +subroutine f90wrap_distribs_container_type__array__radius_distance_tol( & + this, nd, dtype, dshape, dloc & +) + use raffle__distribs_container, only: distribs_container_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer(c_int), intent(out) :: nd + integer(c_int), intent(out) :: dtype + integer(c_int), dimension(10), intent(out) :: dshape + integer*8, intent(out) :: dloc + + nd = 1 + dtype = 11 + this_ptr = transfer(this, this_ptr) + dshape(1:1) = shape(this_ptr%p%radius_distance_tol) + dloc = loc(this_ptr%p%radius_distance_tol) +end subroutine f90wrap_distribs_container_type__array__radius_distance_tol +!############################################################################### + + +!############################################################################### +! distributions container type initialiser and finaliser +!############################################################################### +subroutine f90wrap_raffle__dc__dc_type_initialise(this) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_raffle__dc__dc_type_initialise + +subroutine f90wrap_raffle__dc__dc_type_finalise(this) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_raffle__dc__dc_type_finalise +!############################################################################### + + +!############################################################################### +! procedures to set distribution function parameters +!############################################################################### +subroutine f90wrap_raffle__dc__set_width__binding__dc_type( & + this, width & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(3), intent(in) :: width + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_width(width=width) +end subroutine f90wrap_raffle__dc__set_width__binding__dc_type + +subroutine f90wrap_raffle__dc__set_sigma__binding__dc_type( & + this, sigma & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(3), intent(in) :: sigma + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_sigma(sigma=sigma) +end subroutine f90wrap_raffle__dc__set_sigma__binding__dc_type + +subroutine f90wrap_raffle__dc__set_cutoff_min__binding__dc_type( & + this, cutoff_min & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(3), intent(in) :: cutoff_min + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_cutoff_min(cutoff_min=cutoff_min) +end subroutine f90wrap_raffle__dc__set_cutoff_min__binding__dc_type + +subroutine f90wrap_raffle__dc__set_cutoff_max__binding__dc_type( & + this, cutoff_max & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(3), intent(in) :: cutoff_max + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_cutoff_max(cutoff_max=cutoff_max) +end subroutine f90wrap_raffle__dc__set_cutoff_max__binding__dc_type + +subroutine f90wrap_raffle__dc__set_radius_distance_tol__binding__dc_type( & + this, radius_distance_tol & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(4), intent(in) :: radius_distance_tol + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_radius_distance_tol( & + radius_distance_tol=radius_distance_tol & + ) +end subroutine f90wrap_raffle__dc__set_radius_distance_tol__binding__dc_type +!############################################################################### + + +!############################################################################### +! create and update the generalised distribution functions +!############################################################################### +subroutine f90wrap_raffle__dc__create__binding__dc_type( & + this, basis_list, deallocate_systems, energy_above_hull_list, n0 & +) + use raffle__geom_rw, only: basis_type + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + + type basis_type_xnum_array + type(basis_type), dimension(:), allocatable :: items + end type basis_type_xnum_array + + type basis_type_xnum_array_ptr_type + type(basis_type_xnum_array), pointer :: p => NULL() + end type basis_type_xnum_array_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_xnum_array_ptr_type) :: basis_list_ptr + integer, intent(in), dimension(2) :: basis_list + logical, intent(in), optional :: deallocate_systems + real(4), dimension(n0), intent(in), optional :: energy_above_hull_list + integer :: n0 + !f2py intent(hide), depend(energy_above_hull_list) :: n0 = shape(energy_above_hull_list,0) + + this_ptr = transfer(this, this_ptr) + basis_list_ptr = transfer(basis_list, basis_list_ptr) + call this_ptr%p%create( & + basis_list=basis_list_ptr%p%items, & + energy_above_hull_list=energy_above_hull_list, & + deallocate_systems=deallocate_systems & + ) +end subroutine f90wrap_raffle__dc__create__binding__dc_type + +subroutine f90wrap_raffle__dc__update__binding__dc_type( & + this, basis_list, & + from_host, deallocate_systems, energy_above_hull_list, n0 & +) + use raffle__geom_rw, only: basis_type + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + + type basis_type_xnum_array + type(basis_type), dimension(:), allocatable :: items + end type basis_type_xnum_array + + type basis_type_xnum_array_ptr_type + type(basis_type_xnum_array), pointer :: p => NULL() + end type basis_type_xnum_array_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_xnum_array_ptr_type) :: basis_list_ptr + integer, intent(in), dimension(2) :: basis_list + logical, intent(in), optional :: from_host + logical, intent(in), optional :: deallocate_systems + real(4), dimension(n0), intent(in), optional :: energy_above_hull_list + integer :: n0 + !f2py intent(hide), depend(energy_above_hull_list) :: n0 = shape(energy_above_hull_list,0) + + this_ptr = transfer(this, this_ptr) + basis_list_ptr = transfer(basis_list, basis_list_ptr) + call this_ptr%p%update(basis_list=basis_list_ptr%p%items, & + energy_above_hull_list=energy_above_hull_list, & + from_host=from_host, & + deallocate_systems=deallocate_systems & + ) +end subroutine f90wrap_raffle__dc__update__binding__dc_type +!############################################################################### + + +!############################################################################### +! deallocate systems procedure +!############################################################################### +subroutine f90wrap_raffle__dc__deallocate_systems__binding__dc_type( & + this & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%deallocate_systems() +end subroutine f90wrap_raffle__dc__deallocate_systems__binding__dc_type +!############################################################################### + + +!############################################################################### +! add an individual basis to the set of distribution functions +! this does not update the generalised distribution function +!############################################################################### +subroutine f90wrap_raffle__dc__add_basis__binding__dc_type( & + this, basis & +) + use raffle__geom_rw, only: basis_type + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_ptr_type) :: basis_ptr + integer, intent(in), dimension(2) :: basis + this_ptr = transfer(this, this_ptr) + basis_ptr = transfer(basis, basis_ptr) + call this_ptr%p%add_basis(basis=basis_ptr%p) +end subroutine f90wrap_raffle__dc__add_basis__binding__dc_type +!############################################################################### + + +!############################################################################### +! get the number of elements in the distribution container +!############################################################################### +subroutine f90wrap_raffle__dc__get__num_elements( & + this, ret_num_elements & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + integer, intent(in) :: this(2) + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(out) :: ret_num_elements + + this_ptr = transfer(this, this_ptr) + if(.not.allocated(this_ptr%p%element_info)) then + ret_num_elements = 0 + else + ret_num_elements = size(this_ptr%p%element_info,1) + end if +end subroutine f90wrap_raffle__dc__get__num_elements +!############################################################################### + +!############################################################################### +! handle element reference energies and element pair bond radii +!############################################################################### +subroutine f90wrap_raffle__dc__set_element_energy__binding__dc_type( & + this, element, energy & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character(3), intent(in) :: element + real(4), intent(in) :: energy + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_element_energy(element=element, energy=energy) +end subroutine f90wrap_raffle__dc__set_element_energy__binding__dc_type + +subroutine f90wrap_raffle__dc__set_element_energies__binding__dc_type( & + this, elements, energies, n0 & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character(3), dimension(n0), intent(in) :: elements + real(4), dimension(n0), intent(in) :: energies + integer :: n0 + !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_element_energies(elements=elements, energies=energies) +end subroutine f90wrap_raffle__dc__set_element_energies__binding__dc_type + +subroutine f90wrap_raffle__dc__get_element_energies_sm__binding__dc_type( & + this, elements, energies, n0 & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character(3), intent(inout), dimension(n0) :: elements + real(4), intent(inout), dimension(n0) :: energies + integer :: n0 + !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%get_element_energies_staticmem(elements=elements, energies=energies) +end subroutine f90wrap_raffle__dc__get_element_energies_sm__binding__dc_type + + +subroutine f90wrap_raffle__dc__set_bond_radius__binding__dc_type( & + this, elements, radius & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character(3), dimension(2), intent(in) :: elements + real(4), intent(in) :: radius + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_bond_radius(elements=elements, radius=radius) +end subroutine f90wrap_raffle__dc__set_bond_radius__binding__dc_type + +subroutine f90wrap_raffle__dc__set_bond_radii__binding__dc_type( & + this, elements, radii, n0, n1, n2 & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character(3), intent(in), dimension(n0,n1) :: elements + real(4), intent(in), dimension(n2) :: radii + integer :: n0 + !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) + integer :: n1 + !f2py intent(hide), depend(elements) :: n1 = shape(elements,1) + integer :: n2 + !f2py intent(hide), depend(radii) :: n2 = shape(radii,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_bond_radii(elements=elements, radii=radii) +end subroutine f90wrap_raffle__dc__set_bond_radii__binding__dc_type + +subroutine f90wrap_raffle__dc__get_bond_radii_staticmem__binding__dc_type( & + this, elements, radii, n0 & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character(3), intent(inout), dimension(n0,2) :: elements + real(4), intent(inout), dimension(n0) :: radii + integer :: n0 + !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%get_bond_radii_staticmem(elements=elements, radii=radii) +end subroutine f90wrap_raffle__dc__get_bond_radii_staticmem__binding__dc_type +!############################################################################### + + +!############################################################################### +! initialise generalised distribution functions +!############################################################################### +subroutine f90wrap_raffle__dc__initialise_gdfs__binding__dc_type(this) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%initialise_gdfs() +end subroutine f90wrap_raffle__dc__initialise_gdfs__binding__dc_type +!############################################################################### + + +!############################################################################### +! evolve the generalised distribution functions +!############################################################################### +subroutine f90wrap_raffle__dc__evolve__binding__dc_type(this) !, system) + use raffle__distribs_container, only: distribs_container_type + implicit none + + ! type distribs_type_ptr_type + ! type(distribs_type), pointer :: p => NULL() + ! end type distribs_type_ptr_type + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + ! type(distribs_type_ptr_type) :: system_ptr + ! integer, optional, intent(in), dimension(2) :: system + this_ptr = transfer(this, this_ptr) + ! if (present(system)) then + ! system_ptr = transfer(system, system_ptr) + ! else + ! system_ptr%p => null() + ! end if + call this_ptr%p%evolve() !system=system_ptr%p) +end subroutine f90wrap_raffle__dc__evolve__binding__dc_type +!############################################################################### + + +!############################################################################### +! read and write distribution functions to file +!############################################################################### +subroutine f90wrap_raffle__dc__read__binding__dc_type( & + this, file & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character*(*), intent(in) :: file + this_ptr = transfer(this, this_ptr) + call this_ptr%p%read(file=file) +end subroutine f90wrap_raffle__dc__read__binding__dc_type + +subroutine f90wrap_raffle__dc__write__binding__dc_type( & + this, file & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character*(*), intent(in) :: file + this_ptr = transfer(this, this_ptr) + call this_ptr%p%write(file=file) +end subroutine f90wrap_raffle__dc__write__binding__dc_type + +subroutine f90wrap_raffle__dc__write_2body__binding__dc_type( & + this, file & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character*(*), intent(in) :: file + this_ptr = transfer(this, this_ptr) + call this_ptr%p%write_2body(file=file) +end subroutine f90wrap_raffle__dc__write_2body__binding__dc_type + +subroutine f90wrap_raffle__dc__write_3body__binding__dc_type( & + this, file & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character*(*), intent(in) :: file + this_ptr = transfer(this, this_ptr) + call this_ptr%p%write_3body(file=file) +end subroutine f90wrap_raffle__dc__write_3body__binding__dc_type + +subroutine f90wrap_raffle__dc__write_4body__binding__dc_type( & + this, file & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character*(*), intent(in) :: file + this_ptr = transfer(this, this_ptr) + call this_ptr%p%write_4body(file=file) +end subroutine f90wrap_raffle__dc__write_4body__binding__dc_type +!############################################################################### + + +!############################################################################### +! bin and pair index handling +!############################################################################### +subroutine f90wrap_raffle__dc__get_pair_index__binding__dc_type( & + this, species1, ret_idx, species2 & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + character(3), intent(in) :: species1 + integer, intent(out) :: ret_idx + character(3), intent(in) :: species2 + this_ptr = transfer(this, this_ptr) + ret_idx = this_ptr%p%get_pair_index(species1=species1, species2=species2) +end subroutine f90wrap_raffle__dc__get_pair_index__binding__dc_type + +subroutine f90wrap_raffle__dc__get_bin__binding__dc_type( & + this, value, ret_bin, dim & +) + use raffle__distribs_container, only: distribs_container_type + implicit none + + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type + type(distribs_container_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), intent(in) :: value + integer, intent(out) :: ret_bin + integer, intent(in) :: dim + this_ptr = transfer(this, this_ptr) + ret_bin = this_ptr%p%get_bin(value=value, dim=dim) +end subroutine f90wrap_raffle__dc__get_bin__binding__dc_type +!############################################################################### + +! End of module raffle__distribs_container defined in file ../src/lib/mod_distribs_container.f90 + diff --git a/src/wrapper/f90wrap_mod_evolver.f90 b/src/wrapper/f90wrap_mod_evolver.f90 deleted file mode 100644 index f3edff58..00000000 --- a/src/wrapper/f90wrap_mod_evolver.f90 +++ /dev/null @@ -1,1063 +0,0 @@ -! Module evolver defined in file ../src/lib/mod_evolver.f90 - -subroutine f90wrap_gvector_base_type__array__df_2body(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_base_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_base_type_ptr_type - type(gvector_base_type), pointer :: p => NULL() - end type gvector_base_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_base_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 2 - dtype = 11 - this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%df_2body)) then - dshape(1:2) = shape(this_ptr%p%df_2body) - dloc = loc(this_ptr%p%df_2body) - else - dloc = 0 - end if -end subroutine f90wrap_gvector_base_type__array__df_2body - -subroutine f90wrap_gvector_base_type__array__df_3body(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_base_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_base_type_ptr_type - type(gvector_base_type), pointer :: p => NULL() - end type gvector_base_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_base_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 2 - dtype = 11 - this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%df_3body)) then - dshape(1:2) = shape(this_ptr%p%df_3body) - dloc = loc(this_ptr%p%df_3body) - else - dloc = 0 - end if -end subroutine f90wrap_gvector_base_type__array__df_3body - -subroutine f90wrap_gvector_base_type__array__df_4body(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_base_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_base_type_ptr_type - type(gvector_base_type), pointer :: p => NULL() - end type gvector_base_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_base_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 2 - dtype = 11 - this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%df_4body)) then - dshape(1:2) = shape(this_ptr%p%df_4body) - dloc = loc(this_ptr%p%df_4body) - else - dloc = 0 - end if -end subroutine f90wrap_gvector_base_type__array__df_4body - -subroutine f90wrap_evolver__gvector_base_type_initialise(this) - use evolver, only: gvector_base_type - implicit none - - type gvector_base_type_ptr_type - type(gvector_base_type), pointer :: p => NULL() - end type gvector_base_type_ptr_type - type(gvector_base_type_ptr_type) :: this_ptr - integer, intent(out), dimension(2) :: this - allocate(this_ptr%p) - this = transfer(this_ptr, this) -end subroutine f90wrap_evolver__gvector_base_type_initialise - -subroutine f90wrap_evolver__gvector_base_type_finalise(this) - use evolver, only: gvector_base_type - implicit none - - type gvector_base_type_ptr_type - type(gvector_base_type), pointer :: p => NULL() - end type gvector_base_type_ptr_type - type(gvector_base_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - deallocate(this_ptr%p) -end subroutine f90wrap_evolver__gvector_base_type_finalise - -subroutine f90wrap_gvector_type__get__num_atoms(this, f90wrap_num_atoms) - use evolver, only: gvector_type - implicit none - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_num_atoms - - this_ptr = transfer(this, this_ptr) - f90wrap_num_atoms = this_ptr%p%num_atoms -end subroutine f90wrap_gvector_type__get__num_atoms - -subroutine f90wrap_gvector_type__set__num_atoms(this, f90wrap_num_atoms) - use evolver, only: gvector_type - implicit none - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_num_atoms - - this_ptr = transfer(this, this_ptr) - this_ptr%p%num_atoms = f90wrap_num_atoms -end subroutine f90wrap_gvector_type__set__num_atoms - -subroutine f90wrap_gvector_type__get__energy(this, f90wrap_energy) - use evolver, only: gvector_type - implicit none - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_energy - - this_ptr = transfer(this, this_ptr) - f90wrap_energy = this_ptr%p%energy -end subroutine f90wrap_gvector_type__get__energy - -subroutine f90wrap_gvector_type__set__energy(this, f90wrap_energy) - use evolver, only: gvector_type - implicit none - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_energy - - this_ptr = transfer(this, this_ptr) - this_ptr%p%energy = f90wrap_energy -end subroutine f90wrap_gvector_type__set__energy - -subroutine f90wrap_gvector_type__array__stoichiometry(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 1 - dtype = 5 - this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%stoichiometry)) then - dshape(1:1) = shape(this_ptr%p%stoichiometry) - dloc = loc(this_ptr%p%stoichiometry) - else - dloc = 0 - end if -end subroutine f90wrap_gvector_type__array__stoichiometry - -subroutine f90wrap_gvector_type__array__element_symbols(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 2 - dtype = 2 - this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%element_symbols)) then - dshape(1:2) = (/len(this_ptr%p%element_symbols(1)), & - shape(this_ptr%p%element_symbols)/) - dloc = loc(this_ptr%p%element_symbols) - else - dloc = 0 - end if -end subroutine f90wrap_gvector_type__array__element_symbols - -subroutine f90wrap_evolver__gvector_type_initialise(this) - use evolver, only: gvector_type - implicit none - - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - type(gvector_type_ptr_type) :: this_ptr - integer, intent(out), dimension(2) :: this - allocate(this_ptr%p) - this = transfer(this_ptr, this) -end subroutine f90wrap_evolver__gvector_type_initialise - -subroutine f90wrap_evolver__gvector_type_finalise(this) - use evolver, only: gvector_type - implicit none - - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - type(gvector_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - deallocate(this_ptr%p) -end subroutine f90wrap_evolver__gvector_type_finalise - -subroutine f90wrap_evolver__calculate__binding__gvector_type(this, basis, nbins, width, sigma, cutoff_min, cutoff_max, & - radius_distance_tol) - use evolver, only: gvector_type - use rw_geom, only: basis_type - implicit none - - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - type(gvector_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - type(basis_type_ptr_type) :: basis_ptr - integer, intent(in), dimension(2) :: basis - integer, dimension(3), intent(in), optional :: nbins - real(4), dimension(3), intent(in), optional :: width - real(4), dimension(3), intent(in), optional :: sigma - real(4), dimension(3), intent(in), optional :: cutoff_min - real(4), dimension(3), intent(in), optional :: cutoff_max - real(4), dimension(4), intent(in), optional :: radius_distance_tol - this_ptr = transfer(this, this_ptr) - basis_ptr = transfer(basis, basis_ptr) - call this_ptr%p%calculate(basis=basis_ptr%p, nbins=nbins, width=width, sigma=sigma, cutoff_min=cutoff_min, & - cutoff_max=cutoff_max, radius_distance_tol=radius_distance_tol) -end subroutine f90wrap_evolver__calculate__binding__gvector_type - -subroutine f90wrap_gvector_container_type__get__num_evaluated(this, f90wrap_num_evaluated) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_num_evaluated - - this_ptr = transfer(this, this_ptr) - f90wrap_num_evaluated = this_ptr%p%num_evaluated -end subroutine f90wrap_gvector_container_type__get__num_evaluated - -subroutine f90wrap_gvector_container_type__set__num_evaluated(this, f90wrap_num_evaluated) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_num_evaluated - - this_ptr = transfer(this, this_ptr) - this_ptr%p%num_evaluated = f90wrap_num_evaluated -end subroutine f90wrap_gvector_container_type__set__num_evaluated - -subroutine f90wrap_gvector_container_type__get__num_evaluated_allocated(this, f90wrap_num_evaluated_allocated) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_num_evaluated_allocated - - this_ptr = transfer(this, this_ptr) - f90wrap_num_evaluated_allocated = this_ptr%p%num_evaluated_allocated -end subroutine f90wrap_gvector_container_type__get__num_evaluated_allocated - -subroutine f90wrap_gvector_container_type__set__num_evaluated_allocated(this, f90wrap_num_evaluated_allocated) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_num_evaluated_allocated - - this_ptr = transfer(this, this_ptr) - this_ptr%p%num_evaluated_allocated = f90wrap_num_evaluated_allocated -end subroutine f90wrap_gvector_container_type__set__num_evaluated_allocated - -subroutine f90wrap_gvector_container_type__get__kBT(this, f90wrap_kBT) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_kBT - - this_ptr = transfer(this, this_ptr) - f90wrap_kBT = this_ptr%p%kBT -end subroutine f90wrap_gvector_container_type__get__kBT - -subroutine f90wrap_gvector_container_type__set__kBT(this, f90wrap_kBT) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_kBT - - this_ptr = transfer(this, this_ptr) - this_ptr%p%kBT = f90wrap_kBT -end subroutine f90wrap_gvector_container_type__set__kBT - -subroutine f90wrap_gvector_container_type__get__weight_by_hull(this, f90wrap_weight_by_hull) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_weight_by_hull - - this_ptr = transfer(this, this_ptr) - f90wrap_weight_by_hull = this_ptr%p%weight_by_hull -end subroutine f90wrap_gvector_container_type__get__weight_by_hull - -subroutine f90wrap_gvector_container_type__set__weight_by_hull(this, f90wrap_weight_by_hull) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_weight_by_hull - - this_ptr = transfer(this, this_ptr) - this_ptr%p%weight_by_hull = f90wrap_weight_by_hull -end subroutine f90wrap_gvector_container_type__set__weight_by_hull - -subroutine f90wrap_gvector_container_type__array__nbins(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_container_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 1 - dtype = 5 - this_ptr = transfer(this, this_ptr) - dshape(1:1) = shape(this_ptr%p%nbins) - dloc = loc(this_ptr%p%nbins) -end subroutine f90wrap_gvector_container_type__array__nbins - -subroutine f90wrap_gvector_container_type__array__sigma(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_container_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 1 - dtype = 11 - this_ptr = transfer(this, this_ptr) - dshape(1:1) = shape(this_ptr%p%sigma) - dloc = loc(this_ptr%p%sigma) -end subroutine f90wrap_gvector_container_type__array__sigma - -subroutine f90wrap_gvector_container_type__array__width(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_container_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 1 - dtype = 11 - this_ptr = transfer(this, this_ptr) - dshape(1:1) = shape(this_ptr%p%width) - dloc = loc(this_ptr%p%width) -end subroutine f90wrap_gvector_container_type__array__width - -subroutine f90wrap_gvector_container_type__array__cutoff_min(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_container_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 1 - dtype = 11 - this_ptr = transfer(this, this_ptr) - dshape(1:1) = shape(this_ptr%p%cutoff_min) - dloc = loc(this_ptr%p%cutoff_min) -end subroutine f90wrap_gvector_container_type__array__cutoff_min - -subroutine f90wrap_gvector_container_type__array__cutoff_max(this, nd, dtype, dshape, dloc) - use evolver, only: gvector_container_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer(c_int), intent(out) :: nd - integer(c_int), intent(out) :: dtype - integer(c_int), dimension(10), intent(out) :: dshape - integer*8, intent(out) :: dloc - - nd = 1 - dtype = 11 - this_ptr = transfer(this, this_ptr) - dshape(1:1) = shape(this_ptr%p%cutoff_max) - dloc = loc(this_ptr%p%cutoff_max) -end subroutine f90wrap_gvector_container_type__array__cutoff_max - -subroutine f90wrap_gvector_container_type__get__total(this, f90wrap_total) - use evolver, only: gvector_container_type, gvector_base_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type gvector_base_type_ptr_type - type(gvector_base_type), pointer :: p => NULL() - end type gvector_base_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_total(2) - type(gvector_base_type_ptr_type) :: total_ptr - - this_ptr = transfer(this, this_ptr) - total_ptr%p => this_ptr%p%total - f90wrap_total = transfer(total_ptr,f90wrap_total) -end subroutine f90wrap_gvector_container_type__get__total - -subroutine f90wrap_gvector_container_type__set__total(this, f90wrap_total) - use evolver, only: gvector_container_type, gvector_base_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type gvector_base_type_ptr_type - type(gvector_base_type), pointer :: p => NULL() - end type gvector_base_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_total(2) - type(gvector_base_type_ptr_type) :: total_ptr - - this_ptr = transfer(this, this_ptr) - total_ptr = transfer(f90wrap_total,total_ptr) - this_ptr%p%total = total_ptr%p -end subroutine f90wrap_gvector_container_type__set__total - -subroutine f90wrap_gvector_container_type__array_getitem__system(f90wrap_this, f90wrap_i, systemitem) - - use evolver, only: gvector_type, gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer, intent(in) :: f90wrap_this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_i - integer, intent(out) :: systemitem(2) - type(gvector_type_ptr_type) :: system_ptr - - this_ptr = transfer(f90wrap_this, this_ptr) - if (allocated(this_ptr%p%system)) then - if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%system)) then - call f90wrap_abort("array index out of range") - else - system_ptr%p => this_ptr%p%system(f90wrap_i) - systemitem = transfer(system_ptr,systemitem) - end if - else - call f90wrap_abort("derived type array not allocated") - end if -end subroutine f90wrap_gvector_container_type__array_getitem__system - -subroutine f90wrap_gvector_container_type__array_setitem__system(f90wrap_this, f90wrap_i, systemitem) - - use evolver, only: gvector_type, gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer, intent(in) :: f90wrap_this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_i - integer, intent(in) :: systemitem(2) - type(gvector_type_ptr_type) :: system_ptr - - this_ptr = transfer(f90wrap_this, this_ptr) - if (allocated(this_ptr%p%system)) then - if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%system)) then - call f90wrap_abort("array index out of range") - else - system_ptr = transfer(systemitem,system_ptr) - this_ptr%p%system(f90wrap_i) = system_ptr%p - endif - else - call f90wrap_abort("derived type array not allocated") - end if -end subroutine f90wrap_gvector_container_type__array_setitem__system - -subroutine f90wrap_gvector_container_type__array_len__system(f90wrap_this, f90wrap_n) - - use evolver, only: gvector_type, gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - integer, intent(out) :: f90wrap_n - integer, intent(in) :: f90wrap_this(2) - type(gvector_container_type_ptr_type) :: this_ptr - - this_ptr = transfer(f90wrap_this, this_ptr) - if (allocated(this_ptr%p%system)) then - f90wrap_n = size(this_ptr%p%system) - else - f90wrap_n = 0 - end if -end subroutine f90wrap_gvector_container_type__array_len__system - -subroutine f90wrap_evolver__gvector_container_type_initialise(this) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(out), dimension(2) :: this - allocate(this_ptr%p) - this = transfer(this_ptr, this) -end subroutine f90wrap_evolver__gvector_container_type_initialise - -subroutine f90wrap_evolver__gvector_container_type_finalise(this) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - deallocate(this_ptr%p) -end subroutine f90wrap_evolver__gvector_container_type_finalise - -subroutine f90wrap_evolver__set_width__binding__gvector_container_type(this, width) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - real(4), dimension(3), intent(in) :: width - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_width(width=width) -end subroutine f90wrap_evolver__set_width__binding__gvector_container_type - -subroutine f90wrap_evolver__set_sigma__binding__gvector_container_type(this, sigma) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - real(4), dimension(3), intent(in) :: sigma - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_sigma(sigma=sigma) -end subroutine f90wrap_evolver__set_sigma__binding__gvector_container_type - -subroutine f90wrap_evolver__set_cutoff_min__binding__gvector_container7007(this, cutoff_min) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - real(4), dimension(3), intent(in) :: cutoff_min - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_cutoff_min(cutoff_min=cutoff_min) -end subroutine f90wrap_evolver__set_cutoff_min__binding__gvector_container7007 - -subroutine f90wrap_evolver__set_cutoff_max__binding__gvector_container047c(this, cutoff_max) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - real(4), dimension(3), intent(in) :: cutoff_max - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_cutoff_max(cutoff_max=cutoff_max) -end subroutine f90wrap_evolver__set_cutoff_max__binding__gvector_container047c - -subroutine f90wrap_evolver__set_radius_distance_tol__binding__gvector_1dda(this, radius_distance_tol) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - real(4), dimension(4), intent(in) :: radius_distance_tol - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_radius_distance_tol(radius_distance_tol=radius_distance_tol) -end subroutine f90wrap_evolver__set_radius_distance_tol__binding__gvector_1dda - -subroutine f90wrap_evolver__create__binding__gvector_container_type( & - this, basis_list, deallocate_systems, energy_above_hull_list, n0 & -) - use rw_geom, only: basis_type - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - - type basis_type_xnum_array - type(basis_type), dimension(:), allocatable :: items - end type basis_type_xnum_array - - type basis_type_xnum_array_ptr_type - type(basis_type_xnum_array), pointer :: p => NULL() - end type basis_type_xnum_array_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - type(basis_type_xnum_array_ptr_type) :: basis_list_ptr - integer, intent(in), dimension(2) :: basis_list - logical, intent(in), optional :: deallocate_systems - real(4), dimension(n0), intent(in), optional :: energy_above_hull_list - integer :: n0 - !f2py intent(hide), depend(energy_above_hull_list) :: n0 = shape(energy_above_hull_list,0) - - this_ptr = transfer(this, this_ptr) - basis_list_ptr = transfer(basis_list, basis_list_ptr) - call this_ptr%p%create( & - basis_list=basis_list_ptr%p%items, & - energy_above_hull_list=energy_above_hull_list, & - deallocate_systems=deallocate_systems & - ) -end subroutine f90wrap_evolver__create__binding__gvector_container_type - -subroutine f90wrap_evolver__update__binding__gvector_container_type( & - this, basis_list, & - from_host, deallocate_systems, energy_above_hull_list, n0 & -) - use rw_geom, only: basis_type - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - - type basis_type_xnum_array - type(basis_type), dimension(:), allocatable :: items - end type basis_type_xnum_array - - type basis_type_xnum_array_ptr_type - type(basis_type_xnum_array), pointer :: p => NULL() - end type basis_type_xnum_array_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - type(basis_type_xnum_array_ptr_type) :: basis_list_ptr - integer, intent(in), dimension(2) :: basis_list - logical, intent(in), optional :: from_host - logical, intent(in), optional :: deallocate_systems - real(4), dimension(n0), intent(in), optional :: energy_above_hull_list - integer :: n0 - !f2py intent(hide), depend(energy_above_hull_list) :: n0 = shape(energy_above_hull_list,0) - - this_ptr = transfer(this, this_ptr) - basis_list_ptr = transfer(basis_list, basis_list_ptr) - call this_ptr%p%update(basis_list=basis_list_ptr%p%items, & - energy_above_hull_list=energy_above_hull_list, & - from_host=from_host, & - deallocate_systems=deallocate_systems & - ) -end subroutine f90wrap_evolver__update__binding__gvector_container_type - -subroutine f90wrap_evolver__deallocate_systems__binding__gvector_conta8f02(this) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - call this_ptr%p%deallocate_systems() -end subroutine f90wrap_evolver__deallocate_systems__binding__gvector_conta8f02 - -subroutine f90wrap_evolver__add_basis__binding__gvector_container_type(this, basis) - use rw_geom, only: basis_type - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - type(basis_type_ptr_type) :: basis_ptr - integer, intent(in), dimension(2) :: basis - this_ptr = transfer(this, this_ptr) - basis_ptr = transfer(basis, basis_ptr) - call this_ptr%p%add_basis(basis=basis_ptr%p) -end subroutine f90wrap_evolver__add_basis__binding__gvector_container_type - -subroutine f90wrap_evolver__get__num_elements(this, ret_num_elements) - use evolver, only: gvector_container_type - implicit none - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - integer, intent(in) :: this(2) - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(out) :: ret_num_elements - - this_ptr = transfer(this, this_ptr) - if(.not.allocated(this_ptr%p%element_info)) then - ret_num_elements = 0 - else - ret_num_elements = size(this_ptr%p%element_info,1) - end if -end subroutine f90wrap_evolver__get__num_elements - -subroutine f90wrap_evolver__set_element_energies__binding__gvector_con0537(this, elements, energies, n0) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character(3), dimension(n0), intent(in) :: elements - real(4), dimension(n0), intent(in) :: energies - integer :: n0 - !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_element_energies(elements=elements, energies=energies) -end subroutine f90wrap_evolver__set_element_energies__binding__gvector_con0537 - -subroutine f90wrap_evolver__get_element_energies_staticmem__binding__g4f53(this, elements, energies, n0) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character(3), intent(inout), dimension(n0) :: elements - real(4), intent(inout), dimension(n0) :: energies - integer :: n0 - !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) - this_ptr = transfer(this, this_ptr) - call this_ptr%p%get_element_energies_staticmem(elements=elements, energies=energies) -end subroutine f90wrap_evolver__get_element_energies_staticmem__binding__g4f53 - -subroutine f90wrap_evolver__set_bond_radius__binding__gvector_containe7df9(this, elements, radius) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character(3), dimension(2), intent(in) :: elements - real(4), intent(in) :: radius - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_bond_radius(elements=elements, radius=radius) -end subroutine f90wrap_evolver__set_bond_radius__binding__gvector_containe7df9 - -subroutine f90wrap_evolver__set_bond_radii__binding__gvector_container83c5(this, elements, radii, n0, n1, n2) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character(3), intent(in), dimension(n0,n1) :: elements - real(4), intent(in), dimension(n2) :: radii - integer :: n0 - !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) - integer :: n1 - !f2py intent(hide), depend(elements) :: n1 = shape(elements,1) - integer :: n2 - !f2py intent(hide), depend(radii) :: n2 = shape(radii,0) - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_bond_radii(elements=elements, radii=radii) -end subroutine f90wrap_evolver__set_bond_radii__binding__gvector_container83c5 - -subroutine f90wrap_evolver__get_bond_radii_staticmem__binding__gvectord2e1(this, elements, radii, n0) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character(3), intent(inout), dimension(n0,2) :: elements - real(4), intent(inout), dimension(n0) :: radii - integer :: n0 - !f2py intent(hide), depend(elements) :: n0 = shape(elements,0) - this_ptr = transfer(this, this_ptr) - call this_ptr%p%get_bond_radii_staticmem(elements=elements, radii=radii) -end subroutine f90wrap_evolver__get_bond_radii_staticmem__binding__gvectord2e1 - -! subroutine f90wrap_evolver__set_best_energy__binding__gvector_containe4680(this) -! use evolver, only: gvector_container_type -! implicit none - -! type gvector_container_type_ptr_type -! type(gvector_container_type), pointer :: p => NULL() -! end type gvector_container_type_ptr_type -! type(gvector_container_type_ptr_type) :: this_ptr -! integer, intent(in), dimension(2) :: this -! this_ptr = transfer(this, this_ptr) -! call this_ptr%p%set_best_energy() -! end subroutine f90wrap_evolver__set_best_energy__binding__gvector_containe4680 - -subroutine f90wrap_evolver__initialise_gvectors__binding__gvector_contc1f2(this) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - call this_ptr%p%initialise_gvectors() -end subroutine f90wrap_evolver__initialise_gvectors__binding__gvector_contc1f2 - -subroutine f90wrap_evolver__evolve__binding__gvector_container_type(this, system) - use evolver, only: gvector_type, gvector_container_type - implicit none - - type gvector_type_ptr_type - type(gvector_type), pointer :: p => NULL() - end type gvector_type_ptr_type - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - type(gvector_type_ptr_type) :: system_ptr - integer, optional, intent(in), dimension(2) :: system - this_ptr = transfer(this, this_ptr) - if (present(system)) then - system_ptr = transfer(system, system_ptr) - else - system_ptr%p => null() - end if - call this_ptr%p%evolve(system=system_ptr%p) -end subroutine f90wrap_evolver__evolve__binding__gvector_container_type - -subroutine f90wrap_evolver__write__binding__gvector_container_type(this, file) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character*(*), intent(in) :: file - this_ptr = transfer(this, this_ptr) - call this_ptr%p%write(file=file) -end subroutine f90wrap_evolver__write__binding__gvector_container_type - -subroutine f90wrap_evolver__read__binding__gvector_container_type(this, file) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character*(*), intent(in) :: file - this_ptr = transfer(this, this_ptr) - call this_ptr%p%read(file=file) -end subroutine f90wrap_evolver__read__binding__gvector_container_type - -subroutine f90wrap_evolver__write_2body__binding__gvector_container_type(this, file) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character*(*), intent(in) :: file - this_ptr = transfer(this, this_ptr) - call this_ptr%p%write_2body(file=file) -end subroutine f90wrap_evolver__write_2body__binding__gvector_container_type - -subroutine f90wrap_evolver__write_3body__binding__gvector_container_type(this, file) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character*(*), intent(in) :: file - this_ptr = transfer(this, this_ptr) - call this_ptr%p%write_3body(file=file) -end subroutine f90wrap_evolver__write_3body__binding__gvector_container_type - -subroutine f90wrap_evolver__write_4body__binding__gvector_container_type(this, file) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character*(*), intent(in) :: file - this_ptr = transfer(this, this_ptr) - call this_ptr%p%write_4body(file=file) -end subroutine f90wrap_evolver__write_4body__binding__gvector_container_type - -subroutine f90wrap_evolver__get_pair_index__binding__gvector_container4618(this, species1, ret_idx, species2) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - character(3), intent(in) :: species1 - integer, intent(out) :: ret_idx - character(3), intent(in) :: species2 - this_ptr = transfer(this, this_ptr) - ret_idx = this_ptr%p%get_pair_index(species1=species1, species2=species2) -end subroutine f90wrap_evolver__get_pair_index__binding__gvector_container4618 - -subroutine f90wrap_evolver__get_bin__binding__gvector_container_type(this, value, ret_bin, dim) - use evolver, only: gvector_container_type - implicit none - - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type - type(gvector_container_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - real(4), intent(in) :: value - integer, intent(out) :: ret_bin - integer, intent(in) :: dim - this_ptr = transfer(this, this_ptr) - ret_bin = this_ptr%p%get_bin(value=value, dim=dim) -end subroutine f90wrap_evolver__get_bin__binding__gvector_container_type - -! End of module evolver defined in file ../src/lib/mod_evolver.f90 - diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 77b8e88b..67480ce9 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1,7 +1,10 @@ ! Module generator defined in file ../src/lib/mod_generator.f90 +!############################################################################### +! stoichiometry derived type +!############################################################################### subroutine f90wrap_stoichiometry_type__get__element(this, f90wrap_element) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_ptr_type type(stoichiometry_type), pointer :: p => NULL() @@ -15,7 +18,7 @@ subroutine f90wrap_stoichiometry_type__get__element(this, f90wrap_element) end subroutine f90wrap_stoichiometry_type__get__element subroutine f90wrap_stoichiometry_type__set__element(this, f90wrap_element) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_ptr_type type(stoichiometry_type), pointer :: p => NULL() @@ -29,7 +32,7 @@ subroutine f90wrap_stoichiometry_type__set__element(this, f90wrap_element) end subroutine f90wrap_stoichiometry_type__set__element subroutine f90wrap_stoichiometry_type__get__num(this, f90wrap_num) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_ptr_type type(stoichiometry_type), pointer :: p => NULL() @@ -43,7 +46,7 @@ subroutine f90wrap_stoichiometry_type__get__num(this, f90wrap_num) end subroutine f90wrap_stoichiometry_type__get__num subroutine f90wrap_stoichiometry_type__set__num(this, f90wrap_num) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_ptr_type type(stoichiometry_type), pointer :: p => NULL() @@ -57,7 +60,7 @@ subroutine f90wrap_stoichiometry_type__set__num(this, f90wrap_num) end subroutine f90wrap_stoichiometry_type__set__num subroutine f90wrap_stoichiometry_type_initialise(this) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_ptr_type @@ -70,7 +73,7 @@ subroutine f90wrap_stoichiometry_type_initialise(this) end subroutine f90wrap_stoichiometry_type_initialise subroutine f90wrap_stoichiometry_type_finalise(this) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_ptr_type @@ -85,7 +88,7 @@ end subroutine f90wrap_stoichiometry_type_finalise subroutine f90wrap_stoich_type_xnum_array__array_getitem__items( & this, f90wrap_i, itemsitem) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_xnum_array @@ -114,7 +117,7 @@ subroutine f90wrap_stoich_type_xnum_array__array_getitem__items( & end subroutine f90wrap_stoich_type_xnum_array__array_getitem__items subroutine f90wrap_stoich_type_xnum_array__array_setitem__items(this, f90wrap_i, itemsitem) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_xnum_array @@ -143,7 +146,7 @@ subroutine f90wrap_stoich_type_xnum_array__array_setitem__items(this, f90wrap_i, end subroutine f90wrap_stoich_type_xnum_array__array_setitem__items subroutine f90wrap_stoich_type_xnum_array__array_len__items(this, f90wrap_n) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_xnum_array @@ -161,7 +164,7 @@ subroutine f90wrap_stoich_type_xnum_array__array_len__items(this, f90wrap_n) end subroutine f90wrap_stoich_type_xnum_array__array_len__items subroutine f90wrap_stoich_type_xnum_array__array_alloc__items(this, num) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_xnum_array @@ -181,7 +184,7 @@ subroutine f90wrap_stoich_type_xnum_array__array_alloc__items(this, num) end subroutine f90wrap_stoich_type_xnum_array__array_alloc__items subroutine f90wrap_stoich_type_xnum_array__array_dealloc__items(this) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_xnum_array @@ -198,9 +201,14 @@ subroutine f90wrap_stoich_type_xnum_array__array_dealloc__items(this) deallocate(this_ptr%p%items) this = transfer(this_ptr, this) end subroutine f90wrap_stoich_type_xnum_array__array_dealloc__items +!############################################################################### + +!############################################################################### +! generator contained stoichiometry +!############################################################################### subroutine f90wrap_generator__stoich_type_xnum_array_initialise(this) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_xnum_array @@ -217,7 +225,7 @@ subroutine f90wrap_generator__stoich_type_xnum_array_initialise(this) end subroutine f90wrap_generator__stoich_type_xnum_array_initialise subroutine f90wrap_generator__stoich_type_xnum_array_finalise(this) - use generator, only: stoichiometry_type + use raffle__generator, only: stoichiometry_type implicit none type stoichiometry_type_xnum_array @@ -232,12 +240,16 @@ subroutine f90wrap_generator__stoich_type_xnum_array_finalise(this) this_ptr = transfer(this, this_ptr) deallocate(this_ptr%p) end subroutine f90wrap_generator__stoich_type_xnum_array_finalise +!############################################################################### - - -subroutine f90wrap_raffle_generator_type__get__num_structures(this, f90wrap_num_structures) - use generator, only: raffle_generator_type +!############################################################################### +! number of generated structures +!############################################################################### +subroutine f90wrap_raffle_generator_type__get__num_structures( & + this, f90wrap_num_structures & +) + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -250,8 +262,10 @@ subroutine f90wrap_raffle_generator_type__get__num_structures(this, f90wrap_num_ f90wrap_num_structures = this_ptr%p%num_structures end subroutine f90wrap_raffle_generator_type__get__num_structures -subroutine f90wrap_raffle_generator_type__set__num_structures(this, f90wrap_num_structures) - use generator, only: raffle_generator_type +subroutine f90wrap_raffle_generator_type__set__num_structures( & + this, f90wrap_num_structures & +) + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -263,10 +277,15 @@ subroutine f90wrap_raffle_generator_type__set__num_structures(this, f90wrap_num_ this_ptr = transfer(this, this_ptr) this_ptr%p%num_structures = f90wrap_num_structures end subroutine f90wrap_raffle_generator_type__set__num_structures +!############################################################################### + +!############################################################################### +! host handling +!############################################################################### subroutine f90wrap_raffle_generator_type__get__host(this, f90wrap_host) - use generator, only: raffle_generator_type - use rw_geom, only: basis_type + use raffle__generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -285,8 +304,8 @@ subroutine f90wrap_raffle_generator_type__get__host(this, f90wrap_host) end subroutine f90wrap_raffle_generator_type__get__host subroutine f90wrap_raffle_generator_type__set__host(this, f90wrap_host) - use generator, only: raffle_generator_type - use rw_geom, only: basis_type + use raffle__generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -303,9 +322,16 @@ subroutine f90wrap_raffle_generator_type__set__host(this, f90wrap_host) host_ptr = transfer(f90wrap_host, host_ptr) this_ptr%p%host = host_ptr%p end subroutine f90wrap_raffle_generator_type__set__host +!############################################################################### + -subroutine f90wrap_raffle_generator_type__array__grid(this, nd, dtype, dshape, dloc) - use generator, only: raffle_generator_type +!############################################################################### +! viability grid parameters +!############################################################################### +subroutine f90wrap_raffle_generator_type__array__grid( & + this, nd, dtype, dshape, dloc & +) + use raffle__generator, only: raffle_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none type raffle_generator_type_ptr_type @@ -325,8 +351,10 @@ subroutine f90wrap_raffle_generator_type__array__grid(this, nd, dtype, dshape, d dloc = loc(this_ptr%p%grid) end subroutine f90wrap_raffle_generator_type__array__grid -subroutine f90wrap_raffle_generator_type__array__grid_offset(this, nd, dtype, dshape, dloc) - use generator, only: raffle_generator_type +subroutine f90wrap_raffle_generator_type__array__grid_offset( & + this, nd, dtype, dshape, dloc & +) + use raffle__generator, only: raffle_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none type raffle_generator_type_ptr_type @@ -346,8 +374,10 @@ subroutine f90wrap_raffle_generator_type__array__grid_offset(this, nd, dtype, ds dloc = loc(this_ptr%p%grid_offset) end subroutine f90wrap_raffle_generator_type__array__grid_offset -subroutine f90wrap_raffle_generator_type__get__grid_spacing(this, f90wrap_grid_spacing) - use generator, only: raffle_generator_type +subroutine f90wrap_raffle_generator_type__get__grid_spacing( & + this, f90wrap_grid_spacing & +) + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -360,8 +390,10 @@ subroutine f90wrap_raffle_generator_type__get__grid_spacing(this, f90wrap_grid_s f90wrap_grid_spacing = this_ptr%p%grid_spacing end subroutine f90wrap_raffle_generator_type__get__grid_spacing -subroutine f90wrap_raffle_generator_type__set__grid_spacing(this, f90wrap_grid_spacing) - use generator, only: raffle_generator_type +subroutine f90wrap_raffle_generator_type__set__grid_spacing( & + this, f90wrap_grid_spacing & +) + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -373,49 +405,65 @@ subroutine f90wrap_raffle_generator_type__set__grid_spacing(this, f90wrap_grid_s this_ptr = transfer(this, this_ptr) this_ptr%p%grid_spacing = f90wrap_grid_spacing end subroutine f90wrap_raffle_generator_type__set__grid_spacing +!############################################################################### + -subroutine f90wrap_raffle_generator_type__get__distributions(this, f90wrap_distributions) - use generator, only: raffle_generator_type - use evolver, only: gvector_container_type +!############################################################################### +! distribution function handling +!############################################################################### +subroutine f90wrap_raffle_generator_type__get__distributions( & + this, f90wrap_distributions & +) + use raffle__generator, only: raffle_generator_type + use raffle__distribs_container, only: distribs_container_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() end type raffle_generator_type_ptr_type - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type integer, intent(in) :: this(2) type(raffle_generator_type_ptr_type) :: this_ptr integer, intent(out) :: f90wrap_distributions(2) - type(gvector_container_type_ptr_type) :: distributions_ptr + type(distribs_container_type_ptr_type) :: distributions_ptr this_ptr = transfer(this, this_ptr) distributions_ptr%p => this_ptr%p%distributions f90wrap_distributions = transfer(distributions_ptr,f90wrap_distributions) end subroutine f90wrap_raffle_generator_type__get__distributions -subroutine f90wrap_raffle_generator_type__set__distributions(this, f90wrap_distributions) - use generator, only: raffle_generator_type - use evolver, only: gvector_container_type +subroutine f90wrap_raffle_generator_type__set__distributions( & + this, f90wrap_distributions & +) + use raffle__generator, only: raffle_generator_type + use raffle__distribs_container, only: distribs_container_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() end type raffle_generator_type_ptr_type - type gvector_container_type_ptr_type - type(gvector_container_type), pointer :: p => NULL() - end type gvector_container_type_ptr_type + type distribs_container_type_ptr_type + type(distribs_container_type), pointer :: p => NULL() + end type distribs_container_type_ptr_type integer, intent(in) :: this(2) type(raffle_generator_type_ptr_type) :: this_ptr integer, intent(in) :: f90wrap_distributions(2) - type(gvector_container_type_ptr_type) :: distributions_ptr + type(distribs_container_type_ptr_type) :: distributions_ptr this_ptr = transfer(this, this_ptr) distributions_ptr = transfer(f90wrap_distributions,distributions_ptr) this_ptr%p%distributions = distributions_ptr%p end subroutine f90wrap_raffle_generator_type__set__distributions +!############################################################################### -subroutine f90wrap_raffle_generator_type__get__max_attempts(this, f90wrap_max_attempts) - use generator, only: raffle_generator_type + +!############################################################################### +! random walk parameters +!############################################################################### +subroutine f90wrap_raffle_generator_type__get__max_attempts( & + this, f90wrap_max_attempts & +) + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -428,8 +476,10 @@ subroutine f90wrap_raffle_generator_type__get__max_attempts(this, f90wrap_max_at f90wrap_max_attempts = this_ptr%p%max_attempts end subroutine f90wrap_raffle_generator_type__get__max_attempts -subroutine f90wrap_raffle_generator_type__set__max_attempts(this, f90wrap_max_attempts) - use generator, only: raffle_generator_type +subroutine f90wrap_raffle_generator_type__set__max_attempts( & + this, f90wrap_max_attempts & +) + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type type(raffle_generator_type), pointer :: p => NULL() @@ -442,8 +492,79 @@ subroutine f90wrap_raffle_generator_type__set__max_attempts(this, f90wrap_max_at this_ptr%p%max_attempts = f90wrap_max_attempts end subroutine f90wrap_raffle_generator_type__set__max_attempts -subroutine f90wrap_raffle_generator_type__array__method_probab(this, nd, dtype, dshape, dloc) - use generator, only: raffle_generator_type +subroutine f90wrap_raffle_generator_type__get__walk_step_size_coarse( & + this, f90wrap_walk_step_size_coarse & +) + use raffle__generator, only: raffle_generator_type + implicit none + type raffle_generator_type_ptr_type + type(raffle_generator_type), pointer :: p => NULL() + end type raffle_generator_type_ptr_type + integer, intent(in) :: this(2) + type(raffle_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_walk_step_size_coarse + + this_ptr = transfer(this, this_ptr) + f90wrap_walk_step_size_coarse = this_ptr%p%walk_step_size_coarse +end subroutine f90wrap_raffle_generator_type__get__walk_step_size_coarse + +subroutine f90wrap_raffle_generator_type__set__walk_step_size_coarse( & + this, f90wrap_walk_step_size_coarse & +) + use raffle__generator, only: raffle_generator_type + implicit none + type raffle_generator_type_ptr_type + type(raffle_generator_type), pointer :: p => NULL() + end type raffle_generator_type_ptr_type + integer, intent(in) :: this(2) + type(raffle_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_walk_step_size_coarse + + this_ptr = transfer(this, this_ptr) + this_ptr%p%walk_step_size_coarse = f90wrap_walk_step_size_coarse +end subroutine f90wrap_raffle_generator_type__set__walk_step_size_coarse + +subroutine f90wrap_raffle_generator_type__get__walk_step_size_fine( & + this, f90wrap_walk_step_size_fine & +) + use raffle__generator, only: raffle_generator_type + implicit none + type raffle_generator_type_ptr_type + type(raffle_generator_type), pointer :: p => NULL() + end type raffle_generator_type_ptr_type + integer, intent(in) :: this(2) + type(raffle_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_walk_step_size_fine + + this_ptr = transfer(this, this_ptr) + f90wrap_walk_step_size_fine = this_ptr%p%walk_step_size_fine +end subroutine f90wrap_raffle_generator_type__get__walk_step_size_fine + +subroutine f90wrap_raffle_generator_type__set__walk_step_size_fine( & + this, f90wrap_walk_step_size_fine & +) + use raffle__generator, only: raffle_generator_type + implicit none + type raffle_generator_type_ptr_type + type(raffle_generator_type), pointer :: p => NULL() + end type raffle_generator_type_ptr_type + integer, intent(in) :: this(2) + type(raffle_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_walk_step_size_fine + + this_ptr = transfer(this, this_ptr) + this_ptr%p%walk_step_size_fine = f90wrap_walk_step_size_fine +end subroutine f90wrap_raffle_generator_type__set__walk_step_size_fine +!############################################################################### + + +!############################################################################### +! placement method ratio +!############################################################################### +subroutine f90wrap_raffle_generator_type__array__method_probab( & + this, nd, dtype, dshape, dloc & +) + use raffle__generator, only: raffle_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none type raffle_generator_type_ptr_type @@ -462,11 +583,18 @@ subroutine f90wrap_raffle_generator_type__array__method_probab(this, nd, dtype, dshape(1:1) = shape(this_ptr%p%method_probab) dloc = loc(this_ptr%p%method_probab) end subroutine f90wrap_raffle_generator_type__array__method_probab +!############################################################################### + -subroutine f90wrap_raffle_generator_type__array_getitem__structures(f90wrap_this, f90wrap_i, structuresitem) +!############################################################################### +! generated structures handling +!############################################################################### +subroutine f90wrap_raffle_generator_type__array_getitem__structures( & + f90wrap_this, f90wrap_i, structuresitem & +) - use generator, only: raffle_generator_type - use rw_geom, only: basis_type + use raffle__generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type implicit none type raffle_generator_type_ptr_type @@ -494,10 +622,12 @@ subroutine f90wrap_raffle_generator_type__array_getitem__structures(f90wrap_this end if end subroutine f90wrap_raffle_generator_type__array_getitem__structures -subroutine f90wrap_raffle_generator_type__array_setitem__structures(f90wrap_this, f90wrap_i, structuresitem) +subroutine f90wrap_raffle_generator_type__array_setitem__structures( & + f90wrap_this, f90wrap_i, structuresitem & +) - use generator, only: raffle_generator_type - use rw_geom, only: basis_type + use raffle__generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type implicit none type raffle_generator_type_ptr_type @@ -525,10 +655,12 @@ subroutine f90wrap_raffle_generator_type__array_setitem__structures(f90wrap_this end if end subroutine f90wrap_raffle_generator_type__array_setitem__structures -subroutine f90wrap_raffle_generator_type__array_len__structures(f90wrap_this, f90wrap_n) +subroutine f90wrap_raffle_generator_type__array_len__structures( & + f90wrap_this, f90wrap_n & +) - use generator, only: raffle_generator_type - use rw_geom, only: basis_type + use raffle__generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type implicit none type raffle_generator_type_ptr_type @@ -545,9 +677,14 @@ subroutine f90wrap_raffle_generator_type__array_len__structures(f90wrap_this, f9 f90wrap_n = 0 end if end subroutine f90wrap_raffle_generator_type__array_len__structures +!############################################################################### + +!############################################################################### +! generator derived type initialisation and finalisation +!############################################################################### subroutine f90wrap_generator__raffle_generator_type_initialise(this) - use generator, only: raffle_generator_type + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type @@ -560,7 +697,7 @@ subroutine f90wrap_generator__raffle_generator_type_initialise(this) end subroutine f90wrap_generator__raffle_generator_type_initialise subroutine f90wrap_generator__raffle_generator_type_finalise(this) - use generator, only: raffle_generator_type + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type @@ -571,10 +708,15 @@ subroutine f90wrap_generator__raffle_generator_type_finalise(this) this_ptr = transfer(this, this_ptr) deallocate(this_ptr%p) end subroutine f90wrap_generator__raffle_generator_type_finalise +!############################################################################### + +!############################################################################### +! generator type procedure bindings +!############################################################################### subroutine f90wrap_generator__set_host__binding__rgt(this, host) - use rw_geom, only: basis_type - use generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type @@ -592,8 +734,10 @@ subroutine f90wrap_generator__set_host__binding__rgt(this, host) call this_ptr%p%set_host(host=host_ptr%p) end subroutine f90wrap_generator__set_host__binding__rgt -subroutine f90wrap_generator__set_grid__binding__raffle_generator_type(this, grid, grid_spacing, grid_offset) - use generator, only: raffle_generator_type +subroutine f90wrap_generator__set_grid__binding__raffle_generator_type( & + this, grid, grid_spacing, grid_offset & +) + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type @@ -605,11 +749,15 @@ subroutine f90wrap_generator__set_grid__binding__raffle_generator_type(this, gri real(4), intent(in), optional :: grid_spacing real(4), dimension(3), intent(in), optional :: grid_offset this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_grid(grid=grid, grid_spacing=grid_spacing, grid_offset=grid_offset) + call this_ptr%p%set_grid( & + grid = grid, & + grid_spacing = grid_spacing, & + grid_offset = grid_offset & + ) end subroutine f90wrap_generator__set_grid__binding__raffle_generator_type subroutine f90wrap_generator__reset_grid__binding__raffle_generator_type(this) - use generator, only: raffle_generator_type + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type @@ -624,7 +772,7 @@ end subroutine f90wrap_generator__reset_grid__binding__raffle_generator_type subroutine f90wrap_generator__generate__binding__rgt( & this, num_structures, stoichiometry, & method_probab, seed, verbose) - use generator, only: raffle_generator_type, stoichiometry_type + use raffle__generator, only: raffle_generator_type, stoichiometry_type implicit none type raffle_generator_type_ptr_type @@ -660,8 +808,8 @@ subroutine f90wrap_generator__generate__binding__rgt( & end subroutine f90wrap_generator__generate__binding__rgt subroutine f90wrap_generator__evaluate__binding__rgt(this, ret_viability, basis) - use rw_geom, only: basis_type - use generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type @@ -681,8 +829,8 @@ subroutine f90wrap_generator__evaluate__binding__rgt(this, ret_viability, basis) end subroutine f90wrap_generator__evaluate__binding__rgt subroutine f90wrap_generator__get_structures__binding__rgt(this, ret_structures) - use rw_geom, only: basis_type - use generator, only: raffle_generator_type + use raffle__geom_rw, only: basis_type + use raffle__generator, only: raffle_generator_type implicit none type raffle_generator_type_ptr_type @@ -705,6 +853,7 @@ subroutine f90wrap_generator__get_structures__binding__rgt(this, ret_structures) ret_structures_ptr%p%items = this_ptr%p%get_structures() ret_structures = transfer(ret_structures_ptr,ret_structures) end subroutine f90wrap_generator__get_structures__binding__rgt +!############################################################################### ! End of module generator defined in file ../src/lib/mod_generator.f90 diff --git a/src/wrapper/f90wrap_mod_rw_geom.f90 b/src/wrapper/f90wrap_mod_rw_geom.f90 index 1a876047..6759892b 100644 --- a/src/wrapper/f90wrap_mod_rw_geom.f90 +++ b/src/wrapper/f90wrap_mod_rw_geom.f90 @@ -1,7 +1,7 @@ -! Module rw_geom defined in file ../src/lib/mod_rw_geom.f90 +! Module raffle__geom_rw defined in file ../src/lib/mod_rw_geom.f90 subroutine f90wrap_species_type__array__atom(this, nd, dtype, dshape, dloc) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type use, intrinsic :: iso_c_binding, only : c_int implicit none type species_type_ptr_type @@ -26,7 +26,7 @@ subroutine f90wrap_species_type__array__atom(this, nd, dtype, dshape, dloc) end subroutine f90wrap_species_type__array__atom subroutine f90wrap_species_type__get__mass(this, f90wrap_mass) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -40,7 +40,7 @@ subroutine f90wrap_species_type__get__mass(this, f90wrap_mass) end subroutine f90wrap_species_type__get__mass subroutine f90wrap_species_type__set__mass(this, f90wrap_mass) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -54,7 +54,7 @@ subroutine f90wrap_species_type__set__mass(this, f90wrap_mass) end subroutine f90wrap_species_type__set__mass subroutine f90wrap_species_type__get__charge(this, f90wrap_charge) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -68,7 +68,7 @@ subroutine f90wrap_species_type__get__charge(this, f90wrap_charge) end subroutine f90wrap_species_type__get__charge subroutine f90wrap_species_type__set__charge(this, f90wrap_charge) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -82,7 +82,7 @@ subroutine f90wrap_species_type__set__charge(this, f90wrap_charge) end subroutine f90wrap_species_type__set__charge subroutine f90wrap_species_type__get__radius(this, f90wrap_radius) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -96,7 +96,7 @@ subroutine f90wrap_species_type__get__radius(this, f90wrap_radius) end subroutine f90wrap_species_type__get__radius subroutine f90wrap_species_type__set__radius(this, f90wrap_radius) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -110,7 +110,7 @@ subroutine f90wrap_species_type__set__radius(this, f90wrap_radius) end subroutine f90wrap_species_type__set__radius subroutine f90wrap_species_type__get__name(this, f90wrap_name) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -124,7 +124,7 @@ subroutine f90wrap_species_type__get__name(this, f90wrap_name) end subroutine f90wrap_species_type__get__name subroutine f90wrap_species_type__set__name(this, f90wrap_name) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -138,7 +138,7 @@ subroutine f90wrap_species_type__set__name(this, f90wrap_name) end subroutine f90wrap_species_type__set__name subroutine f90wrap_species_type__get__num(this, f90wrap_num) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -152,7 +152,7 @@ subroutine f90wrap_species_type__get__num(this, f90wrap_num) end subroutine f90wrap_species_type__get__num subroutine f90wrap_species_type__set__num(this, f90wrap_num) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type type(species_type), pointer :: p => NULL() @@ -166,7 +166,7 @@ subroutine f90wrap_species_type__set__num(this, f90wrap_num) end subroutine f90wrap_species_type__set__num subroutine f90wrap_rw_geom__species_type_initialise(this) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type @@ -179,7 +179,7 @@ subroutine f90wrap_rw_geom__species_type_initialise(this) end subroutine f90wrap_rw_geom__species_type_initialise subroutine f90wrap_rw_geom__species_type_finalise(this) - use rw_geom, only: species_type + use raffle__geom_rw, only: species_type implicit none type species_type_ptr_type @@ -193,7 +193,7 @@ end subroutine f90wrap_rw_geom__species_type_finalise subroutine f90wrap_basis_type__array_getitem__spec(f90wrap_this, f90wrap_i, specitem) - use rw_geom, only: basis_type, species_type + use raffle__geom_rw, only: basis_type, species_type implicit none type basis_type_ptr_type @@ -223,7 +223,7 @@ end subroutine f90wrap_basis_type__array_getitem__spec subroutine f90wrap_basis_type__array_setitem__spec(f90wrap_this, f90wrap_i, specitem) - use rw_geom, only: basis_type, species_type + use raffle__geom_rw, only: basis_type, species_type implicit none type basis_type_ptr_type @@ -253,7 +253,7 @@ end subroutine f90wrap_basis_type__array_setitem__spec subroutine f90wrap_basis_type__array_len__spec(f90wrap_this, f90wrap_n) - use rw_geom, only: basis_type, species_type + use raffle__geom_rw, only: basis_type, species_type implicit none type basis_type_ptr_type @@ -275,7 +275,7 @@ subroutine f90wrap_basis_type__array_len__spec(f90wrap_this, f90wrap_n) end subroutine f90wrap_basis_type__array_len__spec subroutine f90wrap_basis_type__get__nspec(this, f90wrap_nspec) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -289,7 +289,7 @@ subroutine f90wrap_basis_type__get__nspec(this, f90wrap_nspec) end subroutine f90wrap_basis_type__get__nspec subroutine f90wrap_basis_type__set__nspec(this, f90wrap_nspec) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -303,7 +303,7 @@ subroutine f90wrap_basis_type__set__nspec(this, f90wrap_nspec) end subroutine f90wrap_basis_type__set__nspec subroutine f90wrap_basis_type__get__natom(this, f90wrap_natom) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -317,7 +317,7 @@ subroutine f90wrap_basis_type__get__natom(this, f90wrap_natom) end subroutine f90wrap_basis_type__get__natom subroutine f90wrap_basis_type__set__natom(this, f90wrap_natom) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -331,7 +331,7 @@ subroutine f90wrap_basis_type__set__natom(this, f90wrap_natom) end subroutine f90wrap_basis_type__set__natom subroutine f90wrap_basis_type__get__energy(this, f90wrap_energy) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -345,7 +345,7 @@ subroutine f90wrap_basis_type__get__energy(this, f90wrap_energy) end subroutine f90wrap_basis_type__get__energy subroutine f90wrap_basis_type__set__energy(this, f90wrap_energy) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -359,7 +359,7 @@ subroutine f90wrap_basis_type__set__energy(this, f90wrap_energy) end subroutine f90wrap_basis_type__set__energy subroutine f90wrap_basis_type__array__lat(this, nd, dtype, dshape, dloc) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type use, intrinsic :: iso_c_binding, only : c_int implicit none type basis_type_ptr_type @@ -380,7 +380,7 @@ subroutine f90wrap_basis_type__array__lat(this, nd, dtype, dshape, dloc) end subroutine f90wrap_basis_type__array__lat subroutine f90wrap_basis_type__get__lcart(this, f90wrap_lcart) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -394,7 +394,7 @@ subroutine f90wrap_basis_type__get__lcart(this, f90wrap_lcart) end subroutine f90wrap_basis_type__get__lcart subroutine f90wrap_basis_type__set__lcart(this, f90wrap_lcart) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -408,7 +408,7 @@ subroutine f90wrap_basis_type__set__lcart(this, f90wrap_lcart) end subroutine f90wrap_basis_type__set__lcart subroutine f90wrap_basis_type__array__pbc(this, nd, dtype, dshape, dloc) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type use, intrinsic :: iso_c_binding, only : c_int implicit none type basis_type_ptr_type @@ -429,7 +429,7 @@ subroutine f90wrap_basis_type__array__pbc(this, nd, dtype, dshape, dloc) end subroutine f90wrap_basis_type__array__pbc subroutine f90wrap_basis_type__get__sysname(this, f90wrap_sysname) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -443,7 +443,7 @@ subroutine f90wrap_basis_type__get__sysname(this, f90wrap_sysname) end subroutine f90wrap_basis_type__get__sysname subroutine f90wrap_basis_type__set__sysname(this, f90wrap_sysname) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type type(basis_type), pointer :: p => NULL() @@ -457,7 +457,7 @@ subroutine f90wrap_basis_type__set__sysname(this, f90wrap_sysname) end subroutine f90wrap_basis_type__set__sysname subroutine f90wrap_rw_geom__basis_type_initialise(this) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type @@ -470,7 +470,7 @@ subroutine f90wrap_rw_geom__basis_type_initialise(this) end subroutine f90wrap_rw_geom__basis_type_initialise subroutine f90wrap_rw_geom__basis_type_finalise(this) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type @@ -488,7 +488,7 @@ end subroutine f90wrap_rw_geom__basis_type_finalise subroutine f90wrap_basis_type_xnum_array__array_getitem__items( & this, f90wrap_i, itemsitem) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_xnum_array @@ -517,7 +517,7 @@ subroutine f90wrap_basis_type_xnum_array__array_getitem__items( & end subroutine f90wrap_basis_type_xnum_array__array_getitem__items subroutine f90wrap_basis_type_xnum_array__array_setitem__items(this, f90wrap_i, itemsitem) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_xnum_array @@ -546,7 +546,7 @@ subroutine f90wrap_basis_type_xnum_array__array_setitem__items(this, f90wrap_i, end subroutine f90wrap_basis_type_xnum_array__array_setitem__items subroutine f90wrap_basis_type_xnum_array__array_len__items(this, f90wrap_n) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_xnum_array @@ -564,7 +564,7 @@ subroutine f90wrap_basis_type_xnum_array__array_len__items(this, f90wrap_n) end subroutine f90wrap_basis_type_xnum_array__array_len__items subroutine f90wrap_basis_type_xnum_array__array_alloc__items(this, num) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_xnum_array @@ -584,7 +584,7 @@ subroutine f90wrap_basis_type_xnum_array__array_alloc__items(this, num) end subroutine f90wrap_basis_type_xnum_array__array_alloc__items subroutine f90wrap_basis_type_xnum_array__array_dealloc__items(this) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_xnum_array @@ -603,7 +603,7 @@ subroutine f90wrap_basis_type_xnum_array__array_dealloc__items(this) end subroutine f90wrap_basis_type_xnum_array__array_dealloc__items subroutine f90wrap_rw_geom__basis_type_xnum_array_initialise(this) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_xnum_array @@ -620,7 +620,7 @@ subroutine f90wrap_rw_geom__basis_type_xnum_array_initialise(this) end subroutine f90wrap_rw_geom__basis_type_xnum_array_initialise subroutine f90wrap_rw_geom__basis_type_xnum_array_finalise(this) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_xnum_array @@ -642,7 +642,7 @@ end subroutine f90wrap_rw_geom__basis_type_xnum_array_finalise subroutine f90wrap_rw_geom__allocate_species__binding__basis_type( & this, num_species, species_symbols, species_count, atoms, n0, & n1, n2, n3) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type @@ -672,7 +672,7 @@ subroutine f90wrap_rw_geom__allocate_species__binding__basis_type( & end subroutine f90wrap_rw_geom__allocate_species__binding__basis_type subroutine f90wrap_rw_geom__convert__binding__basis_type(this) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type @@ -685,7 +685,7 @@ subroutine f90wrap_rw_geom__convert__binding__basis_type(this) end subroutine f90wrap_rw_geom__convert__binding__basis_type subroutine f90wrap_rw_geom__copy__binding__basis_type(this, basis, length) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type @@ -702,7 +702,7 @@ subroutine f90wrap_rw_geom__copy__binding__basis_type(this, basis, length) end subroutine f90wrap_rw_geom__copy__binding__basis_type subroutine f90wrap_rw_geom__get_lattice_constants__binding__basis_type(this, ret_output, radians) - use rw_geom, only: basis_type + use raffle__geom_rw, only: basis_type implicit none type basis_type_ptr_type @@ -717,7 +717,7 @@ subroutine f90wrap_rw_geom__get_lattice_constants__binding__basis_type(this, ret end subroutine f90wrap_rw_geom__get_lattice_constants__binding__basis_type subroutine f90wrap_rw_geom__geom_read(unit, basis, length, iostat) - use rw_geom, only: geom_read, basis_type + use raffle__geom_rw, only: geom_read, basis_type implicit none type basis_type_ptr_type @@ -734,7 +734,7 @@ subroutine f90wrap_rw_geom__geom_read(unit, basis, length, iostat) end subroutine f90wrap_rw_geom__geom_read subroutine f90wrap_rw_geom__geom_write(unit, basis) - use rw_geom, only: geom_write, basis_type + use raffle__geom_rw, only: geom_write, basis_type implicit none type basis_type_ptr_type @@ -748,7 +748,7 @@ subroutine f90wrap_rw_geom__geom_write(unit, basis) end subroutine f90wrap_rw_geom__geom_write subroutine f90wrap_rw_geom__get_element_properties(element, charge, mass, radius) - use rw_geom, only: get_element_properties + use raffle__geom_rw, only: get_element_properties implicit none character(3), intent(in) :: element @@ -764,36 +764,36 @@ subroutine f90wrap_rw_geom__get_element_properties(element, charge, mass, radius end subroutine f90wrap_rw_geom__get_element_properties subroutine f90wrap_rw_geom__get__igeom_input(f90wrap_igeom_input) - use rw_geom, only: rw_geom_igeom_input => igeom_input + use raffle__geom_rw, only: raffle__geom_rw_igeom_input => igeom_input implicit none integer, intent(out) :: f90wrap_igeom_input - f90wrap_igeom_input = rw_geom_igeom_input + f90wrap_igeom_input = raffle__geom_rw_igeom_input end subroutine f90wrap_rw_geom__get__igeom_input subroutine f90wrap_rw_geom__set__igeom_input(f90wrap_igeom_input) - use rw_geom, only: rw_geom_igeom_input => igeom_input + use raffle__geom_rw, only: raffle__geom_rw_igeom_input => igeom_input implicit none integer, intent(in) :: f90wrap_igeom_input - rw_geom_igeom_input = f90wrap_igeom_input + raffle__geom_rw_igeom_input = f90wrap_igeom_input end subroutine f90wrap_rw_geom__set__igeom_input subroutine f90wrap_rw_geom__get__igeom_output(f90wrap_igeom_output) - use rw_geom, only: rw_geom_igeom_output => igeom_output + use raffle__geom_rw, only: raffle__geom_rw_igeom_output => igeom_output implicit none integer, intent(out) :: f90wrap_igeom_output - f90wrap_igeom_output = rw_geom_igeom_output + f90wrap_igeom_output = raffle__geom_rw_igeom_output end subroutine f90wrap_rw_geom__get__igeom_output subroutine f90wrap_rw_geom__set__igeom_output(f90wrap_igeom_output) - use rw_geom, only: rw_geom_igeom_output => igeom_output + use raffle__geom_rw, only: raffle__geom_rw_igeom_output => igeom_output implicit none integer, intent(in) :: f90wrap_igeom_output - rw_geom_igeom_output = f90wrap_igeom_output + raffle__geom_rw_igeom_output = f90wrap_igeom_output end subroutine f90wrap_rw_geom__set__igeom_output -! End of module rw_geom defined in file ../src/lib/mod_rw_geom.f90 +! End of module raffle__geom_rw defined in file ../src/lib/mod_rw_geom.f90 diff --git a/src/wrapper/f90wrap_raffle.f90 b/src/wrapper/f90wrap_raffle.f90 index 5272bdc0..cd0be447 100644 --- a/src/wrapper/f90wrap_raffle.f90 +++ b/src/wrapper/f90wrap_raffle.f90 @@ -1,4 +1,4 @@ -! Module raffle defined in file /Users/nedtaylor/DCoding/DGit/raffle/src/raffle.f90 +! Module raffle defined in file ../raffle.f90 -! End of module raffle defined in file /Users/nedtaylor/DCoding/DGit/raffle/src/raffle.f90 +! End of module raffle defined in file ../raffle.f90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 83ad4e34..985eb7e4 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -3,12 +3,14 @@ foreach(execid misc misc_maths misc_linalg - elements - edit_geom - rw_geom - extended_geom - atom_adder - evolver + element_utils + geom_rw + geom_utils + geom_extd + dist_calcs + place_methods + viability + distribs_container evaluator_C evaluator_BTO generator diff --git a/test/test_dist_calcs.f90 b/test/test_dist_calcs.f90 new file mode 100644 index 00000000..8ddbd76d --- /dev/null +++ b/test/test_dist_calcs.f90 @@ -0,0 +1,79 @@ +program test_edit_geom + !! Test program for the module edit_geom. + use raffle__constants, only: real32 + use raffle__geom_rw, only: basis_type + use raffle__misc_linalg, only: modu + use raffle__dist_calcs, only: & + get_min_dist, & + get_min_dist_between_point_and_atom + + implicit none + + type(basis_type) :: bas + real(real32) :: rtmp1, rtmp2 + real(real32), dimension(3) :: loc + + logical :: success = .true. + + + ! Initialise silicon basis + bas%sysname = "Silicon" + bas%nspec = 1 + bas%natom = 2 + allocate(bas%spec(bas%nspec)) + bas%spec(1)%num = 2 + bas%spec(1)%name = 'Si' + allocate(bas%spec(1)%atom(bas%spec(1)%num, 3)) + bas%spec(1)%atom(1, :) = [0.0, 0.0, 0.0] + bas%spec(1)%atom(2, :) = [0.25, 0.25, 0.25] + + ! Initialise silicon lattice + bas%lat(1,:) = [0.0, 2.14, 2.14] + bas%lat(2,:) = [2.14, 0.0, 2.14] + bas%lat(3,:) = [2.14, 2.14, 0.0] + + + !----------------------------------------------------------------------------- + ! Test get_min_dist + !----------------------------------------------------------------------------- + rtmp1 = modu(get_min_dist(bas, loc=[0.9, 0.9, 0.9], lignore_close = .true.)) + + loc = [1.0, 1.0, 1.0] - [0.9, 0.9, 0.9] + loc = loc - ceiling(loc - 0.5) + loc = matmul(loc, bas%lat) + rtmp2 = modu(loc) + + if ( abs(rtmp1 - rtmp2) .gt. 1.E-6 ) then + write(0,*) 'get_min_dist failed' + success = .false. + end if + + + !----------------------------------------------------------------------------- + ! Test get_min_dist_between_point_and_atom + !----------------------------------------------------------------------------- + rtmp1 = get_min_dist_between_point_and_atom(bas, loc=[0.9, 0.9, 0.9], atom=[1, 1]) + + loc = [1.0, 1.0, 1.0] - [0.9, 0.9, 0.9] + loc = loc - ceiling(loc - 0.5) + loc = matmul(loc, bas%lat) + rtmp2 = modu(loc) + + if ( abs(rtmp1 - rtmp2) .gt. 1.E-6 ) then + write(0,*) 'get_min_dist_between_point_and_atom failed' + success = .false. + end if + + + !----------------------------------------------------------------------------- + ! check for any failed tests + !----------------------------------------------------------------------------- + write(*,*) "----------------------------------------" + if(success)then + write(*,*) 'test_dist_calcs passed all tests' + else + write(0,*) 'test_dist_calcs failed one or more tests' + stop 1 + end if + +end program test_edit_geom \ No newline at end of file diff --git a/test/test_evolver.f90 b/test/test_distribs_container.f90 similarity index 65% rename from test/test_evolver.f90 rename to test/test_distribs_container.f90 index c89e2b4f..2d51a324 100644 --- a/test/test_evolver.f90 +++ b/test/test_distribs_container.f90 @@ -1,9 +1,9 @@ -program test_evolver - use error_handling, only: test_error_handling - use evolver, only: & - gvector_container_type - use constants, only: real12, pi - use rw_geom, only: basis_type +program test_distribs_container + use raffle__io_utils, only: test_error_handling + use raffle__distribs_container, only: & + distribs_container_type + use raffle__constants, only: real32, pi + use raffle__geom_rw, only: basis_type implicit none logical :: success = .true. @@ -73,7 +73,7 @@ program test_evolver basis_mgo%lat(3,:) = [0.0, 0.0, 4.19] basis_mgo%energy = -20.0 - call test_init_gvector_container(success) + call test_init_distribs_container(success) call test_set_width(success) call test_set_sigma(success) call test_set_cutoff_min(success) @@ -99,60 +99,60 @@ program test_evolver !----------------------------------------------------------------------------- write(*,*) "----------------------------------------" if(success)then - write(*,*) 'test_evolver passed all tests' + write(*,*) 'test_distribs_container passed all tests' else - write(0,*) 'test_evolver failed one or more tests' + write(0,*) 'test_distribs_container failed one or more tests' stop 1 end if contains - subroutine test_init_gvector_container(success) + subroutine test_init_distribs_container(success) implicit none logical, intent(inout) :: success integer :: i - class(gvector_container_type), allocatable :: gvector_container + class(distribs_container_type), allocatable :: distribs_container character(len=10) :: test_name integer, dimension(3) :: nbins - real(real12), dimension(3) :: width, sigma, cutoff_min, cutoff_max + real(real32), dimension(3) :: width, sigma, cutoff_min, cutoff_max ! Test case 1: Default initialisation - gvector_container = gvector_container_type() + distribs_container = distribs_container_type() nbins = [-1, -1, -1] - width = [0.025_real12, pi/64._real12, pi/64._real12] - sigma = [0.1_real12, 0.1_real12, 0.1_real12] - cutoff_min = [0.5_real12, 0._real12, 0._real12] - cutoff_max = [6._real12, pi, pi] + width = [0.025_real32, pi/64._real32, pi/64._real32] + sigma = [0.1_real32, 0.1_real32, 0.1_real32] + cutoff_min = [0.5_real32, 0._real32, 0._real32] + cutoff_max = [6._real32, pi, pi] test_name = "Default" do i = 1, 2 call assert( & - all( gvector_container%nbins .eq. nbins ), & + all( distribs_container%nbins .eq. nbins ), & trim(test_name)//" nbins initialisation failed", & success & ) call assert( & - all( abs( gvector_container%width - width ) .lt. 1.E-6_real12 ), & + all( abs( distribs_container%width - width ) .lt. 1.E-6_real32 ), & trim(test_name)//" width initialisation failed", & success & ) call assert( & - all( abs( gvector_container%sigma - sigma ) .lt. 1.E-6_real12 ), & + all( abs( distribs_container%sigma - sigma ) .lt. 1.E-6_real32 ), & trim(test_name)//" sigma initialisation failed", & success & ) call assert( & - all( abs( gvector_container%cutoff_min - cutoff_min ) .lt. & - 1.E-6_real12 & + all( abs( distribs_container%cutoff_min - cutoff_min ) .lt. & + 1.E-6_real32 & ), & trim(test_name)//" cutoff_min initialisation failed", & success & ) call assert( & - all( abs( gvector_container%cutoff_max - cutoff_max ) .lt. & - 1.E-6_real12 & + all( abs( distribs_container%cutoff_max - cutoff_max ) .lt. & + 1.E-6_real32 & ), & trim(test_name)//" cutoff_max initialisation failed", & success & @@ -161,11 +161,11 @@ subroutine test_init_gvector_container(success) if(i.eq.2) exit ! Test case 2: Custom initialisation nbins = [10, 20, 30] - width = [0.05_real12, 0.1_real12, 0.15_real12] - sigma = [0.2_real12, 0.3_real12, 0.4_real12] - cutoff_min = [1.0_real12, 2.0_real12, 3.0_real12] - cutoff_max = [5.0_real12, 6.0_real12, 7.0_real12] - gvector_container = gvector_container_type( & + width = [0.05_real32, 0.1_real32, 0.15_real32] + sigma = [0.2_real32, 0.3_real32, 0.4_real32] + cutoff_min = [1.0_real32, 2.0_real32, 3.0_real32] + cutoff_max = [5.0_real32, 6.0_real32, 7.0_real32] + distribs_container = distribs_container_type( & nbins=nbins, & width=width, & sigma=sigma, & @@ -175,33 +175,33 @@ subroutine test_init_gvector_container(success) test_name = "Custom" end do - write(*,*) "Testing gvector_container_type initialisation error handling" - cutoff_min = [6.0_real12, 6.0_real12, 6.0_real12] - cutoff_max = [1.0_real12, 1.0_real12, 1.0_real12] - gvector_container = gvector_container_type( & + write(*,*) "Testing distribs_container_type initialisation error handling" + cutoff_min = [6.0_real32, 6.0_real32, 6.0_real32] + cutoff_max = [1.0_real32, 1.0_real32, 1.0_real32] + distribs_container = distribs_container_type( & cutoff_min=cutoff_min, & cutoff_max=cutoff_max & ) write(*,*) "Handled error: cutoff_min > cutoff_max" - end subroutine test_init_gvector_container + end subroutine test_init_distribs_container subroutine test_set_width(success) implicit none logical, intent(inout) :: success - type(gvector_container_type) :: gvector_container - real(real12), dimension(3) :: width + type(distribs_container_type) :: distribs_container + real(real32), dimension(3) :: width ! Initialise test data - width = [0.05_real12, 0.1_real12, 0.15_real12] + width = [0.05_real32, 0.1_real32, 0.15_real32] ! Call the subroutine to set the width - call gvector_container%set_width(width) + call distribs_container%set_width(width) ! Check if the width was set correctly call assert( & - all( abs( gvector_container%width - width ) .lt. 1.E-6_real12 ), & + all( abs( distribs_container%width - width ) .lt. 1.E-6_real32 ), & "Width was not set correctly", & success & ) @@ -212,18 +212,18 @@ subroutine test_set_sigma(success) implicit none logical, intent(inout) :: success - type(gvector_container_type) :: gvector_container - real(real12), dimension(3) :: sigma + type(distribs_container_type) :: distribs_container + real(real32), dimension(3) :: sigma ! Initialise test data - sigma = [0.05_real12, 0.1_real12, 0.15_real12] + sigma = [0.05_real32, 0.1_real32, 0.15_real32] ! Call the subroutine to set the width - call gvector_container%set_sigma(sigma) + call distribs_container%set_sigma(sigma) ! Check if the width was set correctly call assert( & - all( abs( gvector_container%sigma - sigma ) .lt. 1.E-6_real12 ), & + all( abs( distribs_container%sigma - sigma ) .lt. 1.E-6_real32 ), & "Sigma was not set correctly", & success & ) @@ -234,19 +234,19 @@ subroutine test_set_cutoff_min(success) implicit none logical, intent(inout) :: success - type(gvector_container_type) :: gvector_container - real(real12), dimension(3) :: cutoff_min + type(distribs_container_type) :: distribs_container + real(real32), dimension(3) :: cutoff_min ! Initialise test data - cutoff_min = [0.5_real12, 0.5_real12, 0.5_real12] + cutoff_min = [0.5_real32, 0.5_real32, 0.5_real32] ! Call the subroutine to set the cutoff_min - call gvector_container%set_cutoff_min(cutoff_min) + call distribs_container%set_cutoff_min(cutoff_min) ! Check if the cutoff_min was set correctly call assert( & - all( abs( gvector_container%cutoff_min - cutoff_min ) .lt. & - 1.E-6_real12 & + all( abs( distribs_container%cutoff_min - cutoff_min ) .lt. & + 1.E-6_real32 & ), & "Cutoff_min was not set correctly", & success & @@ -258,19 +258,19 @@ subroutine test_set_cutoff_max(success) implicit none logical, intent(inout) :: success - type(gvector_container_type) :: gvector_container - real(real12), dimension(3) :: cutoff_max + type(distribs_container_type) :: distribs_container + real(real32), dimension(3) :: cutoff_max ! Initialise test data - cutoff_max = [6.0_real12, 6.0_real12, 6.0_real12] + cutoff_max = [6.0_real32, 6.0_real32, 6.0_real32] ! Call the subroutine to set the cutoff_max - call gvector_container%set_cutoff_max(cutoff_max) + call distribs_container%set_cutoff_max(cutoff_max) ! Check if the cutoff_max was set correctly call assert( & - all( abs( gvector_container%cutoff_max - cutoff_max ) .lt. & - 1.E-6_real12 & + all( abs( distribs_container%cutoff_max - cutoff_max ) .lt. & + 1.E-6_real32 & ), & "Cutoff_max was not set correctly", & success & @@ -282,21 +282,21 @@ subroutine test_set_radius_distance_tol(success) implicit none logical, intent(inout) :: success - type(gvector_container_type) :: gvector_container - real(real12), dimension(4) :: radius_distance_tol + type(distribs_container_type) :: distribs_container + real(real32), dimension(4) :: radius_distance_tol ! Initialise test data - radius_distance_tol = [1.5_real12, 2.5_real12, 3.0_real12, 6.0_real12] + radius_distance_tol = [1.5_real32, 2.5_real32, 3.0_real32, 6.0_real32] ! Call the subroutine to set the radius_distance_tol - call gvector_container%set_radius_distance_tol(radius_distance_tol) + call distribs_container%set_radius_distance_tol(radius_distance_tol) ! Check if the radius_distance_tol was set correctly call assert( & all( & abs( & - gvector_container%radius_distance_tol - radius_distance_tol & - ) .lt. 1.E-6_real12 & + distribs_container%radius_distance_tol - radius_distance_tol & + ) .lt. 1.E-6_real32 & ), & "Radius_distance_tol was not set correctly", & success & @@ -307,7 +307,7 @@ end subroutine test_set_radius_distance_tol subroutine test_create(basis, success) - !! Test the create subroutine of gvector_container_type + !! Test the create subroutine of distribs_container_type implicit none logical, intent(inout) :: success type(basis_type), dimension(:), intent(in) :: basis @@ -315,7 +315,7 @@ subroutine test_create(basis, success) integer :: i, j, k integer :: num_pairs character(len=3) :: species_tmp - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container type(basis_type), dimension(size(basis,1)) :: basis_list character(len=3), dimension(:), allocatable :: elements @@ -325,16 +325,16 @@ subroutine test_create(basis, success) end do ! Test element_database uninitiaised error handling - write(*,*) "Testing gvector_container_type create error handling" - call gvector_container%create(basis_list, deallocate_systems=.false.) + write(*,*) "Testing distribs_container_type create error handling" + call distribs_container%create(basis_list, deallocate_systems=.false.) write(*,*) "Handled error: element_database not initialised" ! Set element energies allocate(elements(0)) do i = 1, size(basis_list) species_loop: do j = 1, basis_list(i)%nspec - call gvector_container%set_element_energies( & - [ basis_list(i)%spec(1)%name ], [ -9.027_real12 ] & + call distribs_container%set_element_energies( & + [ basis_list(i)%spec(1)%name ], [ -9.027_real32 ] & ) species_tmp = basis_list(i)%spec(j)%name(1:3) if(.not.allocated(elements)) then @@ -348,37 +348,37 @@ subroutine test_create(basis, success) elements = [ elements, species_tmp ] end do species_loop end do - num_pairs = nint(gamma(real(size(elements) + 2, real12)) / & - ( gamma(real(size(elements), real12)) * gamma( 3._real12 ) ) ) + num_pairs = nint(gamma(real(size(elements) + 2, real32)) / & + ( gamma(real(size(elements), real32)) * gamma( 3._real32 ) ) ) ! Call the create subroutine - call gvector_container%create(basis_list, deallocate_systems=.false.) + call distribs_container%create(basis_list, deallocate_systems=.false.) ! Check if the system is allocated call assert( & - allocated(gvector_container%system), & + allocated(distribs_container%system), & "system not allocated", & success & ) ! Check number of elements in element_info is correct call assert( & - size(gvector_container%element_info, dim=1) .eq. size(elements), & + size(distribs_container%element_info, dim=1) .eq. size(elements), & "Number of elements in element_info is incorrect", & success & ) ! Check symbol of the element is correct call assert( & - any( elements .eq. gvector_container%element_info(1)%name ), & + any( elements .eq. distribs_container%element_info(1)%name ), & "Symbol of the element is incorrect", & success & ) ! Check element energies are set correctly call assert( & - abs( gvector_container%element_info(1)%energy + 9.027_real12 ) .lt. & - 1.E-6_real12 , & + abs( distribs_container%element_info(1)%energy + 9.027_real32 ) .lt. & + 1.E-6_real32 , & "element energies not set correctly", & success & ) @@ -386,9 +386,9 @@ subroutine test_create(basis, success) ! Check if the 2-/3-/4-body distribution functions are not allocated call assert( & ( & - allocated(gvector_container%total%df_2body) .or. & - allocated(gvector_container%total%df_3body) .or. & - allocated(gvector_container%total%df_4body) & + allocated(distribs_container%gdf%df_2body) .or. & + allocated(distribs_container%gdf%df_3body) .or. & + allocated(distribs_container%gdf%df_4body) & ), & "2-/3-/4-body distribution functions are allocated", & success & @@ -396,19 +396,19 @@ subroutine test_create(basis, success) ! Check number of species and species pairs are correct call assert( & - size(gvector_container%total%df_2body, dim=2) .eq. num_pairs, & + size(distribs_container%gdf%df_2body, dim=2) .eq. num_pairs, & "Number of species pairs in 2-body distribution function & &is incorrect", & success & ) call assert( & - size(gvector_container%total%df_3body, dim=2) .eq. size(elements), & + size(distribs_container%gdf%df_3body, dim=2) .eq. size(elements), & "Number of species in 3-body distribution function & &is incorrect", & success & ) call assert( & - size(gvector_container%total%df_4body, dim=2) .eq. size(elements), & + size(distribs_container%gdf%df_4body, dim=2) .eq. size(elements), & "Number of species in 4-body distribution function & &is incorrect", & success & @@ -416,63 +416,63 @@ subroutine test_create(basis, success) ! Check if the 2-/3-/4-body distribution functions are not zero call assert( & - any( abs( gvector_container%total%df_2body ) .gt. 1.E-6_real12 ), & + any( abs( distribs_container%gdf%df_2body ) .gt. 1.E-6_real32 ), & "2-body distribution functions are zero", & success & ) call assert( & - any( abs( gvector_container%total%df_3body ) .gt. 1.E-6_real12 ), & + any( abs( distribs_container%gdf%df_3body ) .gt. 1.E-6_real32 ), & "3-body distribution functions are zero", & success & ) call assert( & - any( abs( gvector_container%total%df_4body ) .gt. 1.E-6_real12 ), & + any( abs( distribs_container%gdf%df_4body ) .gt. 1.E-6_real32 ), & "4-body distribution functions are zero", & success & ) ! Check if the 2-/3-/4-body distribution functions are not NaN call assert( & - all( .not. isnan( gvector_container%total%df_2body ) ), & + all( .not. isnan( distribs_container%gdf%df_2body ) ), & "2-body distribution functions are NaN", & success & ) call assert( & - all( .not. isnan( gvector_container%total%df_3body ) ), & + all( .not. isnan( distribs_container%gdf%df_3body ) ), & "3-body distribution functions are NaN", & success & ) call assert( & - all( .not. isnan( gvector_container%total%df_4body ) ), & + all( .not. isnan( distribs_container%gdf%df_4body ) ), & "4-body distribution functions are NaN", & success & ) ! Check that the maximum value of 2-/3-/4-body distribution functions is 1 - do i = 1, size(gvector_container%total%df_2body, dim=2) + do i = 1, size(distribs_container%gdf%df_2body, dim=2) call assert( & abs( & - maxval(gvector_container%total%df_2body(:,i)) - & - 1._real12 & - ) .lt. 1.E-6_real12, & + maxval(distribs_container%gdf%df_2body(:,i)) - & + 1._real32 & + ) .lt. 1.E-6_real32, & "Maximum value of 2-body distribution functions is not 1", & success & ) end do - do i = 1, size(gvector_container%total%df_3body, dim=2) + do i = 1, size(distribs_container%gdf%df_3body, dim=2) call assert( & abs( & - maxval(gvector_container%total%df_3body(:,i)) - & - 1._real12 & - ) .lt. 1.E-6_real12, & + maxval(distribs_container%gdf%df_3body(:,i)) - & + 1._real32 & + ) .lt. 1.E-6_real32, & "Maximum value of 3-body distribution functions is not 1", & success & ) call assert( & abs( & - maxval(gvector_container%total%df_4body(:,i)) - & - 1._real12 & - ) .lt. 1.E-6_real12, & + maxval(distribs_container%gdf%df_4body(:,i)) - & + 1._real32 & + ) .lt. 1.E-6_real32, & "Maximum value of 4-body distribution functions is not 1", & success & ) @@ -480,30 +480,30 @@ subroutine test_create(basis, success) ! Check if norm is allocated and not zero call assert( & - allocated(gvector_container%norm_2body) .and. & - all( abs( gvector_container%norm_2body ) .gt. 1.E-6_real12 ), & + allocated(distribs_container%norm_2body) .and. & + all( abs( distribs_container%norm_2body ) .gt. 1.E-6_real32 ), & "2-body norm is not allocated or zero", & success & ) call assert( & - allocated(gvector_container%norm_3body) .and. & - all( abs( gvector_container%norm_3body ) .gt. 1.E-6_real12 ), & + allocated(distribs_container%norm_3body) .and. & + all( abs( distribs_container%norm_3body ) .gt. 1.E-6_real32 ), & "3-body norm is not allocated or zero", & success & ) call assert( & - allocated(gvector_container%norm_4body) .and. & - all( abs( gvector_container%norm_4body ) .gt. 1.E-6_real12 ), & + allocated(distribs_container%norm_4body) .and. & + all( abs( distribs_container%norm_4body ) .gt. 1.E-6_real32 ), & "4-body norm is not allocated or zero", & success & ) ! Call the create subroutine again - call gvector_container%create(basis_list, deallocate_systems=.true.) + call distribs_container%create(basis_list, deallocate_systems=.true.) ! Check if the system is deallocated call assert( & - .not.allocated(gvector_container%system), & + .not.allocated(distribs_container%system), & "system not correctly deallocated", & success & ) @@ -518,7 +518,7 @@ subroutine test_update(basis, success) integer :: i, j, k integer :: num_pairs character(len=3) :: species_tmp - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container type(basis_type), dimension(size(basis,1)) :: basis_list character(len=3), dimension(:), allocatable :: elements @@ -528,13 +528,13 @@ subroutine test_update(basis, success) end do ! Set host system - call gvector_container%host_system%set(basis(1)) + call distribs_container%host_system%set(basis(1)) ! Set element energies do i = 1, size(basis_list) species_loop: do j = 1, basis_list(i)%nspec - call gvector_container%set_element_energies( & - [ basis_list(i)%spec(1)%name ], [ -9.027_real12 ] & + call distribs_container%set_element_energies( & + [ basis_list(i)%spec(1)%name ], [ -9.027_real32 ] & ) species_tmp = basis_list(i)%spec(j)%name(1:3) if(.not.allocated(elements)) then @@ -548,28 +548,28 @@ subroutine test_update(basis, success) elements = [ elements, species_tmp ] end do species_loop end do - num_pairs = nint( gamma(real(size(elements) + 2, real12)) / & - ( gamma(real(size(elements), real12)) * gamma( 3._real12 ) ) ) + num_pairs = nint( gamma(real(size(elements) + 2, real32)) / & + ( gamma(real(size(elements), real32)) * gamma( 3._real32 ) ) ) ! Call the create subroutine - call gvector_container%create([basis_list(1)], deallocate_systems=.false.) + call distribs_container%create([basis_list(1)], deallocate_systems=.false.) ! Call the update subroutine - call gvector_container%update([basis_list(2)], deallocate_systems=.false.) + call distribs_container%update([basis_list(2)], deallocate_systems=.false.) ! Check if the system is allocated call assert( & - allocated(gvector_container%system), & + allocated(distribs_container%system), & "system not allocated", & success & ) ! Call the create subroutine again - call gvector_container%update([basis_list(2)], deallocate_systems=.true.) + call distribs_container%update([basis_list(2)], deallocate_systems=.true.) ! Check if the system is deallocated call assert( & - .not.allocated(gvector_container%system), & + .not.allocated(distribs_container%system), & "system not correctly deallocated", & success & ) @@ -581,67 +581,69 @@ subroutine test_add(basis, success) logical, intent(inout) :: success type(basis_type), intent(in) :: basis - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container integer, dimension(1,1,1,1) :: test_array = 1 ! Call the add subroutine - call gvector_container%add(basis) + call distribs_container%add(basis) ! Check number of systems is correct call assert( & - size(gvector_container%system, dim=1) .eq. 1, & + size(distribs_container%system, dim=1) .eq. 1, & "Number of systems is incorrect", & success & ) ! Check if the system information is correct call assert( & - abs( gvector_container%system(1)%energy - basis%energy ) .lt. 1.E-6, & + abs( & + distribs_container%system(1)%energy - basis%energy & + ) .lt. 1.E-6, & "System energy is incorrect", & success & ) call assert( & - gvector_container%system(1)%num_atoms .eq. basis%natom, & + distribs_container%system(1)%num_atoms .eq. basis%natom, & "Number of atoms is incorrect", & success & ) ! Call the add subroutine - call gvector_container%add([basis]) + call distribs_container%add([basis]) ! Check number of systems is correct call assert( & - size(gvector_container%system, dim=1) .eq. 2, & + size(distribs_container%system, dim=1) .eq. 2, & "Number of systems is incorrect", & success & ) ! Check the add subroutine - call gvector_container%add(gvector_container%system(1)) + call distribs_container%add(distribs_container%system(1)) ! Check number of systems is correct call assert( & - size(gvector_container%system, dim=1) .eq. 3, & + size(distribs_container%system, dim=1) .eq. 3, & "Number of systems is incorrect", & success & ) ! Check the add subroutine - call gvector_container%add(gvector_container%system) + call distribs_container%add(distribs_container%system) ! Check number of systems is correct call assert( & - size(gvector_container%system, dim=1) .eq. 6, & + size(distribs_container%system, dim=1) .eq. 6, & "Number of systems is incorrect", & success & ) ! Test unknown type and rank error handling - write(*,*) "Testing gvector_container_type add error handling" - call gvector_container%add(1) - call gvector_container%add([1]) + write(*,*) "Testing distribs_container_type add error handling" + call distribs_container%add(1) + call distribs_container%add([1]) write(*,*) "Handled error: system default type" - call gvector_container%add(test_array) + call distribs_container%add(test_array) write(*,*) "Handled error: system default rank" @@ -653,15 +655,15 @@ subroutine test_get_element_energies(basis, success) logical, intent(inout) :: success type(basis_type), intent(in) :: basis - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container character(len=3), dimension(:), allocatable :: elements - real(real12), dimension(:), allocatable :: energies + real(real32), dimension(:), allocatable :: energies - call gvector_container%set_element_energies(['C '], [-9.027_real12]) - call gvector_container%add(basis) + call distribs_container%set_element_energies(['C '], [-9.027_real32]) + call distribs_container%add(basis) ! Call the get_element_energies subroutine - call gvector_container%get_element_energies(elements, energies) + call distribs_container%get_element_energies(elements, energies) ! Check if the element energies are retrieved correctly call assert( & @@ -680,7 +682,7 @@ subroutine test_get_element_energies(basis, success) success & ) call assert( & - abs(energies(1) + 9.027_real12) .lt. 1.E-6_real12, & + abs(energies(1) + 9.027_real32) .lt. 1.E-6_real32, & "Element energy is incorrect", & success & ) @@ -692,15 +694,15 @@ subroutine test_get_element_energies_staticmem(basis, success) logical, intent(inout) :: success type(basis_type), intent(in) :: basis - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container character(len=3), dimension(1) :: elements - real(real12), dimension(1) :: energies + real(real32), dimension(1) :: energies - call gvector_container%set_element_energies(['C '], [-9.027_real12]) - call gvector_container%add(basis) + call distribs_container%set_element_energies(['C '], [-9.027_real32]) + call distribs_container%add(basis) ! Call the get_element_energies_staticmem subroutine - call gvector_container%get_element_energies_staticmem(elements, energies) + call distribs_container%get_element_energies_staticmem(elements, energies) ! Check if the element energies are retrieved correctly call assert( & @@ -719,7 +721,7 @@ subroutine test_get_element_energies_staticmem(basis, success) success & ) call assert( & - abs(energies(1) + 9.027_real12) .lt. 1.E-6_real12, & + abs(energies(1) + 9.027_real32) .lt. 1.E-6_real32, & "Element energy is incorrect", & success & ) @@ -732,22 +734,22 @@ subroutine test_set_bond_radii(basis, success) type(basis_type), intent(in) :: basis integer :: i - type(gvector_container_type) :: gvector_container - real(real12), dimension(1) :: radii + type(distribs_container_type) :: distribs_container + real(real32), dimension(1) :: radii character(len=3), dimension(1,2) :: elements - real(real12), dimension(:), allocatable :: radii_get + real(real32), dimension(:), allocatable :: radii_get character(len=3), dimension(:,:), allocatable :: elements_get ! Initialise test data - radii(1) = 12.5_real12 + radii(1) = 12.5_real32 elements(1,:) = ['C ', 'C '] ! Call the subroutine to set the bond radii - call gvector_container%set_bond_radii(elements, radii) - call gvector_container%add(basis) + call distribs_container%set_bond_radii(elements, radii) + call distribs_container%add(basis) ! Get the bond radii - call gvector_container%get_bond_radii(elements_get, radii_get) + call distribs_container%get_bond_radii(elements_get, radii_get) ! Check if the number of bond elements is correct call assert( & @@ -771,14 +773,14 @@ subroutine test_set_bond_radii(basis, success) ) elements_get = ' ' - radii_get = 0.0_real12 + radii_get = 0.0_real32 ! Get the bond radii from staticmem - call gvector_container%get_bond_radii_staticmem(elements_get, radii_get) + call distribs_container%get_bond_radii_staticmem(elements_get, radii_get) end do - radii(1) = 14.2_real12 - call gvector_container%set_bond_radii(elements, radii) - call gvector_container%get_bond_radii(elements_get, radii_get) + radii(1) = 14.2_real32 + call distribs_container%set_bond_radii(elements, radii) + call distribs_container%get_bond_radii(elements_get, radii_get) ! Check if the bond radius was set correctly call assert( & @@ -797,12 +799,12 @@ subroutine test_get_bin(success) logical, intent(inout) :: success integer :: bin - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container - gvector_container%nbins(1) = 10 + distribs_container%nbins(1) = 10 ! Check lower bound correct handling - bin = gvector_container%get_bin(0._real12, 1) + bin = distribs_container%get_bin(0._real32, 1) call assert( & bin .eq. 0, & "Bin is incorrect", & @@ -810,7 +812,7 @@ subroutine test_get_bin(success) ) ! Check upper bound correct handling - bin = gvector_container%get_bin(100._real12, 1) + bin = distribs_container%get_bin(100._real32, 1) call assert( & bin .eq. 0, & "Bin is incorrect", & @@ -818,9 +820,9 @@ subroutine test_get_bin(success) ) ! Check middle value correct handling - bin = gvector_container%get_bin(3._real12, 1) + bin = distribs_container%get_bin(3._real32, 1) call assert( & - bin .eq. 1 + nint( (gvector_container%nbins(1) - 1) * 2.5 / 5.5 ), & + bin .eq. 1 + nint( (distribs_container%nbins(1) - 1) * 2.5 / 5.5 ), & "Bin is incorrect", & success & ) @@ -841,4 +843,4 @@ subroutine assert(condition, message, success) end if end subroutine assert -end program test_evolver \ No newline at end of file +end program test_distribs_container \ No newline at end of file diff --git a/test/test_elements.f90 b/test/test_element_utils.f90 similarity index 87% rename from test/test_elements.f90 rename to test/test_element_utils.f90 index e326830b..48175cd6 100644 --- a/test/test_elements.f90 +++ b/test/test_element_utils.f90 @@ -1,7 +1,7 @@ -program test_mod_elements - use elements - use rw_geom, only: get_element_properties - use constants, only: real12 +program test_mod_element_utils + use raffle__element_utils + use raffle__geom_rw, only: get_element_properties + use raffle__constants, only: real32 implicit none ! Local variables @@ -46,9 +46,9 @@ program test_mod_elements ! Test element initialization element = element_type( & name='H ', & - mass=1.008_real12, & - charge=0.0_real12, & - energy=13.6_real12 & + mass=1.008_real32, & + charge=0.0_real32, & + energy=13.6_real32 & ) call assert( & trim(element%name) .eq. "H", & @@ -56,7 +56,7 @@ program test_mod_elements success & ) call assert( & - abs(element%mass - 1.008_real12) .lt. 1.E-6, & + abs(element%mass - 1.008_real32) .lt. 1.E-6, & "Element mass initialisation failed", & success & ) @@ -66,7 +66,7 @@ program test_mod_elements success & ) call assert( & - abs(element%energy - 13.6_real12) .lt. 1.E-6, & + abs(element%energy - 13.6_real32) .lt. 1.E-6, & "Element energy initialisation failed", & success & ) @@ -79,17 +79,17 @@ program test_mod_elements success & ) call assert( & - abs(element%mass - 12.011_real12) .lt. 1.E-6, & + abs(element%mass - 12.011_real32) .lt. 1.E-6, & "Element mass setting failed", & success & ) call assert( & - abs(element%charge - 6._real12) .lt. 1.E-6, & + abs(element%charge - 6._real32) .lt. 1.E-6, & "Element charge setting failed", & success & ) call assert( & - abs(element%radius - 0.76_real12) .lt. 1.E-6, & + abs(element%radius - 0.76_real32) .lt. 1.E-6, & "Element radius setting failed", & success & ) @@ -100,7 +100,7 @@ program test_mod_elements ) ! Test bond initialisation - bond = element_bond_type(elements=['H ', 'O '], radius=0.96_real12) + bond = element_bond_type(elements=['H ', 'O '], radius=0.96_real32) ! Test setting bond properties call bond%set('C ', 'O ', in_database) @@ -132,4 +132,4 @@ subroutine assert(condition, message, success) end if end subroutine assert -end program test_mod_elements \ No newline at end of file +end program test_mod_element_utils \ No newline at end of file diff --git a/test/test_evaluator_BTO.f90 b/test/test_evaluator_BTO.f90 index 568b9826..c9731e0a 100644 --- a/test/test_evaluator_BTO.f90 +++ b/test/test_evaluator_BTO.f90 @@ -1,32 +1,32 @@ program test_evaluator_BTO - use error_handling - use constants, only: real12, pi - use misc_linalg, only: modu - use rw_geom, only: basis_type, geom_write - use extended_geom, only: extended_basis_type - use evaluator, only: evaluate_point - use generator, only: raffle_generator_type - use add_atom, only: get_gridpoints_and_viability + use raffle__io_utils + use raffle__constants, only: real32, pi + use raffle__misc_linalg, only: modu + use raffle__geom_rw, only: basis_type, geom_write + use raffle__geom_extd, only: extended_basis_type + use raffle__evaluator, only: evaluate_point + use raffle__generator, only: raffle_generator_type + use raffle__viability, only: get_gridpoints_and_viability implicit none integer :: unit integer :: i, is, ia, ja, num_points integer :: best_loc - real(real12) :: max_bondlength + real(real32) :: max_bondlength type(extended_basis_type) :: basis_host logical :: ltmp1 type(basis_type), dimension(1) :: database character(3), dimension(3) :: element_symbols - real(real12), dimension(3) :: element_energies - real(real12), dimension(3) :: tolerance + real(real32), dimension(3) :: element_energies + real(real32), dimension(3) :: tolerance integer, dimension(:,:), allocatable :: atom_ignore_list integer :: iostat logical :: viability_printing character(len=256) :: arg, arg_prev, viability_printing_file, fmt - real(real12), dimension(:,:), allocatable :: gridpoints, viability_grid + real(real32), dimension(:,:), allocatable :: gridpoints, viability_grid type(raffle_generator_type) :: generator @@ -82,7 +82,7 @@ program test_evaluator_BTO end if - max_bondlength = 6._real12 + max_bondlength = 6._real32 !----------------------------------------------------------------------------- ! set up database !----------------------------------------------------------------------------- @@ -208,7 +208,7 @@ program test_evaluator_BTO grid_offset = generator%grid_offset & ) do i = 1, 3 - tolerance(i) = 1._real12 / real(generator%grid(i),real12) / 2._real12 + tolerance(i) = 1._real32 / real(generator%grid(i),real32) / 2._real32 end do @@ -251,7 +251,7 @@ program test_evaluator_BTO !----------------------------------------------------------------------------- allocate(viability_grid(basis_host%nspec,size(gridpoints,2))) do ia = 1, size(atom_ignore_list,1) - viability_grid(:,:) = 0._real12 + viability_grid(:,:) = 0._real32 do is = 1, basis_host%nspec do i = 1, size(gridpoints,dim=2) viability_grid(is,i) = evaluate_point( generator%distributions, & @@ -264,7 +264,7 @@ program test_evaluator_BTO end do best_loc = maxloc(viability_grid(atom_ignore_list(ia,1),:),dim=1) ltmp1 = .false. - if(any(viability_grid(atom_ignore_list(ia,1),:) .gt. 0._real12) )then + if(any(viability_grid(atom_ignore_list(ia,1),:) .gt. 0._real32) )then do ja = ia, size(atom_ignore_list,1), 1 if( atom_ignore_list(ja,1) .ne. atom_ignore_list(ia,1) ) cycle if( & @@ -274,7 +274,7 @@ program test_evaluator_BTO basis_host%spec(atom_ignore_list(ja,1))%atom( & atom_ignore_list(ja,2),:3 & ) & - ) .lt. tolerance + 1.E-6_real12 & + ) .lt. tolerance + 1.E-6_real32 & ) & ) ltmp1 = .true. end do diff --git a/test/test_evaluator_C.f90 b/test/test_evaluator_C.f90 index b035c72e..b5def734 100644 --- a/test/test_evaluator_C.f90 +++ b/test/test_evaluator_C.f90 @@ -1,32 +1,32 @@ program test_evaluator - use error_handling - use constants, only: real12, pi - use misc_linalg, only: modu - use rw_geom, only: basis_type, geom_write - use extended_geom, only: extended_basis_type - use evaluator, only: evaluate_point - use generator, only: raffle_generator_type - use add_atom, only: get_gridpoints_and_viability + use raffle__io_utils + use raffle__constants, only: real32, pi + use raffle__misc_linalg, only: modu + use raffle__geom_rw, only: basis_type, geom_write + use raffle__geom_extd, only: extended_basis_type + use raffle__evaluator, only: evaluate_point + use raffle__generator, only: raffle_generator_type + use raffle__viability, only: get_gridpoints_and_viability implicit none integer :: unit - integer :: i, is, ia, num_points + integer :: i, is, ia, ja, num_points integer :: best_loc - real(real12) :: max_bondlength + real(real32) :: max_bondlength type(extended_basis_type) :: basis_host logical :: ltmp1 type(basis_type), dimension(1) :: database character(3), dimension(1) :: element_symbols - real(real12), dimension(1) :: element_energies - real(real12), dimension(3) :: tolerance + real(real32), dimension(1) :: element_energies + real(real32), dimension(3) :: tolerance integer, dimension(:,:), allocatable :: atom_ignore_list integer :: iostat logical :: viability_printing character(len=256) :: arg, arg_prev, viability_printing_file, fmt - real(real12), dimension(:,:), allocatable :: gridpoints, viability_grid + real(real32), dimension(:,:), allocatable :: gridpoints, viability_grid type(raffle_generator_type) :: generator @@ -82,7 +82,7 @@ program test_evaluator end if - max_bondlength = 6._real12 + max_bondlength = 6._real32 !----------------------------------------------------------------------------- ! set up database !----------------------------------------------------------------------------- @@ -163,7 +163,7 @@ program test_evaluator generator%distributions%kBT = 0.2 - call generator%host%copy(basis_host) + call generator%set_host(basis_host) call generator%set_grid( grid_spacing = 0.2, grid_offset = [0.0, 0.0, 0.0] ) generator%distributions%radius_distance_tol = [1.5, 2.5, 3.0, 6.0] call generator%distributions%set_width([0.025, pi/200.0, pi/200.0]) @@ -192,7 +192,7 @@ program test_evaluator grid_offset = generator%grid_offset & ) do i = 1, 3 - tolerance(i) = 1._real12 / real(generator%grid(i),real12) / 2._real12 + tolerance(i) = 1._real32 / real(generator%grid(i),real32) / 2._real32 end do @@ -235,7 +235,7 @@ program test_evaluator !----------------------------------------------------------------------------- allocate(viability_grid(basis_host%nspec,size(gridpoints,2))) do ia = 1, size(atom_ignore_list,1) - viability_grid(:,:) = 0._real12 + viability_grid(:,:) = 0._real32 do i = 1, size(gridpoints,dim=2) viability_grid(1,i) = evaluate_point( generator%distributions, & gridpoints(1:3,i), atom_ignore_list(ia,1), basis_host, & @@ -252,7 +252,7 @@ program test_evaluator abs( & gridpoints(1:3,best_loc) - & basis_host%spec(1)%atom(atom_ignore_list(ja,2),:3) & - ) .lt. tolerance + 1.E-6_real12 & + ) .lt. tolerance + 1.E-6_real32 & ) & ) ltmp1 = .true. end do diff --git a/test/test_generator.f90 b/test/test_generator.f90 index 99348696..515cc1af 100644 --- a/test/test_generator.f90 +++ b/test/test_generator.f90 @@ -1,8 +1,8 @@ program test_generator - use error_handling - use constants, only: real12 - use rw_geom, only: basis_type - use generator, only: raffle_generator_type, stoichiometry_type + use raffle__io_utils + use raffle__constants, only: real32 + use raffle__geom_rw, only: basis_type + use raffle__generator, only: raffle_generator_type, stoichiometry_type implicit none integer :: i @@ -11,8 +11,8 @@ program test_generator type(basis_type) :: basis_host, basis_host_expected type(basis_type), dimension(1) :: database character(3), dimension(1) :: element_symbols - real(real12), dimension(1) :: element_energies - real(real12), dimension(3) :: tolerance + real(real32), dimension(1) :: element_energies + real(real32), dimension(3) :: tolerance logical :: success = .true. @@ -214,7 +214,7 @@ program test_generator abs( & generator%grid_offset - & [0.1, 0.2, 0.3] & - ) .lt. 1.E-6_real12 & + ) .lt. 1.E-6_real32 & ), & 'Generator failed to handle grid_offset', & success & @@ -230,7 +230,7 @@ program test_generator call generator%set_grid( grid_spacing = 0.2, grid_offset = [0.0, 0.0, 0.0] ) generator%distributions%radius_distance_tol = [1.5, 2.5, 3.0, 6.0] do i = 1, 3 - tolerance(i) = 1._real12 / real(generator%grid(i),real12) / 2._real12 + tolerance(i) = 1._real32 / real(generator%grid(i),real32) / 2._real32 end do @@ -329,7 +329,7 @@ function compare_bas(bas1, bas2) result(output) abs( & bas1%spec(is)%atom(ia,:3) - & bas2%spec(is)%atom(ia,:3) & - ) .ge. 2._real12 * tolerance + 1.E-6_real12 & + ) .ge. 2._real32 * tolerance + 1.E-6_real32 & ) & ) then write(0,*) 'Generator failed to produce expected atom: ', is, ia diff --git a/test/test_extended_geom.f90 b/test/test_geom_extd.f90 similarity index 90% rename from test/test_extended_geom.f90 rename to test/test_geom_extd.f90 index df675e27..b9b632ef 100644 --- a/test/test_extended_geom.f90 +++ b/test/test_geom_extd.f90 @@ -1,8 +1,8 @@ -program test_extended_geom - !! Test program for the module extended_geom. - use error_handling - use constants, only: real12 - use extended_geom +program test_geom_extd + !! Test program for the module geom_extd. + use raffle__io_utils + use raffle__constants, only: real32 + use raffle__geom_extd implicit none type(extended_basis_type) :: basis_diamond @@ -40,9 +40,9 @@ program test_extended_geom !----------------------------------------------------------------------------- write(*,*) "----------------------------------------" if(success)then - write(*,*) 'test_extended_geom passed all tests' + write(*,*) 'test_geom_extd passed all tests' else - write(0,*) 'test_extended_geom failed one or more tests' + write(0,*) 'test_geom_extd failed one or more tests' stop 1 end if @@ -58,7 +58,7 @@ subroutine test_create_images(basis, success) call basis_copy%copy(basis) ! Create images - call basis_copy%create_images( max_bondlength = 0._real12 ) + call basis_copy%create_images( max_bondlength = 0._real32 ) ! Check if the number of images is correct call assert( & @@ -74,7 +74,7 @@ subroutine test_create_images(basis, success) call assert( & all( & basis_copy%image_spec(1)%atom(:, :) - & - 1._real12 .lt. 1.E-6_real12 & + 1._real32 .lt. 1.E-6_real32 & ), & 'Atoms outside of max bondlength', & success & @@ -95,7 +95,7 @@ subroutine test_update_iamges(basis, success) ! Create images call basis_copy%create_images( & - max_bondlength = 0._real12, & + max_bondlength = 0._real32, & atom_ignore_list = atom_ignore_list & ) @@ -112,7 +112,7 @@ subroutine test_update_iamges(basis, success) ) ! Update images - call basis_copy%update_images( max_bondlength = 0._real12, is = 1, ia = 1 ) + call basis_copy%update_images( max_bondlength = 0._real32, is = 1, ia = 1 ) ! Check if the number of images is correct call assert( & @@ -128,7 +128,7 @@ subroutine test_update_iamges(basis, success) call assert( & all( & basis_copy%image_spec(1)%atom(:, :) - & - 1._real12 .lt. 1.E-6_real12 & + 1._real32 .lt. 1.E-6_real32 & ), & 'Atoms outside of max bondlength', & success & @@ -192,4 +192,4 @@ subroutine assert(condition, message, success) end if end subroutine assert -end program test_extended_geom \ No newline at end of file +end program test_geom_extd \ No newline at end of file diff --git a/test/test_rw_geom.f90 b/test/test_geom_rw.f90 similarity index 96% rename from test/test_rw_geom.f90 rename to test/test_geom_rw.f90 index 6a566093..a2c1ef00 100644 --- a/test/test_rw_geom.f90 +++ b/test/test_geom_rw.f90 @@ -1,7 +1,7 @@ -program test_rw_geom +program test_geom_rw !! Test program for the module rw_geom. - use constants, only: pi,real12 - use rw_geom, only: & + use raffle__constants, only: pi,real32 + use raffle__geom_rw, only: & basis_type, & geom_read, geom_write, & igeom_input, igeom_output, & @@ -9,16 +9,16 @@ program test_rw_geom implicit none integer :: unit, iostat, i - real(real12) :: mass, charge, radius + real(real32) :: mass, charge, radius type(basis_type) :: bas1, bas2 class(basis_type), allocatable :: bas - real(real12), dimension(3,3) :: atoms + real(real32), dimension(3,3) :: atoms character(len=256) :: cwd, filename = 'test/data/POSCAR_Si' logical :: exist, check logical :: success = .true. character(len=3), dimension(118) :: element_list - real(real12), dimension(:,:), allocatable :: positions + real(real32), dimension(:,:), allocatable :: positions ! Read the geometry @@ -279,9 +279,9 @@ program test_rw_geom !----------------------------------------------------------------------------- write(*,*) "----------------------------------------" if(success)then - write(*,*) 'test_rw_geom passed all tests' + write(*,*) 'test_geom_rw passed all tests' else - write(0,*) 'test_rw_geom failed one or more tests' + write(0,*) 'test_geom_rw failed one or more tests' stop 1 end if @@ -331,4 +331,4 @@ subroutine uninitialise_bas(bas) end subroutine uninitialise_bas -end program test_rw_geom \ No newline at end of file +end program test_geom_rw \ No newline at end of file diff --git a/test/test_edit_geom.f90 b/test/test_geom_utils.f90 similarity index 50% rename from test/test_edit_geom.f90 rename to test/test_geom_utils.f90 index c6547c37..b8728fc2 100644 --- a/test/test_edit_geom.f90 +++ b/test/test_geom_utils.f90 @@ -1,18 +1,13 @@ -program test_edit_geom +program test_geom_utils !! Test program for the module edit_geom. - use constants, only: real12 - use rw_geom, only: basis_type - use misc_linalg, only: modu - use edit_geom, only: & - get_min_dist, & - get_min_dist_between_point_and_atom, & - basis_merge + use raffle__constants, only: real32 + use raffle__geom_rw, only: basis_type + use raffle__misc_linalg, only: modu + use raffle__geom_utils, only: basis_merge implicit none type(basis_type) :: bas, bas2, basis_merged - real(real12) :: rtmp1, rtmp2 - real(real12), dimension(3) :: loc logical :: success = .true. @@ -34,38 +29,6 @@ program test_edit_geom bas%lat(3,:) = [2.14, 2.14, 0.0] - !----------------------------------------------------------------------------- - ! Test get_min_dist - !----------------------------------------------------------------------------- - rtmp1 = modu(get_min_dist(bas, loc=[0.9, 0.9, 0.9], lignore_close = .true.)) - - loc = [1.0, 1.0, 1.0] - [0.9, 0.9, 0.9] - loc = loc - ceiling(loc - 0.5) - loc = matmul(loc, bas%lat) - rtmp2 = modu(loc) - - if ( abs(rtmp1 - rtmp2) .gt. 1.E-6 ) then - write(0,*) 'get_min_dist failed' - success = .false. - end if - - - !----------------------------------------------------------------------------- - ! Test get_min_dist_between_point_and_atom - !----------------------------------------------------------------------------- - rtmp1 = get_min_dist_between_point_and_atom(bas, loc=[0.9, 0.9, 0.9], atom=[1, 1]) - - loc = [1.0, 1.0, 1.0] - [0.9, 0.9, 0.9] - loc = loc - ceiling(loc - 0.5) - loc = matmul(loc, bas%lat) - rtmp2 = modu(loc) - - if ( abs(rtmp1 - rtmp2) .gt. 1.E-6 ) then - write(0,*) 'get_min_dist_between_point_and_atom failed' - success = .false. - end if - - !----------------------------------------------------------------------------- ! Test basis_merge !----------------------------------------------------------------------------- @@ -94,27 +57,39 @@ program test_edit_geom basis_merged = basis_merge(bas, bas2) if ( basis_merged%nspec .ne. 2 ) then - write(0,*) 'basis_merge failed, number of species not equal to 2: ', basis_merged%nspec + write(0,*) & + 'basis_merge failed, number of species not equal to 2: ', & + basis_merged%nspec success = .false. end if if ( basis_merged%natom .ne. 5 ) then - write(0,*) 'basis_merge failed, number of atoms not equal to 5: ', basis_merged%natom + write(0,*) & + 'basis_merge failed, number of atoms not equal to 5: ', & + basis_merged%natom success = .false. end if if ( basis_merged%spec(1)%num .ne. 4 ) then - write(0,*) 'basis_merge failed, number of atoms for species 1 not equal to 4: ', basis_merged%spec(1)%num + write(0,*) & + 'basis_merge failed, number of atoms for species 1 not equal to 4: ', & + basis_merged%spec(1)%num success = .false. end if if ( basis_merged%spec(2)%num .ne. 1 ) then - write(0,*) 'basis_merge failed, number of atoms for species 2 not equal to 1: ', basis_merged%spec(2)%num + write(0,*) & + 'basis_merge failed, number of atoms for species 2 not equal to 1: ', & + basis_merged%spec(2)%num success = .false. end if if( basis_merged%spec(1)%name .ne. 'Si' ) then - write(0,*) 'basis_merge failed, name of species 1 not equal to Si: ', basis_merged%spec(1)%name + write(0,*) & + 'basis_merge failed, name of species 1 not equal to Si: ', & + basis_merged%spec(1)%name success = .false. end if if( basis_merged%spec(2)%name .ne. 'O' ) then - write(0,*) 'basis_merge failed, name of species 2 not equal to O: ', basis_merged%spec(2)%name + write(0,*) & + 'basis_merge failed, name of species 2 not equal to O: ', & + basis_merged%spec(2)%name success = .false. end if @@ -124,10 +99,10 @@ program test_edit_geom !----------------------------------------------------------------------------- write(*,*) "----------------------------------------" if(success)then - write(*,*) 'test_edit_geom passed all tests' + write(*,*) 'test_geom_utils passed all tests' else - write(0,*) 'test_edit_geom failed one or more tests' + write(0,*) 'test_geom_utils failed one or more tests' stop 1 end if -end program test_edit_geom \ No newline at end of file +end program test_geom_utils \ No newline at end of file diff --git a/test/test_misc.f90 b/test/test_misc.f90 index fbcc865e..14eafc1a 100644 --- a/test/test_misc.f90 +++ b/test/test_misc.f90 @@ -1,7 +1,7 @@ program test_misc - use error_handling - use misc_raffle - use constants, only: real12 + use raffle__io_utils + use raffle__misc + use raffle__constants, only: real32 implicit none logical :: success = .true. @@ -117,16 +117,16 @@ end subroutine test_isort1D subroutine test_rsort1D(success) implicit none logical, intent(inout) :: success - real(real12), dimension(5) :: arr = & - [5._real12, 3._real12, 4._real12, 1._real12, 2._real12] - real(real12), dimension(5) :: expected_arr = & - [1._real12, 2._real12, 3._real12, 4._real12, 5._real12] + real(real32), dimension(5) :: arr = & + [5._real32, 3._real32, 4._real32, 1._real32, 2._real32] + real(real32), dimension(5) :: expected_arr = & + [1._real32, 2._real32, 3._real32, 4._real32, 5._real32] call sort1D(arr) call assert( & all( abs(arr - expected_arr) .lt. 1.E-6), & 'test_rsort1D failed', success & ) - expected_arr = [5._real12, 4._real12, 3._real12, 2._real12, 1._real12] + expected_arr = [5._real32, 4._real32, 3._real32, 2._real32, 1._real32] call sort1D(arr, reverse=.true.) call assert( & all(arr .eq. expected_arr), & @@ -153,19 +153,19 @@ end subroutine test_iset subroutine test_rset(success) implicit none logical, intent(inout) :: success - real(real12), dimension(:), allocatable :: arr - real(real12), dimension(:), allocatable :: expected_arr + real(real32), dimension(:), allocatable :: arr + real(real32), dimension(:), allocatable :: expected_arr allocate(arr(6)) - arr = [1._real12, 2._real12, 2._real12, 3._real12, 3._real12, 3._real12] + arr = [1._real32, 2._real32, 2._real32, 3._real32, 3._real32, 3._real32] allocate(expected_arr(3)) - expected_arr = [1._real12, 2._real12, 3._real12] + expected_arr = [1._real32, 2._real32, 3._real32] call set(arr) call assert( & all( abs(arr - expected_arr) .lt. 1.E-6), & 'test_rset failed', success & ) - arr = [1._real12, 2._real12, 2.00001_real12, 3._real12, 3._real12] - expected_arr = [1._real12, 2._real12, 2.00001_real12, 3._real12] + arr = [1._real32, 2._real32, 2.00001_real32, 3._real32, 3._real32] + expected_arr = [1._real32, 2._real32, 2.00001_real32, 3._real32] call set(arr, tol=1.E-6) call assert( & all( abs(arr - expected_arr) .lt. 1.E-6), & @@ -230,10 +230,10 @@ end subroutine test_ishuffle subroutine test_rshuffle(success) implicit none logical, intent(inout) :: success - real(real12) :: arr(1,5) - real(real12) :: original_arr(1,5) + real(real32) :: arr(1,5) + real(real32) :: original_arr(1,5) - arr(1,:) = [1._real12, 2._real12, 3._real12, 4._real12, 5._real12] + arr(1,:) = [1._real32, 2._real32, 3._real32, 4._real32, 5._real32] original_arr(1,:) = arr(1,:) call shuffle(arr, dim=2, seed=0) call assert(any(abs(arr - original_arr).gt.1.E-6), "rshuffle failed", success) @@ -339,10 +339,10 @@ end subroutine test_jump subroutine test_rswap(success) implicit none logical, intent(inout) :: success - real(real12) :: a = 1._real12 - real(real12) :: b = 2._real12 - real(real12) :: expected_a = 2._real12 - real(real12) :: expected_b = 1._real12 + real(real32) :: a = 1._real32 + real(real32) :: b = 2._real32 + real(real32) :: expected_a = 2._real32 + real(real32) :: expected_b = 1._real32 call swap(a, b) call assert( & @@ -356,13 +356,13 @@ end subroutine test_rswap subroutine test_rswap_vec(success) implicit none logical, intent(inout) :: success - real(real12), dimension(2) :: a = [1._real12, 2._real12] - real(real12), dimension(2) :: b = [3._real12, 4._real12] + real(real32), dimension(2) :: a = [1._real32, 2._real32] + real(real32), dimension(2) :: b = [3._real32, 4._real32] call swap(a, b) call assert( & - all( abs(a - [3._real12, 4._real12]) .lt. 1.E-6_real12 ) .and. & - all( abs(b - [1._real12, 2._real12]) .lt. 1.E-6_real12 ), & + all( abs(a - [3._real32, 4._real32]) .lt. 1.E-6_real32 ) .and. & + all( abs(b - [1._real32, 2._real32]) .lt. 1.E-6_real32 ), & "rswap_vec failed", success & ) diff --git a/test/test_misc_linalg.f90 b/test/test_misc_linalg.f90 index 883dff5d..f4464218 100644 --- a/test/test_misc_linalg.f90 +++ b/test/test_misc_linalg.f90 @@ -1,7 +1,7 @@ program test_misc_linalg - use error_handling - use misc_linalg - use constants, only: real12, pi + use raffle__io_utils + use raffle__misc_linalg + use raffle__constants, only: real32, pi implicit none logical :: success = .true. @@ -9,7 +9,6 @@ program test_misc_linalg test_error_handling = .true. - call test_uvec(success) call test_modu(success) call test_cross(success) call test_get_distance(success) @@ -17,8 +16,6 @@ program test_misc_linalg call test_get_angle_from_points(success) call test_get_dihedral_angle_from_vectors(success) call test_get_dihedral_angle_from_points(success) - call test_get_area(success) - call test_get_vol(success) call test_inverse_3x3(success) @@ -35,157 +32,121 @@ program test_misc_linalg contains - subroutine test_uvec(success) - logical, intent(inout) :: success - real(real12), dimension(3) :: vector, result - vector = [3.0_real12, 4.0_real12, 0.0_real12] - result = uvec(vector) - call assert_almost_equal_vector( & - result, [0.6_real12, 0.8_real12, 0.0_real12], 1.E-6_real12, & - "uvec", success & - ) - end subroutine test_uvec - subroutine test_modu(success) logical, intent(inout) :: success - real(real12), dimension(3) :: vector - real(real12) :: result - vector = [3.0_real12, 4.0_real12, 0.0_real12] + real(real32), dimension(3) :: vector + real(real32) :: result + vector = [3.0_real32, 4.0_real32, 0.0_real32] result = modu(vector) call assert_almost_equal_scalar( & - result, 5.0_real12, 1.E-6_real12, & + result, 5.0_real32, 1.E-6_real32, & "modu", success & ) end subroutine test_modu subroutine test_cross(success) logical, intent(inout) :: success - real(real12), dimension(3) :: a, b, result - a = [1.0_real12, 0.0_real12, 0.0_real12] - b = [0.0_real12, 1.0_real12, 0.0_real12] + real(real32), dimension(3) :: a, b, result + a = [1.0_real32, 0.0_real32, 0.0_real32] + b = [0.0_real32, 1.0_real32, 0.0_real32] result = cross(a, b) call assert_almost_equal_vector( & - result, [0.0_real12, 0.0_real12, 1.0_real12], 1.E-6_real12, & + result, [0.0_real32, 0.0_real32, 1.0_real32], 1.E-6_real32, & "cross", success & ) end subroutine test_cross subroutine test_get_distance(success) logical, intent(inout) :: success - real(real12), dimension(3) :: point1, point2 - real(real12) :: result - point1 = [1.0_real12, 2.0_real12, 3.0_real12] - point2 = [4.0_real12, 6.0_real12, 8.0_real12] + real(real32), dimension(3) :: point1, point2 + real(real32) :: result + point1 = [1.0_real32, 2.0_real32, 3.0_real32] + point2 = [4.0_real32, 6.0_real32, 8.0_real32] result = get_distance(point1, point2) call assert_almost_equal_scalar( & - result, 7.0710678118654755_real12, 1.E-6_real12, & + result, 7.0710678118654755_real32, 1.E-6_real32, & "get_angle_from_vectors", success & ) end subroutine test_get_distance subroutine test_get_angle_from_vectors(success) logical, intent(inout) :: success - real(real12), dimension(3) :: vector1, vector2 - real(real12) :: result - vector1 = [1.0_real12, 0.0_real12, 0.0_real12] - vector2 = [0.0_real12, 1.0_real12, 0.0_real12] + real(real32), dimension(3) :: vector1, vector2 + real(real32) :: result + vector1 = [1.0_real32, 0.0_real32, 0.0_real32] + vector2 = [0.0_real32, 1.0_real32, 0.0_real32] result = get_angle(vector1, vector2) call assert_almost_equal_scalar( & - result, pi/2.0_real12, 1.E-6_real12, & + result, pi/2.0_real32, 1.E-6_real32, & "get_angle_from_vectors", success & ) end subroutine test_get_angle_from_vectors subroutine test_get_angle_from_points(success) logical, intent(inout) :: success - real(real12), dimension(3) :: point1, point2, point3 - real(real12) :: result - point1 = [1.0_real12, 0.0_real12, 0.0_real12] - point2 = [0.0_real12, 0.0_real12, 0.0_real12] - point3 = [0.0_real12, 1.0_real12, 0.0_real12] + real(real32), dimension(3) :: point1, point2, point3 + real(real32) :: result + point1 = [1.0_real32, 0.0_real32, 0.0_real32] + point2 = [0.0_real32, 0.0_real32, 0.0_real32] + point3 = [0.0_real32, 1.0_real32, 0.0_real32] result = get_angle(point1, point2, point3) call assert_almost_equal_scalar( & - result, pi/2.0_real12, 1.E-6_real12, & + result, pi/2.0_real32, 1.E-6_real32, & "get_angle_from_points", success & ) end subroutine test_get_angle_from_points subroutine test_get_dihedral_angle_from_vectors(success) logical, intent(inout) :: success - real(real12), dimension(3) :: vector1, vector2, vector3 - real(real12) :: result - vector1 = [1.0_real12, 0.0_real12, 0.0_real12] - vector2 = [0.0_real12, 1.0_real12, 0.0_real12] - vector3 = [1.0_real12, 0.0_real12, 0.0_real12] + real(real32), dimension(3) :: vector1, vector2, vector3 + real(real32) :: result + vector1 = [1.0_real32, 0.0_real32, 0.0_real32] + vector2 = [0.0_real32, 1.0_real32, 0.0_real32] + vector3 = [1.0_real32, 0.0_real32, 0.0_real32] result = get_dihedral_angle(vector1, vector2, vector3) call assert_almost_equal_scalar( & - result, pi/2.0_real12, 1.E-6_real12, & + result, pi/2.0_real32, 1.E-6_real32, & "get_dihedral_angle_from_vectors", success & ) end subroutine test_get_dihedral_angle_from_vectors subroutine test_get_dihedral_angle_from_points(success) logical, intent(inout) :: success - real(real12), dimension(3) :: point1, point2, point3, point4 - real(real12) :: result - point1 = [1.0_real12, 0.0_real12, 0.0_real12] - point2 = [0.0_real12, 0.0_real12, 0.0_real12] - point3 = [0.0_real12, 1.0_real12, 0.0_real12] - point4 = [1.0_real12, 0.0_real12, .0_real12] + real(real32), dimension(3) :: point1, point2, point3, point4 + real(real32) :: result + point1 = [1.0_real32, 0.0_real32, 0.0_real32] + point2 = [0.0_real32, 0.0_real32, 0.0_real32] + point3 = [0.0_real32, 1.0_real32, 0.0_real32] + point4 = [1.0_real32, 0.0_real32, .0_real32] result = get_dihedral_angle(point1, point2, point3, point4) call assert_almost_equal_scalar( & - result, pi/2.0_real12, 1.E-6_real12, & + result, pi/2.0_real32, 1.E-6_real32, & "get_dihedral_angle_from_points", success & ) end subroutine test_get_dihedral_angle_from_points - subroutine test_get_area(success) - logical, intent(inout) :: success - real(real12), dimension(3) :: a, b - real(real12) :: result - a = [1.0_real12, 0.0_real12, 0.0_real12] - b = [0.0_real12, 1.0_real12, 0.0_real12] - result = get_area(a, b) - call assert_almost_equal_scalar( & - result, 1.0_real12, 1.E-6_real12, "get_area", success & - ) - end subroutine test_get_area - - subroutine test_get_vol(success) - logical, intent(inout) :: success - real(real12), dimension(3,3) :: matrix - real(real12) :: result - matrix = reshape([1.0_real12, 0.0_real12, 0.0_real12, & - 0.0_real12, 1.0_real12, 0.0_real12, & - 0.0_real12, 0.0_real12, 1.0_real12], [3,3]) - result = get_vol(matrix) - call assert_almost_equal_scalar( & - result, 1.0_real12, 1.E-6_real12, "get_vol", success & - ) - end subroutine test_get_vol - subroutine test_inverse_3x3(success) logical, intent(inout) :: success - real(real12), dimension(3,3) :: matrix, result, expected - matrix = reshape([4.0_real12, 3.0_real12, 0.0_real12, & - 3.0_real12, 2.0_real12, 1.0_real12, & - 0.0_real12, 1.0_real12, 1.0_real12], [3,3]) - expected = reshape([-1.0_real12, 3.0_real12, -3.0_real12, & - 3.0_real12, -4.0_real12, 4.0_real12, & - -3.0_real12, 4.0_real12, 1.0_real12], [3,3]) - expected = expected / 5.0_real12 + real(real32), dimension(3,3) :: matrix, result, expected + matrix = reshape([4.0_real32, 3.0_real32, 0.0_real32, & + 3.0_real32, 2.0_real32, 1.0_real32, & + 0.0_real32, 1.0_real32, 1.0_real32], [3,3]) + expected = reshape([-1.0_real32, 3.0_real32, -3.0_real32, & + 3.0_real32, -4.0_real32, 4.0_real32, & + -3.0_real32, 4.0_real32, 1.0_real32], [3,3]) + expected = expected / 5.0_real32 result = inverse_3x3(matrix) call assert_almost_equal_matrix( & - result, expected, 1.E-6_real12, "inverse_3x3", success & + result, expected, 1.E-6_real32, "inverse_3x3", success & ) end subroutine test_inverse_3x3 subroutine assert_almost_equal_scalar(actual, expected, tol, message, success) - real(real12), intent(in) :: actual - real(real12), intent(in) :: expected + real(real32), intent(in) :: actual + real(real32), intent(in) :: expected character(len=*), intent(in) :: message logical, intent(inout) :: success - real(real12), intent(in) :: tol + real(real32), intent(in) :: tol if( abs(actual - expected) .gt. tol ) then write(0,*) "Test failed: ", message @@ -194,11 +155,11 @@ subroutine assert_almost_equal_scalar(actual, expected, tol, message, success) end subroutine assert_almost_equal_scalar subroutine assert_almost_equal_vector(actual, expected, tol, message, success) - real(real12), dimension(:), intent(in) :: actual - real(real12), dimension(..), intent(in) :: expected + real(real32), dimension(:), intent(in) :: actual + real(real32), dimension(..), intent(in) :: expected character(len=*), intent(in) :: message logical, intent(inout) :: success - real(real12), intent(in) :: tol + real(real32), intent(in) :: tol select rank(expected) rank(0) @@ -215,11 +176,11 @@ subroutine assert_almost_equal_vector(actual, expected, tol, message, success) end subroutine assert_almost_equal_vector subroutine assert_almost_equal_matrix(actual, expected, tol, message, success) - real(real12), dimension(:,:), intent(in) :: actual - real(real12), dimension(..), intent(in) :: expected + real(real32), dimension(:,:), intent(in) :: actual + real(real32), dimension(..), intent(in) :: expected character(len=*), intent(in) :: message logical, intent(inout) :: success - real(real12), intent(in) :: tol + real(real32), intent(in) :: tol select rank(expected) rank(0) diff --git a/test/test_misc_maths.f90 b/test/test_misc_maths.f90 index a52e6f34..ee48a8dc 100644 --- a/test/test_misc_maths.f90 +++ b/test/test_misc_maths.f90 @@ -1,7 +1,7 @@ program test_misc_maths - use error_handling, only: test_error_handling - use misc_maths - use constants, only: real12 + use raffle__io_utils, only: test_error_handling + use raffle__misc_maths + use raffle__constants, only: real32 implicit none logical :: success = .true. @@ -31,7 +31,7 @@ subroutine test_lnsum(success) implicit none logical, intent(inout) :: success integer :: n - real(real12) :: result + real(real32) :: result n = 5 result = lnsum(n) @@ -39,13 +39,13 @@ subroutine test_lnsum(success) abs( & result - & ( & - log(1.0_real12) + & - log(2.0_real12) + & - log(3.0_real12) + & - log(4.0_real12) + & - log(5.0_real12) & + log(1.0_real32) + & + log(2.0_real32) + & + log(3.0_real32) + & + log(4.0_real32) + & + log(5.0_real32) & ) & - ) .lt. 1.E-6_real12, & + ) .lt. 1.E-6_real32, & 'lnsum failed', & success & ) @@ -68,31 +68,31 @@ end subroutine test_triangular_number subroutine test_set_difference(success) implicit none logical, intent(inout) :: success - real(real12), dimension(3) :: a, b, result, expected - real(real12), dimension(4) :: c + real(real32), dimension(3) :: a, b, result, expected + real(real32), dimension(4) :: c - a = [1.0_real12, 2.0_real12, 3.0_real12] - b = [1.0_real12, 1.0_real12, 1.0_real12] - expected = [0.0_real12, 1.0_real12, 2.0_real12] + a = [1.0_real32, 2.0_real32, 3.0_real32] + b = [1.0_real32, 1.0_real32, 1.0_real32] + expected = [0.0_real32, 1.0_real32, 2.0_real32] result = set_difference(a, b) call assert( & - all( abs(result - expected) .lt. 1.E-6_real12 ), & + all( abs(result - expected) .lt. 1.E-6_real32 ), & 'Set difference failed', & success & ) - b = [0.0_real12, 1.0_real12, 4.0_real12] - expected = [1.0_real12, 1.0_real12, 0.0_real12] + b = [0.0_real32, 1.0_real32, 4.0_real32] + expected = [1.0_real32, 1.0_real32, 0.0_real32] result = set_difference(a, b, set_min_zero=.true.) call assert( & - all( abs(result - expected) .lt. 1.E-6_real12 ), & + all( abs(result - expected) .lt. 1.E-6_real32 ), & 'Set difference min zero failed', & success & ) - c = [1.0_real12, 2.0_real12, 3.0_real12, 4.0_real12] + c = [1.0_real32, 2.0_real32, 3.0_real32, 4.0_real32] write(*,*) "Testing set_difference error handling" result = set_difference(a, c) write(*,*) "Handled error: set difference of arrays of different lengths" diff --git a/test/test_place_methods.f90 b/test/test_place_methods.f90 new file mode 100644 index 00000000..9218a492 --- /dev/null +++ b/test/test_place_methods.f90 @@ -0,0 +1,104 @@ +program test_place_methods + use raffle__io_utils + use raffle__place_methods + use raffle__distribs_container, only: distribs_container_type + use raffle__constants, only: real32 + use raffle__geom_rw, only: basis_type + use raffle__geom_extd, only: extended_basis_type + implicit none + + type(basis_type) :: basis + logical :: success = .true. + + test_error_handling = .true. + + ! Initialise basis + basis%nspec = 1 + allocate(basis%spec(basis%nspec)) + basis%spec(1)%name = 'C' + basis%spec(1)%num = 2 + allocate(basis%spec(1)%atom(basis%spec(1)%num,3)) + basis%spec(1)%atom(1,:) = [0.0_real32, 0.0_real32, 0.0_real32] + basis%spec(1)%atom(2,:) = [0.5_real32, 0.5_real32, 0.5_real32] + basis%lat = 0.0_real32 + basis%lat(1,1) = 5.0_real32 + basis%lat(2,2) = 5.0_real32 + basis%lat(3,3) = 5.0_real32 + + + call test_place_method_void(basis, success) + + + !----------------------------------------------------------------------------- + ! check for any failed tests + !----------------------------------------------------------------------------- + write(*,*) "----------------------------------------" + if(success)then + write(*,*) 'test_place_methods passed all tests' + else + write(0,*) 'test_place_methods failed one or more tests' + stop 1 + end if + +contains + + subroutine test_place_method_void(basis, success) + implicit none + logical, intent(inout) :: success + type(basis_type), intent(in) :: basis + + integer :: i + type(extended_basis_type) :: basis_copy + logical :: viable + integer, dimension(3) :: grid + real(real32), dimension(3) :: grid_offset + real(real32), dimension(3) :: point + integer, dimension(:,:), allocatable :: atom_ignore_list + real(real32), dimension(3) :: tolerance + + ! Initialise test data + grid = [10, 10, 10] + allocate(atom_ignore_list(1, 2)) ! No atoms to ignore + atom_ignore_list(1,:) = [1,2] + grid_offset = [0.5_real32, 0.5_real32, 0.5_real32] + + ! Initialise basis + call basis_copy%copy(basis) + + ! Call the void subroutine + point = place_method_void( & + grid, grid_offset, basis_copy, & + atom_ignore_list, & + viable & + ) + + ! Check if viable + call assert(viable, "No viable gridpoints found.", success) + + do i = 1, 3 + tolerance(i) = 1._real32 / real(grid(i),real32) / 2._real32 + end do + ! Check point is correct + call assert( & + all( abs( point - 0.5_real32) .lt. tolerance + 1.E-6_real32 ), & + "Incorrect gridpoint found.", & + success & + ) + + end subroutine test_place_method_void + + +!############################################################################### + + subroutine assert(condition, message, success) + implicit none + logical, intent(in) :: condition + character(len=*), intent(in) :: message + logical, intent(inout) :: success + if (.not. condition) then + write(0,*) "Test failed: ", message + success = .false. + end if + end subroutine assert + +end program test_place_methods \ No newline at end of file diff --git a/test/test_atom_adder.f90 b/test/test_viability.f90 similarity index 57% rename from test/test_atom_adder.f90 rename to test/test_viability.f90 index 82dfece5..cb2b23d3 100644 --- a/test/test_atom_adder.f90 +++ b/test/test_viability.f90 @@ -1,10 +1,10 @@ -program test_atom_adder - use error_handling - use add_atom - use evolver, only: gvector_container_type - use constants, only: real12 - use rw_geom, only: basis_type - use extended_geom, only: extended_basis_type +program test_place_methods + use raffle__io_utils + use raffle__viability + use raffle__distribs_container, only: distribs_container_type + use raffle__constants, only: real32 + use raffle__geom_rw, only: basis_type + use raffle__geom_extd, only: extended_basis_type implicit none type(basis_type) :: basis @@ -18,17 +18,16 @@ program test_atom_adder basis%spec(1)%name = 'C' basis%spec(1)%num = 2 allocate(basis%spec(1)%atom(basis%spec(1)%num,3)) - basis%spec(1)%atom(1,:) = [0.0_real12, 0.0_real12, 0.0_real12] - basis%spec(1)%atom(2,:) = [0.5_real12, 0.5_real12, 0.5_real12] - basis%lat = 0.0_real12 - basis%lat(1,1) = 5.0_real12 - basis%lat(2,2) = 5.0_real12 - basis%lat(3,3) = 5.0_real12 + basis%spec(1)%atom(1,:) = [0.0_real32, 0.0_real32, 0.0_real32] + basis%spec(1)%atom(2,:) = [0.5_real32, 0.5_real32, 0.5_real32] + basis%lat = 0.0_real32 + basis%lat(1,1) = 5.0_real32 + basis%lat(2,2) = 5.0_real32 + basis%lat(3,3) = 5.0_real32 call test_get_gridpoints_and_viability(basis, success) call test_update_gridpoints_and_viability(basis, success) - call test_add_atom_void(basis, success) !----------------------------------------------------------------------------- @@ -36,9 +35,9 @@ program test_atom_adder !----------------------------------------------------------------------------- write(*,*) "----------------------------------------" if(success)then - write(*,*) 'test_add_atom passed all tests' + write(*,*) 'test_place_methods passed all tests' else - write(0,*) 'test_add_atom failed one or more tests' + write(0,*) 'test_place_methods failed one or more tests' stop 1 end if @@ -51,40 +50,40 @@ subroutine test_get_gridpoints_and_viability(basis, success) integer :: i type(extended_basis_type) :: basis_copy - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container integer, dimension(3) :: grid integer, dimension(:,:), allocatable :: atom_ignore_list - real(real12), dimension(:), allocatable :: radius_list - real(real12) :: lowtol - real(real12), dimension(:,:), allocatable :: points - real(real12), dimension(3) :: grid_offset + real(real32), dimension(:), allocatable :: radius_list + real(real32) :: lowtol + real(real32), dimension(:,:), allocatable :: points + real(real32), dimension(3) :: grid_offset ! Initialise test data grid = [10, 10, 10] allocate(atom_ignore_list(1, 2)) ! No atoms to ignore atom_ignore_list(1,:) = [1,2] allocate(radius_list(1)) - radius_list = 1.0_real12 - lowtol = 0.5_real12 - grid_offset = [0.5_real12, 0.5_real12, 0.5_real12] + radius_list = 1.0_real32 + lowtol = 0.5_real32 + grid_offset = [0.5_real32, 0.5_real32, 0.5_real32] ! Initialise basis call basis_copy%copy(basis) call basis_copy%create_images( & - max_bondlength = gvector_container%cutoff_max(1), & + max_bondlength = distribs_container%cutoff_max(1), & atom_ignore_list = atom_ignore_list & ) ! Initialise gvector container - call gvector_container%set_element_energies( & + call distribs_container%set_element_energies( & [basis%spec(:)%name], & - [ ( 0.0_real12, i = 1, basis%nspec ) ] & + [ ( 0.0_real32, i = 1, basis%nspec ) ] & ) - call gvector_container%create([basis]) + call distribs_container%create([basis]) ! Call the function to test points = get_gridpoints_and_viability( & - gvector_container, & + distribs_container, & grid, basis_copy, & [ 1 ], & radius_list, & @@ -117,40 +116,40 @@ subroutine test_update_gridpoints_and_viability(basis, success) integer :: i type(extended_basis_type) :: basis_copy - type(gvector_container_type) :: gvector_container + type(distribs_container_type) :: distribs_container integer, dimension(3) :: grid integer, dimension(:,:), allocatable :: atom_ignore_list - real(real12), dimension(:), allocatable :: radius_list - real(real12) :: lowtol - real(real12), dimension(:,:), allocatable :: points - real(real12), dimension(3) :: grid_offset + real(real32), dimension(:), allocatable :: radius_list + real(real32) :: lowtol + real(real32), dimension(:,:), allocatable :: points + real(real32), dimension(3) :: grid_offset ! Initialise test data grid = [10, 10, 10] allocate(atom_ignore_list(1, 2)) ! No atoms to ignore atom_ignore_list(1,:) = [1,2] allocate(radius_list(1)) - radius_list = 1.0_real12 !!! NO!!! USING CARBON RADIUS - lowtol = 0.5_real12 - grid_offset = [0.5_real12, 0.5_real12, 0.5_real12] + radius_list = 1.0_real32 !!! NO!!! USING CARBON RADIUS + lowtol = 0.5_real32 + grid_offset = [0.5_real32, 0.5_real32, 0.5_real32] ! Initialise basis call basis_copy%copy(basis) call basis_copy%create_images( & - max_bondlength = gvector_container%cutoff_max(1), & + max_bondlength = distribs_container%cutoff_max(1), & atom_ignore_list = atom_ignore_list & ) ! Initialise gvector container - call gvector_container%set_element_energies( & + call distribs_container%set_element_energies( & [basis%spec(:)%name], & - [ ( 0.0_real12, i = 1, basis%nspec ) ] & + [ ( 0.0_real32, i = 1, basis%nspec ) ] & ) - call gvector_container%create([basis]) + call distribs_container%create([basis]) ! Call the function to test points = get_gridpoints_and_viability( & - gvector_container, & + distribs_container, & grid, basis_copy, & [ 1 ], & radius_list, & @@ -160,7 +159,7 @@ subroutine test_update_gridpoints_and_viability(basis, success) ! Call the update subroutine call update_gridpoints_and_viability( & - points, gvector_container, basis_copy, & + points, distribs_container, basis_copy, & [1], & [1,2], & radius_list, & @@ -185,9 +184,9 @@ subroutine test_update_gridpoints_and_viability(basis, success) ) ! Call the update subroutine - gvector_container%radius_distance_tol(1) = 100._real12 + distribs_container%radius_distance_tol(1) = 100._real32 call update_gridpoints_and_viability( & - points, gvector_container, basis_copy, & + points, distribs_container, basis_copy, & [1], & [1,2], & radius_list, & @@ -199,51 +198,6 @@ subroutine test_update_gridpoints_and_viability(basis, success) end subroutine test_update_gridpoints_and_viability - subroutine test_add_atom_void(basis, success) - implicit none - logical, intent(inout) :: success - type(basis_type), intent(in) :: basis - - integer :: i - type(extended_basis_type) :: basis_copy - logical :: viable - integer, dimension(3) :: grid - real(real12), dimension(3) :: grid_offset - real(real12), dimension(3) :: point - integer, dimension(:,:), allocatable :: atom_ignore_list - real(real12), dimension(3) :: tolerance - - ! Initialise test data - grid = [10, 10, 10] - allocate(atom_ignore_list(1, 2)) ! No atoms to ignore - atom_ignore_list(1,:) = [1,2] - grid_offset = [0.5_real12, 0.5_real12, 0.5_real12] - - ! Initialise basis - call basis_copy%copy(basis) - - ! Call the void subroutine - point = add_atom_void( & - grid, grid_offset, basis_copy, & - atom_ignore_list, & - viable & - ) - - ! Check if viable - call assert(viable, "No viable gridpoints found.", success) - - do i = 1, 3 - tolerance(i) = 1._real12 / real(grid(i),real12) / 2._real12 - end do - ! Check point is correct - call assert( & - all( abs( point - 0.5_real12) .lt. tolerance + 1.E-6_real12 ), & - "Incorrect gridpoint found.", & - success & - ) - - end subroutine test_add_atom_void - !############################################################################### @@ -258,4 +212,4 @@ subroutine assert(condition, message, success) end if end subroutine assert -end program test_atom_adder \ No newline at end of file +end program test_place_methods \ No newline at end of file diff --git a/tools/version_number.py b/tools/version_number.py new file mode 100644 index 00000000..e72ed526 --- /dev/null +++ b/tools/version_number.py @@ -0,0 +1,27 @@ +import re + +def update_version(new_version): + # Update fpm.toml + with open('fpm.toml', 'r') as file: + content = file.read() + content = re.sub(r'version = "\d+\.\d+\.\d+"', f'version = "{new_version}"', content) + with open('fpm.toml', 'w') as file: + file.write(content) + + # Update Fortran module + with open('src/fortran/lib/mod_io_utils.F90', 'r') as file: + content = file.read() + content = re.sub(r'character\(len=\*\), parameter :: version = "\d+\.\d+\.\d+"', f'character(len=*), parameter :: version = "{new_version}"', content) + with open('src/fortran/lib/mod_io_utils.F90', 'w') as file: + file.write(content) + +def get_version(): + # get the version number from fpm.toml + with open('fpm.toml', 'r') as file: + content = file.read() + match = re.search(r'version = "(\d+\.\d+\.\d+)"', content) + if match: + return match.group(1) + +if __name__ == '__main__': + update_version(get_version())