From ee32b47129ea883171ad293c9de9e317ab86d10c Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Mon, 22 Jan 2024 15:00:26 +0000 Subject: [PATCH 001/137] Handle single-atom cell --- src/lib/mod_edit_geom.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/lib/mod_edit_geom.f90 b/src/lib/mod_edit_geom.f90 index 8f092e0..c1f36ee 100644 --- a/src/lib/mod_edit_geom.f90 +++ b/src/lib/mod_edit_geom.f90 @@ -197,6 +197,7 @@ function get_min_bulk_bond(lat,bas) result(min_bond) vdtmp1(2)*lat(2,:3) + & vdtmp1(3)*lat(3,:3) dtmp1 = modu(vdtmp1) + write(*,*) "tmp",dtmp1, min_bond if(dtmp1.lt.min_bond) min_bond = dtmp1 end do atmloop end do From 680dee1980177bd4e5d07035f63170e320b5b61e Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Mon, 22 Jan 2024 15:04:28 +0000 Subject: [PATCH 002/137] Remove test printing --- src/lib/mod_edit_geom.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/lib/mod_edit_geom.f90 b/src/lib/mod_edit_geom.f90 index c1f36ee..8f092e0 100644 --- a/src/lib/mod_edit_geom.f90 +++ b/src/lib/mod_edit_geom.f90 @@ -197,7 +197,6 @@ function get_min_bulk_bond(lat,bas) result(min_bond) vdtmp1(2)*lat(2,:3) + & vdtmp1(3)*lat(3,:3) dtmp1 = modu(vdtmp1) - write(*,*) "tmp",dtmp1, min_bond if(dtmp1.lt.min_bond) min_bond = dtmp1 end do atmloop end do From 4f691996940eef9b403d71aaac7339a91007921a Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Mon, 22 Jan 2024 15:12:34 +0000 Subject: [PATCH 003/137] Fix unallocated shift array --- src/interfaces.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/interfaces.f90 b/src/interfaces.f90 index 4d2cc7b..77a4dfa 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -266,7 +266,6 @@ end subroutine gen_interfaces_restart subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) implicit none integer :: j,iterm,jterm,ntrans,ifit,iunique,old_natom,itmp1,old_intf - integer :: is, ia integer :: iterm_step,jterm_step integer :: lw_ncells,up_ncells integer :: lw_layered_axis,up_layered_axis From fb7d7aac059c6a9e9f583099bf61dbeaf4c9b9b2 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Mon, 20 Jan 2025 13:21:46 +0000 Subject: [PATCH 004/137] Fix natom check --- src/interfaces.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/interfaces.f90 b/src/interfaces.f90 index 77a4dfa..aa395d1 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -1431,7 +1431,7 @@ subroutine prepare_slab(lat, bas, map, term, iterm, thickness, ncells, & do j=1,term%nterm iterm_list(j) = j end do - iterm_list=cshift(iterm_list,term%nterm-iterm+1) + iterm_list=cshift(iterm_list,iterm-1) if(ludef_surf)then j_start = udef_top_iterm - iterm + 1 if(j_start.le.0) j_start = j_start + term%nterm From 7f6bbd8eb538b59be898f6abb3ec17721341bc0a Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 21 Jan 2025 10:09:05 +0000 Subject: [PATCH 005/137] Add termination fail tag --- src/inputs.f90 | 96 +++++++++++++++++++++++---------------------- src/interfaces.f90 | 48 +++++++++++++++++++---- src/lib/mod_sym.f90 | 31 +++++++++++---- src/mod_help.f90 | 12 +++++- 4 files changed, 125 insertions(+), 62 deletions(-) diff --git a/src/inputs.f90 b/src/inputs.f90 index 9e95212..c7a5b85 100644 --- a/src/inputs.f90 +++ b/src/inputs.f90 @@ -37,6 +37,7 @@ module inputs logical :: lpresent_struc2 logical :: lswap_mirror logical :: lc_fix + logical :: lbreak_on_no_term type(bas_type) :: struc1_bas,struc2_bas type(tol_type) :: tolerance type(aspect_type) :: edits @@ -143,6 +144,7 @@ subroutine set_global_vars() lw_bulk_modulus=0.E0 up_bulk_modulus=0.E0 lc_fix=.true. + lbreak_on_no_term = .true. !!!----------------------------------------------------------------------------- @@ -655,7 +657,7 @@ subroutine read_card_interfaces(unit,count,skip) logical :: ludef_offset, ludef_lw_layer_sep, ludef_up_layer_sep integer, intent(in) :: unit integer, intent(inout) :: count - integer, dimension(54) :: readvar + integer, dimension(55) :: readvar logical, optional, intent(in) :: skip @@ -738,100 +740,102 @@ subroutine read_card_interfaces(unit,count,skip) end select end if case("NSHIFT") - call assign(buffer,nshift, readvar(10)) + call assign(buffer,nshift, readvar(10)) case("NTERM") - call assign(buffer,nterm, readvar(11)) + call assign(buffer,nterm, readvar(11)) case("NMATCH") - call assign(buffer,tolerance%nstore, readvar(12)) + call assign(buffer,tolerance%nstore, readvar(12)) case("TOL_VEC") - call assign(buffer,tolerance%vec, readvar(13)) + call assign(buffer,tolerance%vec, readvar(13)) case("TOL_ANG") - call assign(buffer,tolerance%ang, readvar(14)) + call assign(buffer,tolerance%ang, readvar(14)) case("TOL_AREA") - call assign(buffer,tolerance%area, readvar(15)) + call assign(buffer,tolerance%area, readvar(15)) case("TOL_MAXFIND") - call assign(buffer,tolerance%maxfit, readvar(16)) + call assign(buffer,tolerance%maxfit, readvar(16)) case("TOL_MAXSIZE") - call assign(buffer,tolerance%maxsize,readvar(17)) + call assign(buffer,tolerance%maxsize, readvar(17)) case("LPRINT_MATCHES") - call assign(buffer,lprint_matches, readvar(18)) + call assign(buffer,lprint_matches, readvar(18)) case("LPRINT_TERMS") - call assign(buffer,lprint_terms, readvar(19)) + call assign(buffer,lprint_terms, readvar(19)) case("LGEN_INTERFACES") - call assign(buffer,lgen_interfaces, readvar(20)) + call assign(buffer,lgen_interfaces, readvar(20)) case("IMATCH") - call assign(buffer,imatch, readvar(21)) + call assign(buffer,imatch, readvar(21)) case("ISHIFT") - call assign(buffer,ishift, readvar(22)) + call assign(buffer,ishift, readvar(22)) case("LREDUCE") - call assign(buffer,lreduce, readvar(23)) + call assign(buffer,lreduce, readvar(23)) case("LPRINT_SHIFTS") - call assign(buffer,lprint_shifts, readvar(24)) + call assign(buffer,lprint_shifts, readvar(24)) case("C_SCALE") - call assign(buffer,c_scale, readvar(25)) + call assign(buffer,c_scale, readvar(25)) case("INTF_DEPTH") - call assign(buffer,intf_depth, readvar(26)) + call assign(buffer,intf_depth, readvar(26)) idepth=0 case("IDEPTH") - call assign(buffer,idepth, readvar(27)) + call assign(buffer,idepth, readvar(27)) case("NINTF") - call assign(buffer,nintf, readvar(28)) + call assign(buffer,nintf, readvar(28)) case("ISWAP") - call assign(buffer,iswap, readvar(29)) + call assign(buffer,iswap, readvar(29)) case("NSWAP") - call assign(buffer,nswap, readvar(30)) + call assign(buffer,nswap, readvar(30)) case("SWAP_DENSITY") - call assign(buffer,swap_den, readvar(31)) + call assign(buffer,swap_den, readvar(31)) case("SHIFTDIR") - call assign(buffer,shiftdir, readvar(32)) + call assign(buffer,shiftdir, readvar(32)) case("SWAPDIR") - call assign(buffer,swapdir, readvar(33)) + call assign(buffer,swapdir, readvar(33)) case("ICHECK") - call assign(buffer,icheck_intf, readvar(34)) + call assign(buffer,icheck_intf, readvar(34)) case("NMILLER") - call assign(buffer,nmiller, readvar(35)) + call assign(buffer,nmiller, readvar(35)) case("MAXLEN") - call assign(buffer,tolerance%maxlen, readvar(36)) + call assign(buffer,tolerance%maxlen, readvar(36)) case("MAXAREA") - call assign(buffer,tolerance%maxarea,readvar(37)) + call assign(buffer,tolerance%maxarea, readvar(37)) case("LW_LAYERED") - call assign(buffer,lw_layered, readvar(38)) + call assign(buffer,lw_layered, readvar(38)) ludef_lw_layered=.true. case("UP_LAYERED") - call assign(buffer,up_layered, readvar(39)) + call assign(buffer,up_layered, readvar(39)) ludef_up_layered=.true. case("IINTF") - call assign(buffer,iintf, readvar(40)) + call assign(buffer,iintf, readvar(40)) case("LAYER_SEP") - call assign(buffer,layer_sep, readvar(41)) + call assign(buffer,layer_sep, readvar(41)) case("LW_LAYER_SEP") - call assign(buffer,lw_layer_sep, readvar(42)) + call assign(buffer,lw_layer_sep, readvar(42)) ludef_lw_layer_sep=.true. case("UP_LAYER_SEP") - call assign(buffer,up_layer_sep, readvar(43)) + call assign(buffer,up_layer_sep, readvar(43)) ludef_up_layer_sep=.true. case("MBOND_MAXLEN") - call assign(buffer,max_bondlength, readvar(44)) + call assign(buffer,max_bondlength, readvar(44)) case("SWAP_SIGMA") - call assign(buffer,swap_sigma, readvar(45)) + call assign(buffer,swap_sigma, readvar(45)) case("SWAP_DEPTH") - call assign(buffer,swap_depth, readvar(46)) + call assign(buffer,swap_depth, readvar(46)) case("INTF_LOC") - call assign_vec(buffer,udef_intf_loc,readvar(47)) + call assign_vec(buffer,udef_intf_loc, readvar(47)) case("LMIRROR") - call assign(buffer,lswap_mirror, readvar(48)) + call assign(buffer,lswap_mirror, readvar(48)) case("LORTHO") - call assign(buffer,lortho, readvar(49)) + call assign(buffer,lortho, readvar(49)) case("LW_USE_PRICEL") - call assign(buffer,lw_use_pricel, readvar(50)) + call assign(buffer,lw_use_pricel, readvar(50)) case("UP_USE_PRICEL") - call assign(buffer,up_use_pricel, readvar(51)) + call assign(buffer,up_use_pricel, readvar(51)) case("LW_BULK_MODULUS") - call assign(buffer,lw_bulk_modulus, readvar(52)) + call assign(buffer,lw_bulk_modulus, readvar(52)) case("UP_BULK_MODULUS") - call assign(buffer,up_bulk_modulus, readvar(53)) + call assign(buffer,up_bulk_modulus, readvar(53)) case("LC_FIX") - call assign(buffer,lc_fix, readvar(54)) + call assign(buffer,lc_fix, readvar(54)) + case("LBREAK_ON_NO_TERM") + call assign(buffer,lbreak_on_no_term, readvar(55)) case default write(0,'("NOTE: unable to assign variable on line ",I0)') count end select diff --git a/src/interfaces.f90 b/src/interfaces.f90 index aa395d1..7b27bf2 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -105,11 +105,23 @@ subroutine gen_terminations(lat,bas,miller_plane,axis,directory,& !! get the terminations if(present(udef_layer_sep)) then - term = get_terminations(tmp_lat1,tmp_bas1,axis,& - lprint=.true.,layer_sep=udef_layer_sep) + term = get_terminations( & + tmp_lat1, tmp_bas1, axis, & + lprint = .true., layer_sep = udef_layer_sep, & + break_on_fail = lbreak_on_no_term & + ) else - term = get_terminations(tmp_lat1,tmp_bas1,axis,& - lprint=.true.,layer_sep=layer_sep) + term = get_terminations( & + tmp_lat1, tmp_bas1, axis, & + lprint = .true., layer_sep = layer_sep, & + break_on_fail = lbreak_on_no_term & + ) + end if + if(term%nterm .eq. 0)then + write(0,'("WARNING: & + &No terminations found for Miller plane (",3(1X,I0)," )")' & + ) miller_plane + return end if !! set thickness if provided by user @@ -634,8 +646,18 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !! Finds all terminations parallel to the surface plane !!----------------------------------------------------------------------- if(allocated(lw_term%arr)) deallocate(lw_term%arr) - lw_term=get_terminations(lw_lat,lw_bas,axis,& - lprint=lprint_terms,layer_sep=lw_layer_sep) + lw_term = get_terminations( & + lw_lat, lw_bas, axis, & + lprint = lprint_terms, layer_sep = lw_layer_sep, & + break_on_fail = lbreak_on_no_term & + ) + if(lw_term%nterm .eq. 0)then + write(0,'("WARNING: & + &No terminations found for lower material Miller plane & + &(",3(1X,I0)," )")' & + ) lw_mplane + cycle intf_loop + end if !!----------------------------------------------------------------------- @@ -687,8 +709,18 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !! Finds all up_lat unique terminations parallel to the surface plane !!----------------------------------------------------------------------- if(allocated(up_term%arr)) deallocate(up_term%arr) - up_term=get_terminations(up_lat,up_bas,axis,& - lprint=lprint_terms,layer_sep=up_layer_sep) + up_term = get_terminations( & + up_lat, up_bas, axis, & + lprint = lprint_terms, layer_sep = up_layer_sep, & + break_on_fail = lbreak_on_no_term & + ) + if(up_term%nterm .eq. 0)then + write(0,'("WARNING: & + &No terminations found for upper material Miller plane & + &(",3(1X,I0)," )")' & + ) up_mplane + cycle intf_loop + end if !!----------------------------------------------------------------------- diff --git a/src/lib/mod_sym.f90 b/src/lib/mod_sym.f90 index 9524319..9203eda 100644 --- a/src/lib/mod_sym.f90 +++ b/src/lib/mod_sym.f90 @@ -70,7 +70,7 @@ module mod_sym end type term_type type term_arr_type - integer :: nterm,axis,nstep + integer :: nterm = 0, axis, nstep double precision :: tol logical :: lmirror=.false. type(term_type), allocatable, dimension(:) :: arr @@ -1470,11 +1470,11 @@ end function basis_map !!!############################################################################# !!! finds all possible terminations along an axis !!!############################################################################# - function get_terminations(lat,bas,axis,lprint,layer_sep) result(term) + function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(term) implicit none integer :: i,j,k,is,nterm,mterm,dim,ireject integer :: itmp1,itmp2,init,min_loc - logical :: ludef_print,lunique,ltmp1,lmirror + logical :: ludef_print,lunique,ltmp1,lmirror, break_on_fail_ double precision :: dtmp1,tol,height,max_sep,c_along,centre type(sym_type) :: grp1,grp_store, grp_store_inv type(term_arr_type) :: term @@ -1493,7 +1493,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep) result(term) double precision, dimension(3,3), intent(in) :: lat double precision, optional, intent(in) :: layer_sep - logical, optional, intent(in) :: lprint + logical, optional, intent(in) :: lprint, break_on_fail integer, dimension(:), allocatable :: comparison_list @@ -1502,6 +1502,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep) result(term) !!!APPLY TRANSFORMATION MATRIX TO FIND TERMINATIONS ALONG OTHER PLANES !!! E.G. (1 0 1) + term%nterm = 0 s_end=0 grp_store%confine%l=.false. grp_store%confine%axis=axis @@ -1514,6 +1515,8 @@ function get_terminations(lat,bas,axis,lprint,layer_sep) result(term) else ludef_print = .false. end if + break_on_fail_ = .false. + if(present(break_on_fail)) break_on_fail_ = break_on_fail !!!----------------------------------------------------------------------------- @@ -1558,7 +1561,11 @@ function get_terminations(lat,bas,axis,lprint,layer_sep) result(term) end if end do if(max_sep.lt.tol)then - write(0,'("ERROR: Error in mod_sym.f90")') + if(break_on_fail_)then + write(0,'("ERROR: Error in mod_sym.f90")') + else + write(0,'("WARNING:")') + end if write(0,'(2X,"get_terminations subroutine unable to find a separation & &in the material that is greater than LAYER_SEP")') write(0,'(2X,"Writing material to ''unlayerable.vasp''")') @@ -1567,10 +1574,20 @@ function get_terminations(lat,bas,axis,lprint,layer_sep) result(term) close(13) write(0,'(2X,"We suggest reducing LAYER_SEP to less than ",F6.4)') & max_sep + write(0,'(2X,"NOTE: If LAYER_SEP < 0.7, the material likely does not & + &support the Miller plane")') write(0,'(2X,"Please inform the developers of this and give details & &of what structure caused this")') - write(0,'("Stopping...")') - stop + if(break_on_fail_)then + write( 0, & + '("To allow the program to continue, set & + &LBREAK_ON_NO_TERM = F")' & + ) + write(0,'("Stopping...")') + call exit() + else + return + end if end if bas_list(:,axis) = bas_list(:,axis) - height bas_list(:,axis) = bas_list(:,axis) - floor(bas_list(:,axis)) diff --git a/src/mod_help.f90 b/src/mod_help.f90 index 34c8091..32e048e 100644 --- a/src/mod_help.f90 +++ b/src/mod_help.f90 @@ -41,7 +41,7 @@ module mod_help ! Interface number of tags - integer, parameter :: ntags_interface=54 + integer, parameter :: ntags_interface=55 ! Interface tags integer, parameter :: inintf_tag=1 integer, parameter :: iimatch_tag=2 @@ -97,6 +97,7 @@ module mod_help integer, parameter :: ilw_bulk_modulus_tag=52 integer, parameter :: iup_bulk_modulus_tag=53 integer, parameter :: ilc_fix_tag=54 + integer, parameter :: ilbreak_on_no_term=55 @@ -584,6 +585,15 @@ function setup_interface_tags() result(tag) 'Defines the minimum size of gaps along the Miller direction that & &distinguish between separate layers (in Å) for the upper structure' + tag(ilbreak_on_no_term)%name = 'LBREAK_ON_NO_TERM' + tag(ilbreak_on_no_term)%type = 'L' + tag(ilbreak_on_no_term)%summary = 'Stop on no termination' + tag(ilbreak_on_no_term)%allowed = 'TRUE or FALSE' + tag(ilbreak_on_no_term)%default = 'TRUE' + tag(ilbreak_on_no_term)%description = & + 'Defines whether to stop the code if no terminations are found for a & + &given Miller plane' + tag(ilprint_shifts_tag)%name = 'LPRINT_SHIFTS' tag(ilprint_shifts_tag)%type = 'L' tag(ilprint_shifts_tag)%summary = 'Print shift information' From 532fda13163960d15a7c82556166d7d40ea6056c Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 24 Jan 2025 15:09:17 +0000 Subject: [PATCH 006/137] Fix typo --- src/mod_help.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mod_help.f90 b/src/mod_help.f90 index 32e048e..6456101 100644 --- a/src/mod_help.f90 +++ b/src/mod_help.f90 @@ -667,7 +667,7 @@ function setup_interface_tags() result(tag) tag(iidepth_tag)%name = 'IDEPTH' tag(iidepth_tag)%type = 'I' - tag(iidepth_tag)%summary = 'Interface depth mehtod' + tag(iidepth_tag)%summary = 'Interface depth method' tag(iidepth_tag)%allowed = '0, 1' tag(iidepth_tag)%default = '0' tag(iidepth_tag)%description = & From 8922da9bd3077cc7bfe99032be6038e049cfc52e Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 24 Jan 2025 15:19:45 +0000 Subject: [PATCH 007/137] Fix miller plane printing --- src/interfaces.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/interfaces.f90 b/src/interfaces.f90 index 7b27bf2..8a502c8 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -655,7 +655,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) write(0,'("WARNING: & &No terminations found for lower material Miller plane & &(",3(1X,I0)," )")' & - ) lw_mplane + ) SAV%tf1(ifit,3,1:3) cycle intf_loop end if @@ -718,7 +718,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) write(0,'("WARNING: & &No terminations found for upper material Miller plane & &(",3(1X,I0)," )")' & - ) up_mplane + ) SAV%tf2(ifit,3,1:3) cycle intf_loop end if From 2e94a53a73b09e96406dee030878f3e53cb83805 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 25 Jan 2025 07:31:59 +0000 Subject: [PATCH 008/137] Fix out of bounds --- src/lib/mod_sym.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/mod_sym.f90 b/src/lib/mod_sym.f90 index 9203eda..e5c0aa4 100644 --- a/src/lib/mod_sym.f90 +++ b/src/lib/mod_sym.f90 @@ -1116,7 +1116,7 @@ subroutine get_primitive_cell(lat,bas) !!----------------------------------------------------------------- !! Check for duplicates in the cell !!----------------------------------------------------------------- - do ja=1,ia-1 + do ja=1, itmp1 if(all(abs(bas%spec(is)%atom(ia,1:3)-atom_store(ja,1:3)).lt.& (/tol_sym,tol_sym,tol_sym/))) cycle atcheck end do From f794a0aef5695eff6fd28e1de319c34bc4640828 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 25 Jan 2025 07:49:50 +0000 Subject: [PATCH 009/137] Reduce array temporary warnings --- src/interfaces.f90 | 2 +- src/lib/mod_edit_geom.f90 | 2 +- src/lib/mod_sym.f90 | 2 +- src/mod_lat_compare.f90 | 4 ++-- src/mod_plane_matching.f90 | 14 +++++++------- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/interfaces.f90 b/src/interfaces.f90 index 8a502c8..60c28ad 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -1032,7 +1032,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& !!!----------------------------------------------------------------------------- !!! Determines number of swaps across the interface !!!----------------------------------------------------------------------------- - nswaps_per_cell=nint(swap_den*get_area(lat(abc(1),:),lat(abc(2),:))) + nswaps_per_cell=nint(swap_den*get_area([lat(abc(1),:)],[lat(abc(2),:)])) if(iswap.ne.0)then write(6,& '(" Generating ",I0," swaps per structure ")') nswaps_per_cell diff --git a/src/lib/mod_edit_geom.f90 b/src/lib/mod_edit_geom.f90 index 8f092e0..8b68b89 100644 --- a/src/lib/mod_edit_geom.f90 +++ b/src/lib/mod_edit_geom.f90 @@ -428,7 +428,7 @@ function get_surface_normal(lat,axis) result(normal) double precision, dimension(3,3), intent(in) :: lat order = cshift(order,3-axis) - normal = cross(lat(order(1),:),lat(order(2),:)) + normal = cross([lat(order(1),:)],[lat(order(2),:)]) component = dot_product(lat(3,:),normal) / modu(normal)**2.D0 normal = normal * component diff --git a/src/lib/mod_sym.f90 b/src/lib/mod_sym.f90 index e5c0aa4..6e7e5b3 100644 --- a/src/lib/mod_sym.f90 +++ b/src/lib/mod_sym.f90 @@ -1530,7 +1530,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te abc=cshift(abc,3-axis) c_along = abs(dot_product(lat(axis,:),& - uvec(cross(lat(abc(1),:),lat(abc(2),:))))) + uvec(cross([lat(abc(1),:)],[lat(abc(2),:)])))) tol = tol / c_along !tol = tol/modu(lat(axis,1:3)) lmirror=.false. diff --git a/src/mod_lat_compare.f90 b/src/mod_lat_compare.f90 index 3aa477b..fd70ae0 100644 --- a/src/mod_lat_compare.f90 +++ b/src/mod_lat_compare.f90 @@ -1173,10 +1173,10 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) tmpsym1=0.D0 !!! IS THIS REASONABLE TO DO IT THIS WAY? OR DO WE NEED TO CHANGE sym TO BE IN THE NEW LAT? !!! Wait, should it be instead that the cross product of the a-b plane is always consistent? - rvec1=real(cross(templat1(1,:),templat1(2,:))) + rvec1=real(cross([templat1(1,:)],[templat1(2,:)])) do i=1,grp1%nsym rmat1=real(matmul(tmpsym(i,:3,:3),templat1(:,:))) - rvec2=cross(rmat1(1,:),rmat1(2,:)) + rvec2=cross([rmat1(1,:)],[rmat1(2,:)]) if(all(abs( rvec1(:) - rvec2(:) ).lt.1.D-8).or.& all(abs( rvec1(:) + rvec2(:) ).lt.1.D-8))then nsym1=nsym1+1 diff --git a/src/mod_plane_matching.f90 b/src/mod_plane_matching.f90 index 3af7f2a..7c9c9f8 100644 --- a/src/mod_plane_matching.f90 +++ b/src/mod_plane_matching.f90 @@ -746,9 +746,9 @@ subroutine cell_match(& MAINLOOP2: do m=1,nvec1 tmpmat(2,:2) = numstore_1(m,:2) if(all(latstore_1(l,:).eq.latstore_1(m,:))) cycle MAINLOOP2 - if(get_area(latstore_1(l,:),latstore_1(m,:)).gt.tol%maxarea) cycle MAINLOOP2 - if(all(cross(latstore_1(l,:),latstore_1(m,:)).eq.0.D0)) cycle MAINLOOP2 - reference_angle = get_angle(latstore_1(l,:),latstore_1(m,:)) + if(get_area([latstore_1(l,:)],[latstore_1(m,:)]).gt.tol%maxarea) cycle MAINLOOP2 + if(all(cross([latstore_1(l,:)],[latstore_1(m,:)]).eq.0.D0)) cycle MAINLOOP2 + reference_angle = get_angle([latstore_1(l,:)],[latstore_1(m,:)]) if (abs(reference_angle) .lt. tiny) cycle MAINLOOP2 !!! CHANGE IT TO TAKE IN A 2x2 MATRIX LATER !!! @@ -791,7 +791,7 @@ subroutine cell_match(& considered_vectors(1,:) = list_1a(i,1)*lat2_veca + list_1a(i,2)*lat2_vecb considered_vectors(2,:) = list_1b(j,1)*lat2_veca + list_1b(j,2)*lat2_vecb considered_angle = & - get_angle(considered_vectors(1,:),considered_vectors(2,:)) + get_angle([considered_vectors(1,:)],[considered_vectors(2,:)]) !if(.not.is_unique_set(nint(list_1a(i,:2)),nint(list_1b(j,:2)),sym2)) & ! cycle loop110 !!-------------------------------------------------------------------------- @@ -829,12 +829,12 @@ subroutine cell_match(& tmp_tolerances(len_list_final,2) = & abs(considered_angle-reference_angle) tmp_tolerances(len_list_final,3) = abs(1.D0 - & - get_area(considered_vectors(1,:),considered_vectors(2,:))& - /get_area(latstore_1(l,:),latstore_1(m,:))) + get_area([considered_vectors(1,:)],[considered_vectors(2,:)])& + /get_area([latstore_1(l,:)],[latstore_1(m,:)])) list_angle_fits(len_list_final,5) = & tol%ang_weight * abs(considered_angle-reference_angle) + & list_1a(i,3) + list_1b(i,3) + & - tol%area_weight*get_area(latstore_1(l,:),latstore_1(m,:)) + tol%area_weight*get_area([latstore_1(l,:)],[latstore_1(m,:)]) end if end do loop110 end do loop109 From 5d066d9892a69f11dbb06d9d7a7e7d134109663d Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 25 Jan 2025 07:50:14 +0000 Subject: [PATCH 010/137] Improve error printing --- src/mod_shifting.f90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/mod_shifting.f90 b/src/mod_shifting.f90 index cbc03ca..7a1245d 100644 --- a/src/mod_shifting.f90 +++ b/src/mod_shifting.f90 @@ -1014,7 +1014,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& call err_abort_print_struc(lat,splitbas(1),"lw_term.vasp",& "",.false.) call err_abort_print_struc(lat,splitbas(2),"up_term.vasp",& - "",.false.) + "",.false.) call err_abort("ERROR: Internal error in get_shifts_DON\n& & More neighbours found in slab than in bulk.",.true.) end if @@ -1046,7 +1046,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& intf(2)%neigh(:)%pos(3) = intf(2)%neigh(:)%pos(3) - lowest_atom(2) lowest_atom(1) = minval(intf(1)%neigh(:)%pos(3),dim=1) highest_atom(2) = maxval(intf(2)%neigh(:)%pos(3),dim=1) - if(ierror.ge.1)then + if(abs(ierror).ge.1)then write(6,*) "lowest atom:",lowest_atom write(6,*) "highest atom:",highest_atom end if @@ -1109,13 +1109,25 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !!!----------------------------------------------------------------------------- !!! Determines neighbours for each grid point !!!----------------------------------------------------------------------------- - if(ierror.ge.1)then + if(abs(ierror).ge.1)then write(6,'(1X,A,3(2X,F8.4))') & "lat:",modu(lat(1,:)),modu(lat(2,:)),modu(lat(3,:)) write(6,'(1X,A,3(2X,F8.4))') "gridsize:",gridsize write(6,*) "add:",add write(6,*) "nstep:",nstep write(6,*) "ngrid:",ngrid + write(*,*) "max_sep:",max_sep + end if + + if(any(nstep(:).le.0))then + write(0,*) "ERROR: Internal error in get_shifts_DON" + write(0,*) "nstep:",nstep + write(0,*) "ngrid:",ngrid + call err_abort_print_struc(lat,splitbas(1),"lw_term.vasp",& + "",.false.) + call err_abort_print_struc(lat,splitbas(2),"up_term.vasp",& + "",.false.) + call err_abort("ERROR: Internal error in get_shifts_DON",.true.) end if !$OMP PARALLEL DO & !$OMP DEFAULT(SHARED) & From 5de486f27a9a612eac24b685057b81c64ab2fec3 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 25 Jan 2025 07:50:29 +0000 Subject: [PATCH 011/137] Fix separation size --- src/mod_shifting.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mod_shifting.f90 b/src/mod_shifting.f90 index 7a1245d..3f08654 100644 --- a/src/mod_shifting.f90 +++ b/src/mod_shifting.f90 @@ -1063,7 +1063,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& end if end if if(.not.lpresent)then - max_sep = 6.0 + max_sep = max(6.D0, max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:))) add = 0.D0 end if From 6cc09b4b2a3a74d26eb0c08560732226124989da Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 25 Jan 2025 07:53:52 +0000 Subject: [PATCH 012/137] Increase separation search height --- src/mod_shifting.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mod_shifting.f90 b/src/mod_shifting.f90 index 3f08654..836be81 100644 --- a/src/mod_shifting.f90 +++ b/src/mod_shifting.f90 @@ -1063,7 +1063,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& end if end if if(.not.lpresent)then - max_sep = max(6.D0, max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:))) + max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:)) + 6.D0 add = 0.D0 end if From 44bd18b8d7576cbccd08adb724238c509f915cee Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sun, 13 Apr 2025 06:45:25 +0100 Subject: [PATCH 013/137] Update error printing --- src/io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io.F90 b/src/io.F90 index 83abf44..b681496 100644 --- a/src/io.F90 +++ b/src/io.F90 @@ -240,7 +240,7 @@ subroutine err_abort(message,fmtd) lpresent=.false. if(present(fmtd))then if(fmtd)then - call write_fmtd(unit,trim(message)) + call write_fmtd(unit,"ERROR: "//trim(message)) lpresent=.true. end if end if From f631030c8efd3d30df68117c226f492ea91fafad Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sun, 13 Apr 2025 06:59:12 +0100 Subject: [PATCH 014/137] Fix symmetry --- src/lib/mod_sym.f90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/lib/mod_sym.f90 b/src/lib/mod_sym.f90 index 6e7e5b3..6b49dc5 100644 --- a/src/lib/mod_sym.f90 +++ b/src/lib/mod_sym.f90 @@ -26,6 +26,7 @@ module mod_sym use rw_geom, only: bas_type,geom_write use edit_geom, only: transformer,vacuumer,set_vacuum,shifter,& clone_bas,get_closest_atom,ortho_axis,reducer,primitive_lat,get_min_dist + use io, only: err_abort implicit none integer :: ierror_sym=0 integer :: s_start=1,s_end=0 @@ -976,8 +977,8 @@ subroutine mksym(grp,inlat) tsym2(:,4,4)=1.D0 count=0 samecheck: do isym=1,grp%nsym - tmat1=matmul((lat),tsym1(isym,:3,:3)) - tmat1=matmul(tmat1,(invlat)) + tmat1=matmul((invlat),tsym1(isym,:3,:3)) + tmat1=matmul(tmat1,(lat)) do i=1,3 do j=1,3 if(abs(tmat1(i,j)).lt.tol_sym) tmat1(i,j)=0.D0 @@ -992,7 +993,7 @@ subroutine mksym(grp,inlat) !!----------------------------------------------------------------------- if(.not.all(abs(tmat1-nint(tmat1)).lt.tol_sym)) cycle samecheck do jsym=1,count - if(all(tmat1.eq.tsym2(jsym,:3,:3))) cycle samecheck + if(all(abs(tmat1-tsym2(jsym,:3,:3)).lt.tol_sym)) cycle samecheck !if(all(tsym1(isym,:3,:3).eq.tsym2(jsym,:3,:3))) cycle samecheck end do count=count+1 @@ -1491,6 +1492,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te integer, intent(in) :: axis type(bas_type), intent(in) :: bas double precision, dimension(3,3), intent(in) :: lat + character(len=256) :: err_msg double precision, optional, intent(in) :: layer_sep logical, optional, intent(in) :: lprint, break_on_fail @@ -1687,12 +1689,17 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te do i=1,3 inv_mat(i,i) = -1.D0 end do + itmp1 = 0 do i=1,grp_store%nsym if(all(abs(grp_store%sym(i,:3,:3)-inv_mat).lt.tol_sym))then itmp1 = i exit end if end do + if(itmp1.eq.0)then + write(err_msg,*) "No inversion symmetry found!" + call err_abort(err_msg) + end if do i=1,grp_store%nsymop if(all(abs(savsym(i,:3,:3)-inv_mat).lt.tol_sym)) & grp_store%sym(itmp1,4,:3) = savsym(i,4,:3) From 98da3131d6195947a4fc40d4471d1813a14c3c76 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Mon, 14 Apr 2025 21:18:27 +0100 Subject: [PATCH 015/137] Add slab thickness input parameter --- src/inputs.f90 | 56 ++++++++++++++----- src/interfaces.f90 | 133 ++++++++++++++++++++++++++++----------------- src/main.f90 | 12 +++- 3 files changed, 134 insertions(+), 67 deletions(-) diff --git a/src/inputs.f90 b/src/inputs.f90 index c7a5b85..e7657bd 100644 --- a/src/inputs.f90 +++ b/src/inputs.f90 @@ -20,9 +20,10 @@ module inputs implicit none integer :: nout,clock,task,task_defect,axis,icheck_intf,iintf integer :: irestart,idepth,imatch,ishift,iswap - integer :: lw_thickness,up_thickness + integer :: lw_num_layers,up_num_layers integer :: nshift,nterm,nintf,nswap,nmiller real :: max_bondlength,swap_sigma,swap_depth + double precision :: lw_thickness, up_thickness double precision :: lw_bulk_modulus, up_bulk_modulus double precision :: c_scale,intf_depth,vacuum double precision :: layer_sep,lw_layer_sep,up_layer_sep,swap_den,tol_sym @@ -96,8 +97,10 @@ subroutine set_global_vars() up_mplane=(/0,0,0/) lw_mplane=(/0,0,0/) axis=3 - lw_thickness=3 - up_thickness=3 + lw_num_layers=0 + up_num_layers=0 + lw_thickness=-1.D0 + up_thickness=-1.D0 vacuum=14.D0 lw_surf=0 up_surf=0 @@ -382,6 +385,16 @@ subroutine set_global_vars() write(6,'(A)') repeat("#",50) + if(lw_thickness.gt.0.D0.and.lw_num_layers.gt.0) then + write(0,'(1X,A)') "WARNING: SLAB THICKNESS AND NUMBER OF LAYERS BOTH DEFINED" + write(0,'(1X,A)') " SLAB THICKNESS OVERRIDES NUMBER OF LAYERS" + lw_num_layers=0 + end if + if(up_thickness.gt.0.D0.and.up_num_layers.gt.0) then + write(0,'(1X,A)') "WARNING: SLAB THICKNESS AND NUMBER OF LAYERS BOTH DEFINED" + write(0,'(1X,A)') " SLAB THICKNESS OVERRIDES NUMBER OF LAYERS" + up_num_layers=0 + end if return end subroutine set_global_vars @@ -538,7 +551,7 @@ subroutine read_card_cell_edits(unit,count,skip) character(1024) :: buffer,tagname,store integer, intent(in) :: unit integer, intent(inout) :: count - integer, dimension(12) :: readvar + integer, dimension(13) :: readvar logical, optional, intent(in) :: skip character(len=6), dimension(4) :: & tag_list = ["axis ","loc ","val ","bounds"] @@ -568,8 +581,11 @@ subroutine read_card_cell_edits(unit,count,skip) call assign(buffer,lsurf_gen, readvar(2)) case("MILLER_PLANE") call assign_vec(buffer,lw_mplane, readvar(3)) - case("SLAB_THICKNESS") - call assign(buffer,lw_thickness, readvar(4)) + case("NUM_LAYERS", "SLAB_THICKNESS") + if(index(buffer,"SLAB_THICKNESS").ne.0)then + write(0,'(1X,A)') "WARNING: SLAB_THICKNESS is deprecated, use NUM_LAYERS instead" + end if + call assign(buffer,lw_num_layers, readvar(4)) case("SHIFT") edits%nedits=edits%nedits+1 store=buffer(index(buffer,"SHIFT")+len("SHIFT"):) @@ -624,6 +640,8 @@ subroutine read_card_cell_edits(unit,count,skip) end select case("LNORM_LAT") call assign(buffer,lnorm_lat, readvar(12)) + case("MIN_THICKNESS") + call assign(buffer,lw_thickness, readvar(13)) case default write(6,'("NOTE: unable to assign variable on line ",I0)') count end select @@ -657,7 +675,7 @@ subroutine read_card_interfaces(unit,count,skip) logical :: ludef_offset, ludef_lw_layer_sep, ludef_up_layer_sep integer, intent(in) :: unit integer, intent(inout) :: count - integer, dimension(55) :: readvar + integer, dimension(57) :: readvar logical, optional, intent(in) :: skip @@ -684,10 +702,16 @@ subroutine read_card_interfaces(unit,count,skip) case("AXIS") ludef_axis=.true. call assign(buffer,axis, readvar(2)) - case("LW_SLAB_THICKNESS") - call assign(buffer,lw_thickness, readvar(3)) - case("UP_SLAB_THICKNESS") - call assign(buffer,up_thickness, readvar(4)) + case("LW_NUM_LAYERS", "LW_SLAB_THICKNESS") + if(index(buffer,"LW_SLAB_THICKNESS").ne.0)then + write(0,'(1X,A)') "WARNING: LW_SLAB_THICKNESS is deprecated, use LW_NUM_LAYERS instead" + end if + call assign(buffer,lw_num_layers, readvar(3)) + case("UP_NUM_LAYERS", "UP_SLAB_THICKNESS") + if(index(buffer,"LW_SLAB_THICKNESS").ne.0)then + write(0,'(1X,A)') "WARNING: UP_SLAB_THICKNESS is deprecated, use LW_NUM_LAYERS instead" + end if + call assign(buffer,up_num_layers, readvar(4)) case("LW_MILLER") call assign_vec(buffer,lw_mplane, readvar(5)) case("UP_MILLER") @@ -835,7 +859,11 @@ subroutine read_card_interfaces(unit,count,skip) case("LC_FIX") call assign(buffer,lc_fix, readvar(54)) case("LBREAK_ON_NO_TERM") - call assign(buffer,lbreak_on_no_term, readvar(55)) + call assign(buffer,lbreak_on_no_term, readvar(55)) + case("LW_MIN_THICKNESS") + call assign(buffer,lw_thickness, readvar(56)) + case("UP_MIN_THICKNESS") + call assign(buffer,up_thickness, readvar(57)) case default write(0,'("NOTE: unable to assign variable on line ",I0)') count end select @@ -987,8 +1015,8 @@ subroutine write_settings(dirname) write(UNIT,'(2X,"NMILLER = ",3(I0,1X))') nmiller write(UNIT,'(2X,"LW_MILLER_PLANE = ",3(I0,1X))') lw_mplane write(UNIT,'(2X,"UP_MILLER_PLANE = ",3(I0,1X))') up_mplane - write(UNIT,'(2X,"LW_SLAB_THICKNESS = ",I0)') lw_thickness - write(UNIT,'(2X,"UP_SLAB_THICKNESS = ",I0)') up_thickness + write(UNIT,'(2X,"LW_SLAB_THICKNESS = ",I0)') lw_num_layers + write(UNIT,'(2X,"UP_SLAB_THICKNESS = ",I0)') up_num_layers if(ludef_lw_layered) write(UNIT,'(2X,"LW_LAYERED = ",L)') lw_layered if(ludef_up_layered) write(UNIT,'(2X,"UP_LAYERED = ",L)') lw_layered write(UNIT,'(2X,"NTERM = ",I0)') nterm diff --git a/src/interfaces.f90 b/src/interfaces.f90 index 60c28ad..def0f93 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -6,7 +6,7 @@ !!!############################################################################# module interface_subroutines use io - use misc_linalg, only: uvec,modu,get_area,inverse + use misc_linalg, only: uvec,modu,get_area,inverse,cross use inputs use interface_identifier, only: intf_info_type,& get_interface,get_layered_axis,gen_DON @@ -41,11 +41,11 @@ module interface_subroutines !!! Generates and prints terminations parallel to the supplied miller plane !!!############################################################################# subroutine gen_terminations(lat,bas,miller_plane,axis,directory,& - thickness,udef_layer_sep) + num_layers,thickness,udef_layer_sep) implicit none integer :: unit integer :: itmp1,iterm,term_start,term_end,iterm_step - integer :: old_natom,ncells,thickness_val,ntrans + integer :: old_natom,ncells,num_layers_,ntrans double precision :: height character(len=1024) :: dirname,filename,pwd logical :: ludef_surf,lignore @@ -58,11 +58,12 @@ subroutine gen_terminations(lat,bas,miller_plane,axis,directory,& double precision, allocatable, dimension(:,:) :: trans integer, intent(in) :: axis + double precision, intent(in) :: thickness type(bas_type), intent(in) :: bas integer, dimension(3), intent(in) :: miller_plane double precision, dimension(3,3), intent(in) :: lat - integer, optional, intent(in) :: thickness + integer, optional, intent(in) :: num_layers double precision, optional, intent(in) :: udef_layer_sep character(len=*), optional, intent(in) :: directory @@ -125,10 +126,10 @@ subroutine gen_terminations(lat,bas,miller_plane,axis,directory,& end if !! set thickness if provided by user - if(present(thickness))then - thickness_val = thickness + if(present(num_layers))then + num_layers_ = num_layers else - thickness_val = 1 + num_layers_ = 1 end if !! make directory and change to that directory @@ -147,7 +148,7 @@ subroutine gen_terminations(lat,bas,miller_plane,axis,directory,& !! determine required extension and perform that call set_slab_height(tmp_lat1,tmp_bas1,bas_map,term,lw_surf,old_natom,& - height,thickness_val,ncells,& + height,num_layers_, thickness, ncells,& term_start,term_end,iterm_step,ludef_surf,& dirname,"lw",lignore) @@ -169,7 +170,7 @@ subroutine gen_terminations(lat,bas,miller_plane,axis,directory,& if(allocated(t1bas_map)) deallocate(t1bas_map) allocate(t1bas_map,source=bas_map) call prepare_slab(tmp_lat2,tmp_bas2,bas_map,term,iterm,& - thickness_val,ncells,height,ludef_surf,lw_surf(2),& + num_layers_,ncells, thickness, height,ludef_surf,lw_surf(2),& "lw",lignore,lortho,vacuum) @@ -305,6 +306,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) integer, allocatable, dimension(:,:,:) :: lw_map,t1lw_map,t2lw_map integer, allocatable, dimension(:,:,:) :: up_map,t1up_map,t2up_map double precision, allocatable, dimension(:,:) :: trans + character(len=256) :: err_msg !!!----------------------------------------------------------------------------- @@ -676,7 +678,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !! Defines height of lower slab from user-defined values !!----------------------------------------------------------------------- call set_slab_height(lw_lat,lw_bas,t1lw_map,lw_term,lw_surf, old_natom,& - lw_height,lw_thickness,lw_ncells,& + lw_height,lw_num_layers, lw_thickness,lw_ncells,& lw_term_start,lw_term_end,iterm_step,ludef_lw_surf,& intf_dir,"lw",lcycle) if(lcycle) cycle intf_loop @@ -739,7 +741,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !! Defines height of upper slab from user-defined values !!----------------------------------------------------------------------- call set_slab_height(up_lat,up_bas,t1up_map,up_term,up_surf,old_natom,& - up_height,up_thickness,up_ncells,& + up_height,up_num_layers, up_thickness, up_ncells,& up_term_start,up_term_end,jterm_step,ludef_up_surf,& intf_dir,"up",lcycle) if(lcycle) cycle intf_loop @@ -763,7 +765,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !! Shifts lower material to specified termination !!-------------------------------------------------------------------- call prepare_slab(tlw_lat,tlw_bas,t2lw_map,lw_term,iterm,& - lw_thickness,lw_ncells,lw_height,ludef_lw_surf,lw_surf(2),& + lw_num_layers,lw_ncells, lw_thickness,lw_height,ludef_lw_surf,lw_surf(2),& "lw",lcycle) if(lcycle) cycle lw_term_loop @@ -776,7 +778,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) if(allocated(t2up_map)) deallocate(t2up_map) allocate(t2up_map,source=t1up_map) call prepare_slab(tup_lat,tup_bas,t2up_map,up_term,jterm,& - up_thickness,up_ncells,up_height,ludef_up_surf,up_surf(2),& + up_num_layers,up_ncells, up_thickness, up_height,ludef_up_surf,up_surf(2),& "up",lcycle) if(lcycle) cycle up_term_loop @@ -1195,12 +1197,12 @@ end function get_term_list !!! sets the maximum height of the slab !!!############################################################################# subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& - height, thickness, ncells,& + height, num_layers, thickness, ncells,& term_start, term_end, term_step, ludef_surf,& intf_dir, lwup_in, lcycle) implicit none integer :: i,itmp1 - double precision :: dtmp1 + double precision :: dtmp1, slab_thickness, largest_sep character(2) :: lwup character(5) :: lowerupper character(1024) :: msg @@ -1208,10 +1210,11 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& double precision, allocatable, dimension(:) :: vtmp1 type(term_list_type), allocatable, dimension(:) :: list - integer, intent(in) :: thickness, old_natom + integer, intent(in) :: num_layers, old_natom integer, intent(inout) :: term_start, term_end, ncells integer, intent(out) :: term_step - double precision, intent(inout) :: height + double precision, intent(in) :: thickness + double precision, intent(out) :: height character(2), intent(in) :: lwup_in character(1024), intent(in) :: intf_dir logical, intent(inout) :: ludef_surf @@ -1262,7 +1265,7 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& !! determines the maximum number of cells required allocate(vtmp1(size(list))) height = term%arr(term_start)%hmin - do i=thickness,2,-1 + do i=num_layers,2,-1 vtmp1 = list(:)%loc - height vtmp1 = vtmp1 - ceiling( vtmp1 - 1.D0 ) itmp1 = minloc( vtmp1(:), dim=1,& @@ -1280,21 +1283,8 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& mask=& vtmp1(:).ge.-1.D-5.and.& list(:)%term.eq.surf(2)) - !!write(0,*) "temp",itmp1 - !!write(0,*) "temp",list(:)%loc - !!write(0,*) "SURFACES",surf - !write(0,*) "look",term%arr(term_start)%hmin, term_start - !write(0,*) vtmp1(itmp1),itmp1 - !write(0,*) list(:)%loc - !write(0,*) list(:)%loc-height - !write(0,*) vtmp1 - !write(0,*) list(:)%term - !write(0,*) "height check1", height height = height + vtmp1(itmp1) - term%arr(term_start)%hmin - !write(0,*) "height check2", height - !write(0,*) "mirror?",term%lmirror - !! if there is no mirror, we need to remove extra layers in the cell !if(.not.term%lmirror)then ! get thickness of top/surface layer dtmp1 = term%arr(surf(2))%hmax - term%arr(surf(2))%hmin @@ -1302,12 +1292,9 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& height = height + dtmp1 !(1.D0 - dtmp1) !end if - !write(0,*) "HEIGHT", height ncells = ceiling(height) height = height/dble(ncells) end if - !write(0,*) "ncells",ncells - !write(0,*) "height",height !!----------------------------------------------------------------------- @@ -1323,17 +1310,37 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& !!----------------------------------------------------------------------- !! Extend slab to user-defined thickness !!----------------------------------------------------------------------- - !write(0,*) "HERE",term%nstep,thickness - !write(0,*) thickness-1, (thickness-1)/term%nstep,int((thickness-1)/term%nstep)+1 - if(.not.ludef_surf) ncells = int((thickness-1)/term%nstep)+1 - !write(0,*) ncells - tfmat(:,:)=0.D0 - tfmat(1,1)=1.D0 - tfmat(2,2)=1.D0 - tfmat(3,3)=ncells - !write(0,*) "test0",ncells + if(.not.ludef_surf) ncells = int((num_layers-1)/term%nstep)+1 + !! convert thickness, in angstroms to number of cells + if(thickness.gt.0.D0)then + select case(term%axis) + case(1) + slab_thickness = dot_product(uvec(cross(lat(2,:),lat(3,:))), lat(1,:)) + case(2) + slab_thickness = dot_product(uvec(cross(lat(1,:),lat(3,:))), lat(2,:)) + case(3) + slab_thickness = dot_product(uvec(cross(lat(1,:),lat(2,:))), lat(3,:)) + end select + ! get the largest separation between two terminations + largest_sep = abs( term%arr(1)%hmin - & + term%arr(term%nterm)%ladder(term%nstep) - & + term%arr(term%nterm)%hmax + 1.D0 ) + ! if hmax .gt. hmin, hmax = hmax - 1 + if(largest_sep.lt.0.D0) largest_sep = 1.D0 + largest_sep + do i = 2, term%nterm, 1 + dtmp1 = abs(term%arr(i)%hmin - term%arr(i-1)%hmax) + if(dtmp1.gt.largest_sep) largest_sep = dtmp1 + end do + ! thickness = ( ncells - 1 ) * slab_thickness + ( 1 - largest_sep ) * slab_thickness + ! ncells = ceiling( thickness / slab_thickness - ( 1 - largest_sep ) + 1 ) + ncells = ceiling( thickness / slab_thickness - (1.E0 - largest_sep - 2.E0 * term%tol) ) + 1 + height = thickness/dble(ncells) + end if + tfmat(:,:) = 0.D0 + tfmat(1,1) = 1.D0 + tfmat(2,2) = 1.D0 + tfmat(3,3) = ncells call transformer(lat,bas,tfmat,map) - !write(0,*) "test1" if(mod(real(old_natom*ncells)/real(bas%natom),1.0).gt.1.D-5)then write(0,'(1X,"ERROR: Internal error in interfaces subroutine")') write(0,'(2X,"gldfnd subroutine did not reproduce a sensible & @@ -1359,6 +1366,7 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& term%arr(:)%hmin = term%arr(:)%hmin/dble(ncells) term%arr(:)%hmax = term%arr(:)%hmax/dble(ncells) term%tol = term%tol/dble(ncells) + end subroutine set_slab_height @@ -1404,22 +1412,23 @@ end subroutine set_layer_tol !!!############################################################################# !!! Supply a supercell that can be cut down to the size of the slab ... !!! ... i.e. the input structure must be larger or equal to the desired output - subroutine prepare_slab(lat, bas, map, term, iterm, thickness, ncells, & + subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thickness, & height, ludef_surf, udef_top_iterm, lwup_in, lcycle, & ludef_ortho, udef_vacuum) implicit none integer :: j, j_start, istep, natom_check - double precision :: vacuum, dtmp1 + double precision :: vacuum, dtmp1, slab_thickness, shift_val character(2) :: lwup character(5) :: lowerupper character(1024) :: msg logical :: lortho integer, dimension(3) :: abc=(/1,2,3/) + double precision, dimension(3) :: surface_normal_vec double precision, dimension(3,3) :: tfmat integer, allocatable, dimension(:) :: iterm_list - integer, intent(in) :: iterm, udef_top_iterm, thickness, ncells - double precision, intent(in) :: height + integer, intent(in) :: iterm, udef_top_iterm, num_layers, ncells + double precision, intent(in) :: height, thickness character(2), intent(in) :: lwup_in logical, intent(in) :: ludef_surf logical, intent(out) :: lcycle @@ -1440,7 +1449,30 @@ subroutine prepare_slab(lat, bas, map, term, iterm, thickness, ncells, & lcycle = .false. dtmp1=0.D0 tfmat=0.D0 - istep = thickness - (ncells-1)*term%nstep + select case(term%axis) + case(1) + surface_normal_vec = uvec(cross(lat(2,:),lat(3,:))) + slab_thickness = abs( dot_product(surface_normal_vec, lat(1,:)) ) + case(2) + surface_normal_vec = uvec(cross(lat(1,:),lat(3,:))) + slab_thickness = abs( dot_product(surface_normal_vec, lat(2,:)) ) + case(3) + surface_normal_vec = uvec(cross(lat(1,:),lat(2,:))) + slab_thickness = abs( dot_product(surface_normal_vec, lat(3,:)) ) + end select + if(thickness.gt.0.D0)then + dtmp1 = slab_thickness / ncells * ( ncells - 1 ) + istep = term%nstep + do j = 1, term%nstep + dtmp1 = dtmp1 + term%arr(iterm)%ladder(j) * slab_thickness / real(ncells) + if(dtmp1.ge.thickness)then + istep = j + exit + end if + end do + else + istep = num_layers - (ncells-1)*term%nstep + end if natom_check = bas%natom if(present(ludef_ortho))then @@ -1514,8 +1546,9 @@ subroutine prepare_slab(lat, bas, map, term, iterm, thickness, ncells, & !! ... i.e. account for the tolerance that has been added to layer ... !! ... hmin and hmax !!-------------------------------------------------------------------- + shift_val = term%tol * slab_thickness / modu(lat(term%axis,:)) call transformer(lat,bas,tfmat,map) - call shifter(bas,term%axis,-term%tol/tfmat(term%axis,term%axis),.true.) + call shifter(bas,term%axis,-shift_val/tfmat(term%axis,term%axis),.true.) !!-------------------------------------------------------------------- diff --git a/src/main.f90 b/src/main.f90 index 1712ae8..efb1ae4 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -32,7 +32,7 @@ program artemis if(lsurf_gen)then write(0,'(1X,"Finding terminations for lower material.")') call gen_terminations(struc1_lat,struc1_bas,lw_mplane,axis,& - thickness=lw_thickness) + num_layers=lw_num_layers, thickness=lw_thickness) write(0,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop end if @@ -58,7 +58,10 @@ program artemis else write(6,'(1X,"Finding terminations for lower material.")') call gen_terminations(struc1_lat,struc1_bas,lw_mplane,axis,& - directory="DLW_TERMS",thickness=lw_thickness,udef_layer_sep=lw_layer_sep) + directory="DLW_TERMS", & + num_layers=lw_num_layers, & + thickness=lw_thickness, & + udef_layer_sep=lw_layer_sep) end if if(all(up_mplane.eq.0))then write(6,'("No Miller plane defined for upper material.")') @@ -66,7 +69,10 @@ program artemis else write(6,'(1X,"Finding terminations for upper material.")') call gen_terminations(struc2_lat,struc2_bas,up_mplane,axis,& - directory="DUP_TERMS",thickness=up_thickness,udef_layer_sep=up_layer_sep) + directory="DUP_TERMS", & + num_layers = up_num_layers, & + thickness = up_thickness, & + udef_layer_sep=up_layer_sep) end if write(6,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop From 3a5e4f275c2a71303fafccc1d9482c62da250c83 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 15 Apr 2025 06:37:21 +0100 Subject: [PATCH 016/137] Remove commented code --- src/lib/mod_sym.f90 | 16 +--------------- 1 file changed, 1 insertion(+), 15 deletions(-) diff --git a/src/lib/mod_sym.f90 b/src/lib/mod_sym.f90 index 6b49dc5..6e6d682 100644 --- a/src/lib/mod_sym.f90 +++ b/src/lib/mod_sym.f90 @@ -998,7 +998,6 @@ subroutine mksym(grp,inlat) end do count=count+1 tsym2(count,:3,:3)=tmat1 - !tsym2(count,:4,:4)=tsym1(isym,:4,:4) end do samecheck grp%nsym=count deallocate(tsym1) @@ -1534,7 +1533,6 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te c_along = abs(dot_product(lat(axis,:),& uvec(cross([lat(abc(1),:)],[lat(abc(2),:)])))) tol = tol / c_along - !tol = tol/modu(lat(axis,1:3)) lmirror=.false. @@ -1668,13 +1666,6 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te grp_store%confine%laxis(axis) = .true. call sym_setup(grp_store,lat,predefined=.false.,new_start=.true.) - !!WRITE OUT THE STRUCTURES HERE AND COMPARE - !do i=1,grp_store%nsym - ! write(0,*) i - ! write(0,'(4(2X,F6.2))') grp_store%sym(i,:4,:3) - ! write(0,*) det(grp_store%sym(i,:3,:3)) - ! write(0,*) - !end do !!-------------------------------------------------------------------------- @@ -1704,12 +1695,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te if(all(abs(savsym(i,:3,:3)-inv_mat).lt.tol_sym)) & grp_store%sym(itmp1,4,:3) = savsym(i,4,:3) end do - !do i=1,grp_store%nsymop - ! write(0,*) i - ! write(0,'(4(2X,F9.4))') grp_store%sym(i,:4,:3) - ! write(0,*) det(grp_store%sym(i,:3,:3)) - ! write(0,*) - !end do + !!-------------------------------------------------------------------------- From 4d6507fd0eddd670947f5865e0380669c5211f37 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 15 Apr 2025 13:56:20 +0100 Subject: [PATCH 017/137] Handle terminations --- src/interfaces.f90 | 127 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 103 insertions(+), 24 deletions(-) diff --git a/src/interfaces.f90 b/src/interfaces.f90 index def0f93..e73d05b 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -1225,6 +1225,10 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& double precision, dimension(3,3), intent(inout) :: lat integer, allocatable, dimension(:,:,:), intent(inout) :: map + + integer :: icell, istep, iterm + double precision :: layer_thickness + logical :: success !!-------------------------------------------------------------------- @@ -1322,19 +1326,62 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& slab_thickness = dot_product(uvec(cross(lat(1,:),lat(2,:))), lat(3,:)) end select ! get the largest separation between two terminations - largest_sep = abs( term%arr(1)%hmin - & - term%arr(term%nterm)%ladder(term%nstep) - & - term%arr(term%nterm)%hmax + 1.D0 ) - ! if hmax .gt. hmin, hmax = hmax - 1 - if(largest_sep.lt.0.D0) largest_sep = 1.D0 + largest_sep - do i = 2, term%nterm, 1 - dtmp1 = abs(term%arr(i)%hmin - term%arr(i-1)%hmax) - if(dtmp1.gt.largest_sep) largest_sep = dtmp1 - end do - ! thickness = ( ncells - 1 ) * slab_thickness + ( 1 - largest_sep ) * slab_thickness - ! ncells = ceiling( thickness / slab_thickness - ( 1 - largest_sep ) + 1 ) - ncells = ceiling( thickness / slab_thickness - (1.E0 - largest_sep - 2.E0 * term%tol) ) + 1 - height = thickness/dble(ncells) + if(ludef_surf)then + + height = 0.E0 + largest_sep = abs( term%arr(surf(1))%hmin - & + term%arr(surf(2))%ladder(term%nstep) - & + term%arr(surf(2))%hmax + 1.D0 ) + if(largest_sep.lt.0.D0) largest_sep = 1.D0 + largest_sep + ! check for all terminations that a certain step is sufficiently large to reproduce thickness + cell_loop1: do icell = 0, ceiling(thickness/slab_thickness), 1 + layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol + success = .false. + step_loop1: do istep = 1, term%nstep, 1 + if(surf(2).lt.surf(1))then + if(istep.eq.term%nstep)then + layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol + ( 1.E0 + term%arr(surf(2))%ladder(1) - term%arr(surf(1))%ladder(term%nstep) ) + else + layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol + ( term%arr(surf(2))%ladder(istep+1) - term%arr(surf(1))%ladder(istep) ) + end if + end if + dtmp1 = ( icell + layer_thickness + term%arr(surf(2))%ladder(istep) - term%arr(surf(1))%ladder(1) ) * slab_thickness + if(dtmp1.ge.thickness)then + success = .true. + height = dtmp1 + 2.E0 * term%tol * slab_thickness + exit step_loop1 + end if + end do step_loop1 + if(.not.success) cycle cell_loop1 + ncells = icell + 1 + exit cell_loop1 + end do cell_loop1 + + else + largest_sep = abs( term%arr(1)%hmin - & + term%arr(1)%ladder(term%nstep) - & + term%arr(1)%hmax + 1.D0 ) + if(largest_sep.lt.0.D0) largest_sep = 1.D0 + largest_sep + ! check for all terminations that a certain step is sufficiently large to reproduce thickness + cell_loop2: do icell = 0, ceiling(thickness/slab_thickness), 1 + term_loop: do iterm = 1, term%nterm, 1 + layer_thickness = term%arr(iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + success = .false. + step_loop: do istep = 1, term%nstep, 1 + dtmp1 = ( icell + layer_thickness + term%arr(iterm)%ladder(istep) ) * slab_thickness + if(dtmp1.ge.thickness)then + success = .true. + exit step_loop + end if + end do step_loop + if(.not.success) cycle cell_loop2 + end do term_loop + ncells = icell + 1 + exit cell_loop2 + end do cell_loop2 + + end if + height = height/dble(ncells * slab_thickness) end if tfmat(:,:) = 0.D0 tfmat(1,1) = 1.D0 @@ -1440,6 +1487,9 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes logical, optional, intent(in) :: ludef_ortho double precision, optional, intent(in) :: udef_vacuum + integer :: icell, num_cells, jterm + double precision :: layer_thickness + !!-------------------------------------------------------------------- !! Initialise variables !!-------------------------------------------------------------------- @@ -1462,16 +1512,35 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes end select if(thickness.gt.0.D0)then dtmp1 = slab_thickness / ncells * ( ncells - 1 ) - istep = term%nstep - do j = 1, term%nstep - dtmp1 = dtmp1 + term%arr(iterm)%ladder(j) * slab_thickness / real(ncells) - if(dtmp1.ge.thickness)then - istep = j - exit - end if - end do + istep = term%nstep + num_cells = ncells - 1 + if(ludef_surf)then + jterm = udef_top_iterm + else + jterm = iterm + end if + cell_loop: do icell = 0, ncells, 1 + layer_thickness = term%arr(udef_top_iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + step_loop: do j = 1, term%nstep + if(udef_top_iterm.lt.iterm)then + if(j.eq.term%nstep)then + layer_thickness = term%arr(udef_top_iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + ( 1.E0 + term%arr(udef_top_iterm)%ladder(1) - term%arr(iterm)%ladder(term%nstep) ) + else + layer_thickness = term%arr(udef_top_iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + ( term%arr(udef_top_iterm)%ladder(j+1) - term%arr(iterm)%ladder(j) ) + end if + end if + dtmp1 = ( icell / real(ncells) + layer_thickness ) * slab_thickness + & + term%arr(udef_top_iterm)%ladder(j) * slab_thickness / real(ncells) + if(dtmp1.ge.thickness)then + istep = j + num_cells = icell + exit cell_loop + end if + end do step_loop + end do cell_loop else istep = num_layers - (ncells-1)*term%nstep + num_cells = ncells - 1 end if natom_check = bas%natom @@ -1523,12 +1592,12 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes tfmat(j,j)=1.D0 if(j.eq.term%axis)then if(ludef_surf)then - tfmat(j,j) = height !+ term%tol*2.D0 + tfmat(j,j) = height else!if(term%lmirror)then if(istep.ne.0)then - dtmp1 = (ncells-1) + term%arr(iterm)%ladder(istep) + dtmp1 = num_cells + term%arr(iterm)%ladder(istep) dtmp1 = dtmp1/(ncells) - tfmat(j,j) = dtmp1 !+ term%tol*2.D0 + tfmat(j,j) = dtmp1 tfmat(j,j) = tfmat(j,j) + & (term%arr(iterm)%hmax - term%arr(iterm)%hmin) end if @@ -1541,6 +1610,16 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes end do + !!-------------------------------------------------------------------- + !! Check number of atoms is expected + !!-------------------------------------------------------------------- + if(num_cells.ne.ncells-1)then + do icell = num_cells + 2, ncells, 1 + natom_check = natom_check - nint( bas%natom / real(ncells) ) + end do + end if + + !!-------------------------------------------------------------------- !! Apply transformation and shift cell back to bottom of layer !! ... i.e. account for the tolerance that has been added to layer ... From f0d6f12c1fc4de59e6d9622b78d25bedea611b3c Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 15 Apr 2025 14:22:46 +0100 Subject: [PATCH 018/137] Improve formatting --- src/interfaces.f90 | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/src/interfaces.f90 b/src/interfaces.f90 index e73d05b..b408b28 100644 --- a/src/interfaces.f90 +++ b/src/interfaces.f90 @@ -1340,12 +1340,27 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& step_loop1: do istep = 1, term%nstep, 1 if(surf(2).lt.surf(1))then if(istep.eq.term%nstep)then - layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol + ( 1.E0 + term%arr(surf(2))%ladder(1) - term%arr(surf(1))%ladder(term%nstep) ) + layer_thickness = & + term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - & + 2.E0 * term%tol + ( & + 1.E0 + term%arr(surf(2))%ladder(1) - & + term%arr(surf(1))%ladder(term%nstep) & + ) else - layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol + ( term%arr(surf(2))%ladder(istep+1) - term%arr(surf(1))%ladder(istep) ) + layer_thickness = & + term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - & + 2.E0 * term%tol + ( & + term%arr(surf(2))%ladder(istep+1) - & + term%arr(surf(1))%ladder(istep) & + ) end if end if - dtmp1 = ( icell + layer_thickness + term%arr(surf(2))%ladder(istep) - term%arr(surf(1))%ladder(1) ) * slab_thickness + dtmp1 = & + ( & + icell + layer_thickness + & + term%arr(surf(2))%ladder(istep) - & + term%arr(surf(1))%ladder(1) & + ) * slab_thickness if(dtmp1.ge.thickness)then success = .true. height = dtmp1 + 2.E0 * term%tol * slab_thickness @@ -1415,7 +1430,6 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& term%tol = term%tol/dble(ncells) - end subroutine set_slab_height !!!############################################################################# From 8b8310de05c3b28d7f9b02fe2a76ef248bc06bd2 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 15 Apr 2025 15:30:49 +0100 Subject: [PATCH 019/137] Improve help --- src/inputs.f90 | 12 ++-- src/io.F90 | 33 +++++++++- src/mod_help.f90 | 167 +++++++++++++++++++++++++++++++++++++---------- 3 files changed, 170 insertions(+), 42 deletions(-) diff --git a/src/inputs.f90 b/src/inputs.f90 index e7657bd..c4a4fc6 100644 --- a/src/inputs.f90 +++ b/src/inputs.f90 @@ -385,15 +385,19 @@ subroutine set_global_vars() write(6,'(A)') repeat("#",50) - if(lw_thickness.gt.0.D0.and.lw_num_layers.gt.0) then + if(lw_thickness.gt.0.D0.and.lw_num_layers.gt.0)then write(0,'(1X,A)') "WARNING: SLAB THICKNESS AND NUMBER OF LAYERS BOTH DEFINED" write(0,'(1X,A)') " SLAB THICKNESS OVERRIDES NUMBER OF LAYERS" lw_num_layers=0 + elseif(lw_thickness.le.0.D0.and.lw_num_layers.le.0)then + lw_thickness = 10.D0 end if - if(up_thickness.gt.0.D0.and.up_num_layers.gt.0) then + if(up_thickness.gt.0.D0.and.up_num_layers.gt.0)then write(0,'(1X,A)') "WARNING: SLAB THICKNESS AND NUMBER OF LAYERS BOTH DEFINED" write(0,'(1X,A)') " SLAB THICKNESS OVERRIDES NUMBER OF LAYERS" up_num_layers=0 + elseif(up_thickness.le.0.D0.and.up_num_layers.le.0)then + up_thickness = 10.D0 end if return @@ -639,9 +643,9 @@ subroutine read_card_cell_edits(unit,count,skip) read(store,*) lw_surf end select case("LNORM_LAT") - call assign(buffer,lnorm_lat, readvar(12)) + call assign(buffer,lnorm_lat, readvar(12)) case("MIN_THICKNESS") - call assign(buffer,lw_thickness, readvar(13)) + call assign(buffer,lw_thickness, readvar(13)) case default write(6,'("NOTE: unable to assign variable on line ",I0)') count end select diff --git a/src/io.F90 b/src/io.F90 index b681496..0caf584 100644 --- a/src/io.F90 +++ b/src/io.F90 @@ -34,7 +34,11 @@ module io character(40) :: summary character(60) :: allowed character(60) :: default - character(1024) :: description + character(300) :: description + logical :: is_deprecated = .false. + logical :: to_be_deprecated = .false. + character(25) :: deprecated_name = '' + character(20) :: deprecated_version end type tag_type public :: write_fmtd @@ -314,8 +318,18 @@ subroutine io_print_help(unit, helpword, tags, search) if(index(tags(i)%name,checkword).ne.0)then found=.true. - write(unit,'(A,T33,A)') & - trim(tags(i)%name),trim(tags(i)%summary) + if(tags(i)%to_be_deprecated)then + write(unit,'(A,T33,A)') & + trim(tags(i)%name),& + 'To be deprecated ('//trim(tags(i)%deprecated_version)//')' + elseif(tags(i)%is_deprecated)then + write(unit,'(A,T33,A)') & + trim(tags(i)%name),& + 'Deprecated ('//trim(tags(i)%deprecated_version)//')' + else + write(unit,'(A,T33,A)') & + trim(tags(i)%name),trim(tags(i)%summary) + end if end if end do tagloop1 @@ -355,6 +369,19 @@ subroutine io_print_help(unit, helpword, tags, search) write(unit,*) write(unit,fmt) trim(title) write(unit,*) + if(tags(i)%is_deprecated)then + write(unit,'("DEPRECATED AS OF ",A)') & + trim(tags(i)%deprecated_version) + elseif(tags(i)%to_be_deprecated)then + write(unit,'("TO BE DEPRECATED AS OF ",A)') & + trim(tags(i)%deprecated_version) + end if + if(trim(tags(i)%deprecated_name).ne.'')then + write(unit,'("New tag name: ",A)') trim(tags(i)%deprecated_name) + end if + if(tags(i)%is_deprecated.or.tags(i)%to_be_deprecated)then + write(unit,*) + end if select case(tags(i)%type) case('I'); type = 'Integer' diff --git a/src/mod_help.f90 b/src/mod_help.f90 index 6456101..c7d98d7 100644 --- a/src/mod_help.f90 +++ b/src/mod_help.f90 @@ -24,12 +24,12 @@ module mod_help ! Cell_edits number of tags - integer, parameter :: ntags_cell_edits=12 + integer, parameter :: ntags_cell_edits=13 ! Cell_edits tags integer, parameter :: iout_file_tag=1 integer, parameter :: ilsurf_gen_CE_tag=2 integer, parameter :: imiller_tag=3 - integer, parameter :: islab_thick_tag=4 + integer, parameter :: inum_layers_tag=4 integer, parameter :: ishift_tag=5 integer, parameter :: ishift_region_tag=6 integer, parameter :: ivacuum_tag=7 @@ -38,10 +38,15 @@ module mod_help integer, parameter :: ilortho_CE_tag=10 integer, parameter :: isurf_tag=11 integer, parameter :: ilnorm_lat_tag=12 + integer, parameter :: imin_thick_tag=13 + + integer, parameter :: ntags_depr_cell_edits=1 + ! Cell_edits deprecated tags + integer, parameter :: islab_thick_tag=1 ! Interface number of tags - integer, parameter :: ntags_interface=55 + integer, parameter :: ntags_interface=57 ! Interface tags integer, parameter :: inintf_tag=1 integer, parameter :: iimatch_tag=2 @@ -50,8 +55,8 @@ module mod_help integer, parameter :: iaxis_tag=5 integer, parameter :: ilw_miller_tag=6 integer, parameter :: iup_miller_tag=7 - integer, parameter :: ilw_thick_tag=8 - integer, parameter :: iup_thick_tag=9 + integer, parameter :: ilw_num_layers_tag=8 + integer, parameter :: iup_num_layers_tag=9 integer, parameter :: ishiftdir_tag=10 integer, parameter :: iishift_tag=11 integer, parameter :: inshift_tag=12 @@ -97,7 +102,14 @@ module mod_help integer, parameter :: ilw_bulk_modulus_tag=52 integer, parameter :: iup_bulk_modulus_tag=53 integer, parameter :: ilc_fix_tag=54 - integer, parameter :: ilbreak_on_no_term=55 + integer, parameter :: ilbreak_on_no_term_tag=55 + integer, parameter :: ilw_min_thick_tag=56 + integer, parameter :: iup_min_thick_tag=57 + + integer, parameter :: ntags_depr_interface=2 + ! Cell_edits deprecated tags + integer, parameter :: ilw_slab_thick_tag=1 + integer, parameter :: iup_slab_thick_tag=2 @@ -307,14 +319,24 @@ function setup_cell_edits_tags() result(tag) 'Prints the surface terminations of a Miller plane into DTERMINATIONS & &directory' - tag(islab_thick_tag)%name = 'SLAB_THICKNESS' - tag(islab_thick_tag)%type = 'I' - tag(islab_thick_tag)%summary = 'Thickness of slab' - tag(islab_thick_tag)%allowed = 'Any positive integer number' - tag(islab_thick_tag)%default = '3' - tag(islab_thick_tag)%description = & + tag(inum_layers_tag)%name = 'NUM_LAYERS' + tag(inum_layers_tag)%type = 'I' + tag(inum_layers_tag)%summary = 'Number of layers of crystal' + tag(inum_layers_tag)%allowed = 'Any positive integer number' + tag(inum_layers_tag)%default = '(empty)' + tag(inum_layers_tag)%description = & 'Defines the number of primitive layers to use for the slab' + tag(imin_thick_tag)%name = 'MIN_THICKNESS' + tag(imin_thick_tag)%type = 'R' + tag(imin_thick_tag)%summary = 'Minimum thickness of slab' + tag(imin_thick_tag)%allowed = 'Any positive real number' + tag(imin_thick_tag)%default = '10.0' + tag(imin_thick_tag)%description = & + 'Defines the minimum thickness of the lower crystal (in Å).\n& + &The generated slab will be the smallest possible thickness equal to & + &or greater than this value.' + tag(imiller_tag)%name = 'MILLER_PLANE' tag(imiller_tag)%type = 'U' tag(imiller_tag)%summary = 'Crystal Miller plane' @@ -522,22 +544,42 @@ function setup_interface_tags() result(tag) tag(inmiller_tag)%description = & 'Defines the number of Miller planes to search over for each crystal.' - tag(ilw_thick_tag)%name = 'LW_SLAB_THICKNESS' - tag(ilw_thick_tag)%type = 'I' - tag(ilw_thick_tag)%summary = 'Thickness of lower crystal' - tag(ilw_thick_tag)%allowed = 'Any positive integer number' - tag(ilw_thick_tag)%default = '3' - tag(ilw_thick_tag)%description = & + tag(ilw_num_layers_tag)%name = 'LW_NUM_LAYERS' + tag(ilw_num_layers_tag)%type = 'I' + tag(ilw_num_layers_tag)%summary = 'Number of layers of lower crystal' + tag(ilw_num_layers_tag)%allowed = 'Any positive integer number' + tag(ilw_num_layers_tag)%default = '(empty)' + tag(ilw_num_layers_tag)%description = & 'Defines the number of primitive layers to use for the lower crystal' - tag(iup_thick_tag)%name = 'UP_SLAB_THICKNESS' - tag(iup_thick_tag)%type = 'I' - tag(iup_thick_tag)%summary = 'Thickness of upper crystal' - tag(iup_thick_tag)%allowed = 'Any positive integer number' - tag(iup_thick_tag)%default = '3' - tag(iup_thick_tag)%description = & + tag(iup_num_layers_tag)%name = 'UP_NUM_LAYERS' + tag(iup_num_layers_tag)%type = 'I' + tag(iup_num_layers_tag)%summary = 'Number of layers of upper crystal' + tag(iup_num_layers_tag)%allowed = 'Any positive integer number' + tag(iup_num_layers_tag)%default = '(empty)' + tag(iup_num_layers_tag)%description = & 'Defines the number of primitive layers to use for the upper crystal' + tag(ilw_min_thick_tag)%name = 'LW_MIN_THICKNESS' + tag(ilw_min_thick_tag)%type = 'R' + tag(ilw_min_thick_tag)%summary = 'Minimum thickness of lower crystal' + tag(ilw_min_thick_tag)%allowed = 'Any positive real number' + tag(ilw_min_thick_tag)%default = '10.0' + tag(ilw_min_thick_tag)%description = & + 'Defines the minimum thickness of the lower crystal (in Å).\n& + &The generated slab will be the smallest possible thickness equal to & + &or greater than this value.' + + tag(iup_min_thick_tag)%name = 'UP_MIN_THICKNESS' + tag(iup_min_thick_tag)%type = 'R' + tag(iup_min_thick_tag)%summary = 'Minimum thickness of upper crystal' + tag(iup_min_thick_tag)%allowed = 'Any positive real number' + tag(iup_min_thick_tag)%default = '10.0' + tag(iup_min_thick_tag)%description = & + 'Defines the minimum thickness of the upper crystal (in Å).\n& + &The generated slab will be the smallest possible thickness equal to & + &or greater than this value.' + tag(ilw_surf_tag)%name = 'LW_SURFACE' tag(ilw_surf_tag)%type = 'U' tag(ilw_surf_tag)%summary = 'Lower crystal surface terminations' @@ -585,12 +627,12 @@ function setup_interface_tags() result(tag) 'Defines the minimum size of gaps along the Miller direction that & &distinguish between separate layers (in Å) for the upper structure' - tag(ilbreak_on_no_term)%name = 'LBREAK_ON_NO_TERM' - tag(ilbreak_on_no_term)%type = 'L' - tag(ilbreak_on_no_term)%summary = 'Stop on no termination' - tag(ilbreak_on_no_term)%allowed = 'TRUE or FALSE' - tag(ilbreak_on_no_term)%default = 'TRUE' - tag(ilbreak_on_no_term)%description = & + tag(ilbreak_on_no_term_tag)%name = 'LBREAK_ON_NO_TERM' + tag(ilbreak_on_no_term_tag)%type = 'L' + tag(ilbreak_on_no_term_tag)%summary = 'Stop on no termination' + tag(ilbreak_on_no_term_tag)%allowed = 'TRUE or FALSE' + tag(ilbreak_on_no_term_tag)%default = 'TRUE' + tag(ilbreak_on_no_term_tag)%description = & 'Defines whether to stop the code if no terminations are found for a & &given Miller plane' @@ -642,7 +684,7 @@ function setup_interface_tags() result(tag) tag(imbond_maxlen_tag)%name = 'MBOND_MAXLEN' tag(imbond_maxlen_tag)%type = 'R' tag(imbond_maxlen_tag)%summary = 'Maximum considered missing bondlength' - tag(imbond_maxlen_tag)%allowed = 'Any real positive number' + tag(imbond_maxlen_tag)%allowed = 'Any positive real number' tag(imbond_maxlen_tag)%default = '4.0 (Å)' tag(imbond_maxlen_tag)%description = & 'ONLY USED IN ISHIFT = 4\n& @@ -897,6 +939,61 @@ end function setup_interface_tags !!!############################################################################# +!!!############################################################################# +!!! setup deprecated interface tag descriptions +!!!############################################################################# + function setup_depr_cell_edits_tags() result(tag) + implicit none + type(tag_type), dimension(ntags_depr_cell_edits) :: tag + + tag(islab_thick_tag)%name = 'SLAB_THICKNESS' + tag(islab_thick_tag)%type = 'I' + tag(islab_thick_tag)%summary = 'Number of layers of crystal' + tag(islab_thick_tag)%allowed = 'Any positive integer number' + tag(islab_thick_tag)%default = '(empty)' + tag(islab_thick_tag)%is_deprecated = .false. + tag(islab_thick_tag)%to_be_deprecated = .true. + tag(islab_thick_tag)%deprecated_version = '2.0.0' + tag(islab_thick_tag)%deprecated_name = 'NUM_LAYERS' + tag(islab_thick_tag)%description = & + 'Defines the number of primitive layers to use for the lower crystal' + + end function setup_depr_cell_edits_tags +!------------------------------------------------------------------------------- + function setup_depr_interface_tags() result(tag) + implicit none + type(tag_type), dimension(ntags_depr_interface) :: tag + + tag(ilw_slab_thick_tag)%name = 'LW_SLAB_THICKNESS' + tag(ilw_slab_thick_tag)%type = 'I' + tag(ilw_slab_thick_tag)%summary = 'Number of layers of lower crystal' + tag(ilw_slab_thick_tag)%allowed = 'Any positive integer number' + tag(ilw_slab_thick_tag)%default = '(empty)' + tag(ilw_slab_thick_tag)%is_deprecated = .false. + tag(ilw_slab_thick_tag)%to_be_deprecated = .true. + tag(ilw_slab_thick_tag)%deprecated_version = '2.0.0' + tag(ilw_slab_thick_tag)%deprecated_name = 'LW_NUM_LAYERS' + tag(ilw_slab_thick_tag)%description = & + 'Defines the number of primitive layers to use for the lower crystal' + + + tag(iup_slab_thick_tag)%name = 'UP_SLAB_THICKNESS' + tag(iup_slab_thick_tag)%type = 'I' + tag(iup_slab_thick_tag)%summary = 'Number of layers of upper crystal' + tag(iup_slab_thick_tag)%allowed = 'Any positive integer number' + tag(iup_slab_thick_tag)%default = '(empty)' + tag(iup_slab_thick_tag)%is_deprecated = .false. + tag(iup_slab_thick_tag)%to_be_deprecated = .true. + tag(iup_slab_thick_tag)%deprecated_version = '2.0.0' + tag(iup_slab_thick_tag)%deprecated_name = 'UP_NUM_LAYERS' + tag(iup_slab_thick_tag)%description = & + 'Defines the number of primitive layers to use for the upper crystal' + + end function setup_depr_interface_tags +!!!############################################################################# + + + !!!############################################################################# !!! settings card help !!!############################################################################# @@ -929,14 +1026,14 @@ subroutine cell_edits_help(unit, helpword, search) implicit none integer, intent(in) :: unit character(len=*), intent(in) :: helpword - type(tag_type), dimension(ntags_cell_edits) :: tag + type(tag_type), dimension(ntags_cell_edits + ntags_depr_cell_edits) :: tag logical :: lsearch logical, optional :: search lsearch=.false. if(present(search)) lsearch=search - tag=setup_cell_edits_tags() + tag = [ setup_cell_edits_tags(), setup_depr_cell_edits_tags() ] write(unit,'("======================================")') write(unit,'("Help information in CELL_EDITS card:")') @@ -954,14 +1051,14 @@ subroutine interface_help(unit, helpword, search) implicit none integer, intent(in) :: unit character(len=*), intent(in) :: helpword - type(tag_type), dimension(ntags_interface) :: tag + type(tag_type), dimension(ntags_interface + ntags_depr_interface) :: tag logical :: lsearch logical, optional :: search lsearch=.false. if(present(search)) lsearch=search - tag=setup_interface_tags() + tag = [ setup_interface_tags(), setup_depr_interface_tags() ] write(unit,'("======================================")') write(unit,'("Help information in INTERFACE card:")') From 3be73788323b72572f319b9f4938470557623b28 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 15 Apr 2025 15:39:23 +0100 Subject: [PATCH 020/137] Update ignore list --- .gitignore | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 2e8f474..7eca3c6 100644 --- a/.gitignore +++ b/.gitignore @@ -6,4 +6,5 @@ obj/ tests/*/*.txt tests/*/*.out tests/*/DINTERFACES -tests/*/DTERMINATIONS \ No newline at end of file +tests/*/DTERMINATIONS +build/ \ No newline at end of file From cab5f1fb24d3cef018a377b508a7b68ed0c190e3 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 15 Apr 2025 16:00:51 +0100 Subject: [PATCH 021/137] Update filepaths --- {src => app}/main.f90 | 9 ++-- .../D01/DSHIFT/D01/DSWAP/D01/POSCAR | 0 .../D01/DSHIFT/D01/DSWAP/D02/POSCAR | 0 .../D01/DSHIFT/D01/DSWAP/D03/POSCAR | 0 .../D01/DSHIFT/D01/DSWAP/D04/POSCAR | 0 .../D01/DSHIFT/D01/DSWAP/D05/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D01/POSCAR | 0 .../D01/DSHIFT/D02/DSWAP/D01/POSCAR | 0 .../D01/DSHIFT/D02/DSWAP/D02/POSCAR | 0 .../D01/DSHIFT/D02/DSWAP/D03/POSCAR | 0 .../D01/DSHIFT/D02/DSWAP/D04/POSCAR | 0 .../D01/DSHIFT/D02/DSWAP/D05/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D02/POSCAR | 0 .../D01/DSHIFT/D03/DSWAP/D01/POSCAR | 0 .../D01/DSHIFT/D03/DSWAP/D02/POSCAR | 0 .../D01/DSHIFT/D03/DSWAP/D03/POSCAR | 0 .../D01/DSHIFT/D03/DSWAP/D04/POSCAR | 0 .../D01/DSHIFT/D03/DSWAP/D05/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D03/POSCAR | 0 .../D01/DSHIFT/D04/DSWAP/D01/POSCAR | 0 .../D01/DSHIFT/D04/DSWAP/D02/POSCAR | 0 .../D01/DSHIFT/D04/DSWAP/D03/POSCAR | 0 .../D01/DSHIFT/D04/DSWAP/D04/POSCAR | 0 .../D01/DSHIFT/D04/DSWAP/D05/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D04/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D05/POSCAR | 0 .../DINTERFACES/settings.txt | 35 ++++++++++++ .../generate_interface/POSCAR_Ge | 0 .../generate_interface/POSCAR_Si | 0 .../generate_interface/param.in | 0 .../DTERMINATIONS/DLW_TERMS/POSCAR_term1 | 0 .../identify_terminations/POSCAR | 0 .../identify_terminations/param.in | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/POSCAR | 0 .../DINTERFACES/interface_location.dat | 0 .../pregenerated_interface/POSCAR | 0 .../pregenerated_interface/param.in | 0 src/fortran/artemis.f90 | 6 +++ src/{ => fortran}/aspect.f90 | 0 src/{ => fortran}/default_infile.f90 | 0 src/{ => fortran}/inputs.f90 | 0 src/{ => fortran}/interfaces.f90 | 4 +- src/{ => fortran}/io.F90 | 0 src/{ => fortran}/lib/mod_constants.f90 | 0 src/{ => fortran}/lib/mod_edit_geom.f90 | 0 src/{ => fortran}/lib/mod_misc.f90 | 0 src/{ => fortran}/lib/mod_misc_linalg.f90 | 0 src/{ => fortran}/lib/mod_misc_maths.f90 | 0 src/{ => fortran}/lib/mod_rw_geom.f90 | 0 src/{ => fortran}/lib/mod_sym.f90 | 0 src/{ => fortran}/lib/mod_tools_infile.f90 | 0 src/{ => fortran}/mod_help.f90 | 0 src/{ => fortran}/mod_intf_identifier.f90 | 0 src/{ => fortran}/mod_lat_compare.f90 | 0 src/{ => fortran}/mod_plane_matching.f90 | 0 src/{ => fortran}/mod_shifting.f90 | 2 +- src/{ => fortran}/mod_swapping.f90 | 0 .../DCHECK/POSCAR_term1 | 0 .../DCHECK/POSCAR_term2 | 0 .../DTERMINATIONS/POSCAR_term2 | 54 +++++++++++++++++++ .../DTERMINATIONS/lw_term.vasp | 48 +++++++++++++++++ .../POSCAR | 0 .../param.in | 0 .../DCHECK/POSCAR_term1 | 0 .../DTERMINATIONS/POSCAR_term1 | 17 ++++++ .../POSCAR | 0 .../param.in | 0 .../DCHECK/POSCAR_term1 | 0 .../DTERMINATIONS/POSCAR_term1 | 17 ++++++ .../DTERMINATIONS/lw_term.vasp | 5 ++ .../POSCAR | 0 .../param.in | 0 .../DCHECK/D01/DSHIFT/D01/DSWAP/D01/POSCAR | 0 .../DCHECK/D01/DSHIFT/D01/DSWAP/D02/POSCAR | 0 .../DCHECK/D01/DSHIFT/D01/DSWAP/D03/POSCAR | 0 .../DCHECK/D01/DSHIFT/D01/DSWAP/D04/POSCAR | 0 .../DCHECK/D01/DSHIFT/D01/DSWAP/D05/POSCAR | 0 .../DCHECK/D01/DSHIFT/D01/POSCAR | 0 .../DCHECK/D01/DSHIFT/D02/DSWAP/D01/POSCAR | 0 .../DCHECK/D01/DSHIFT/D02/DSWAP/D02/POSCAR | 0 .../DCHECK/D01/DSHIFT/D02/DSWAP/D03/POSCAR | 0 .../DCHECK/D01/DSHIFT/D02/DSWAP/D04/POSCAR | 0 .../DCHECK/D01/DSHIFT/D02/DSWAP/D05/POSCAR | 0 .../DCHECK/D01/DSHIFT/D02/POSCAR | 0 .../DCHECK/D01/DSHIFT/D03/DSWAP/D01/POSCAR | 0 .../DCHECK/D01/DSHIFT/D03/DSWAP/D02/POSCAR | 0 .../DCHECK/D01/DSHIFT/D03/DSWAP/D03/POSCAR | 0 .../DCHECK/D01/DSHIFT/D03/DSWAP/D04/POSCAR | 0 .../DCHECK/D01/DSHIFT/D03/DSWAP/D05/POSCAR | 0 .../DCHECK/D01/DSHIFT/D03/POSCAR | 0 .../DCHECK/D01/DSHIFT/D04/DSWAP/D01/POSCAR | 0 .../DCHECK/D01/DSHIFT/D04/DSWAP/D02/POSCAR | 0 .../DCHECK/D01/DSHIFT/D04/DSWAP/D03/POSCAR | 0 .../DCHECK/D01/DSHIFT/D04/DSWAP/D04/POSCAR | 0 .../DCHECK/D01/DSHIFT/D04/DSWAP/D05/POSCAR | 0 .../DCHECK/D01/DSHIFT/D04/POSCAR | 0 .../DCHECK/D01/DSHIFT/D05/POSCAR | 0 .../DCHECK/D01/DSHIFT/shift_vals.txt | 0 .../generate_interface/DCHECK/settings.txt | 0 {tests => test}/generate_interface/POSCAR_Ge | 0 {tests => test}/generate_interface/POSCAR_Si | 0 .../generate_interface/param.in | 0 .../DCHECK/DLW_TERMS/POSCAR_term1 | 0 {tests => test}/identify_terminations/POSCAR | 0 .../identify_terminations/param.in | 0 .../DCHECK/DSHIFT/D01/DSWAP/D01/POSCAR | 0 .../DCHECK/DSHIFT/D01/DSWAP/D02/POSCAR | 0 .../DCHECK/DSHIFT/D01/DSWAP/D03/POSCAR | 0 .../DCHECK/DSHIFT/D01/DSWAP/D04/POSCAR | 0 .../DCHECK/DSHIFT/D01/DSWAP/D05/POSCAR | 0 .../DCHECK/DSHIFT/D01/POSCAR | 0 .../DCHECK/DSHIFT/D02/DSWAP/D01/POSCAR | 0 .../DCHECK/DSHIFT/D02/DSWAP/D02/POSCAR | 0 .../DCHECK/DSHIFT/D02/DSWAP/D03/POSCAR | 0 .../DCHECK/DSHIFT/D02/DSWAP/D04/POSCAR | 0 .../DCHECK/DSHIFT/D02/DSWAP/D05/POSCAR | 0 .../DCHECK/DSHIFT/D02/POSCAR | 0 .../DCHECK/DSHIFT/D03/DSWAP/D01/POSCAR | 0 .../DCHECK/DSHIFT/D03/DSWAP/D02/POSCAR | 0 .../DCHECK/DSHIFT/D03/DSWAP/D03/POSCAR | 0 .../DCHECK/DSHIFT/D03/DSWAP/D04/POSCAR | 0 .../DCHECK/DSHIFT/D03/DSWAP/D05/POSCAR | 0 .../DCHECK/DSHIFT/D03/POSCAR | 0 .../DCHECK/DSHIFT/D04/DSWAP/D01/POSCAR | 0 .../DCHECK/DSHIFT/D04/DSWAP/D02/POSCAR | 0 .../DCHECK/DSHIFT/D04/DSWAP/D03/POSCAR | 0 .../DCHECK/DSHIFT/D04/DSWAP/D04/POSCAR | 0 .../DCHECK/DSHIFT/D04/DSWAP/D05/POSCAR | 0 .../DCHECK/DSHIFT/D04/POSCAR | 0 .../DCHECK/DSHIFT/D05/DSWAP/D01/POSCAR | 0 .../DCHECK/DSHIFT/D05/DSWAP/D02/POSCAR | 0 .../DCHECK/DSHIFT/D05/DSWAP/D03/POSCAR | 0 .../DCHECK/DSHIFT/D05/DSWAP/D04/POSCAR | 0 .../DCHECK/DSHIFT/D05/DSWAP/D05/POSCAR | 0 .../DCHECK/DSHIFT/D05/POSCAR | 0 .../DCHECK/DSHIFT/shift_vals.txt | 0 .../DCHECK/interface_location.dat | 0 .../DCHECK/settings.txt | 0 {tests => test}/pregenerated_interface/POSCAR | 0 .../pregenerated_interface/param.in | 0 {tests => test}/tester.sh | 0 .../tol_sym_thickness/DCHECK/POSCAR_term1 | 0 .../DTERMINATIONS/POSCAR_term1 | 32 +++++++++++ {tests => test}/tol_sym_thickness/POSCAR | 0 {tests => test}/tol_sym_thickness/param.in | 0 174 files changed, 220 insertions(+), 9 deletions(-) rename {src => app}/main.f90 (97%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR (100%) rename {examples => example}/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR (100%) create mode 100644 example/generate_interface/DINTERFACES/settings.txt rename {examples => example}/generate_interface/POSCAR_Ge (100%) rename {examples => example}/generate_interface/POSCAR_Si (100%) rename {tests => example}/generate_interface/param.in (100%) rename {examples => example}/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 (100%) rename {examples => example}/identify_terminations/POSCAR (100%) rename {examples => example}/identify_terminations/param.in (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR (100%) rename {examples => example}/pregenerated_interface/DINTERFACES/interface_location.dat (100%) rename {examples => example}/pregenerated_interface/POSCAR (100%) rename {examples => example}/pregenerated_interface/param.in (100%) create mode 100644 src/fortran/artemis.f90 rename src/{ => fortran}/aspect.f90 (100%) rename src/{ => fortran}/default_infile.f90 (100%) rename src/{ => fortran}/inputs.f90 (100%) rename src/{ => fortran}/interfaces.f90 (99%) rename src/{ => fortran}/io.F90 (100%) rename src/{ => fortran}/lib/mod_constants.f90 (100%) rename src/{ => fortran}/lib/mod_edit_geom.f90 (100%) rename src/{ => fortran}/lib/mod_misc.f90 (100%) rename src/{ => fortran}/lib/mod_misc_linalg.f90 (100%) rename src/{ => fortran}/lib/mod_misc_maths.f90 (100%) rename src/{ => fortran}/lib/mod_rw_geom.f90 (100%) rename src/{ => fortran}/lib/mod_sym.f90 (100%) rename src/{ => fortran}/lib/mod_tools_infile.f90 (100%) rename src/{ => fortran}/mod_help.f90 (100%) rename src/{ => fortran}/mod_intf_identifier.f90 (100%) rename src/{ => fortran}/mod_lat_compare.f90 (100%) rename src/{ => fortran}/mod_plane_matching.f90 (100%) rename src/{ => fortran}/mod_shifting.f90 (99%) rename src/{ => fortran}/mod_swapping.f90 (100%) rename {tests => test}/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term1 (100%) rename {tests => test}/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term2 (100%) create mode 100644 test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 create mode 100644 test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp rename {tests => test}/cell_edits_identify_terminations_CaZrO3/POSCAR (100%) rename {tests => test}/cell_edits_identify_terminations_CaZrO3/param.in (100%) rename {tests => test}/cell_edits_identify_terminations_TMDC-H/DCHECK/POSCAR_term1 (100%) create mode 100644 test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 rename {tests => test}/cell_edits_identify_terminations_TMDC-H/POSCAR (100%) rename {tests => test}/cell_edits_identify_terminations_TMDC-H/param.in (100%) rename {tests => test}/cell_edits_identify_terminations_TMDC-T/DCHECK/POSCAR_term1 (100%) create mode 100644 test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 create mode 100644 test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp rename {tests => test}/cell_edits_identify_terminations_TMDC-T/POSCAR (100%) rename {tests => test}/cell_edits_identify_terminations_TMDC-T/param.in (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D01/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D02/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D03/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D04/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D05/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D01/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D01/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D02/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D03/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D04/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D05/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D02/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D01/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D02/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D03/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D04/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D05/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D03/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D01/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D02/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D03/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D04/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D05/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D04/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/D05/POSCAR (100%) rename {tests => test}/generate_interface/DCHECK/D01/DSHIFT/shift_vals.txt (100%) rename {tests => test}/generate_interface/DCHECK/settings.txt (100%) rename {tests => test}/generate_interface/POSCAR_Ge (100%) rename {tests => test}/generate_interface/POSCAR_Si (100%) rename {examples => test}/generate_interface/param.in (100%) rename {tests => test}/identify_terminations/DCHECK/DLW_TERMS/POSCAR_term1 (100%) rename {tests => test}/identify_terminations/POSCAR (100%) rename {tests => test}/identify_terminations/param.in (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D01/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D02/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D03/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D04/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D05/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D01/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D01/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D02/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D03/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D04/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D05/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D02/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D01/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D02/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D03/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D04/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D05/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D03/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D01/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D02/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D03/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D04/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D05/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D04/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D01/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D02/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D03/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D04/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D05/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/D05/POSCAR (100%) rename {tests => test}/pregenerated_interface/DCHECK/DSHIFT/shift_vals.txt (100%) rename {tests => test}/pregenerated_interface/DCHECK/interface_location.dat (100%) rename {tests => test}/pregenerated_interface/DCHECK/settings.txt (100%) rename {tests => test}/pregenerated_interface/POSCAR (100%) rename {tests => test}/pregenerated_interface/param.in (100%) rename {tests => test}/tester.sh (100%) rename {tests => test}/tol_sym_thickness/DCHECK/POSCAR_term1 (100%) create mode 100644 test/tol_sym_thickness/DTERMINATIONS/POSCAR_term1 rename {tests => test}/tol_sym_thickness/POSCAR (100%) rename {tests => test}/tol_sym_thickness/param.in (100%) diff --git a/src/main.f90 b/app/main.f90 similarity index 97% rename from src/main.f90 rename to app/main.f90 index efb1ae4..ee3bd6b 100644 --- a/src/main.f90 +++ b/app/main.f90 @@ -4,14 +4,11 @@ !!! Code part of the ARTEMIS group (Hepplestone research group). !!! Think Hepplestone, think HRG. !!!############################################################################# -program artemis - use inputs - use interface_subroutines +program artemis_executable + use artemis implicit none -!!!updated 2021/11/12 - !!!----------------------------------------------------------------------------- !!! set up global variables @@ -103,5 +100,5 @@ program artemis -end program artemis +end program artemis_executable diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR diff --git a/examples/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR b/example/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR similarity index 100% rename from examples/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR rename to example/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR diff --git a/example/generate_interface/DINTERFACES/settings.txt b/example/generate_interface/DINTERFACES/settings.txt new file mode 100644 index 0000000..47530f3 --- /dev/null +++ b/example/generate_interface/DINTERFACES/settings.txt @@ -0,0 +1,35 @@ +SETTINGS + TASK = 1 + RESTART = 0 + CLOCK = 972499989 +END SETTINGS + + +INTERFACES + LGEN_INTERFACES = T + NINTF = 100 + IMATCH = 0 + NMATCH = 1 + TOL_VEC = 5.0000000 + TOL_ANG = 1.0000000 + TOL_AREA = 10.0000000 + + NMILLER = 10 + LW_MILLER_PLANE = 0 0 0 + UP_MILLER_PLANE = 0 0 0 + LW_SLAB_THICKNESS = 6 + UP_SLAB_THICKNESS = 6 + NTERM = 5 + + ISHIFT = 4 + NSHIFT = 5 + C_SCALE = 1.0000000 + + ISWAP = 2 + NSWAP = 5 + SWAP_DENSITY = .05000 + + LSURF_GEN = F +END INTERFACES + + diff --git a/examples/generate_interface/POSCAR_Ge b/example/generate_interface/POSCAR_Ge similarity index 100% rename from examples/generate_interface/POSCAR_Ge rename to example/generate_interface/POSCAR_Ge diff --git a/examples/generate_interface/POSCAR_Si b/example/generate_interface/POSCAR_Si similarity index 100% rename from examples/generate_interface/POSCAR_Si rename to example/generate_interface/POSCAR_Si diff --git a/tests/generate_interface/param.in b/example/generate_interface/param.in similarity index 100% rename from tests/generate_interface/param.in rename to example/generate_interface/param.in diff --git a/examples/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 b/example/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 similarity index 100% rename from examples/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 rename to example/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 diff --git a/examples/identify_terminations/POSCAR b/example/identify_terminations/POSCAR similarity index 100% rename from examples/identify_terminations/POSCAR rename to example/identify_terminations/POSCAR diff --git a/examples/identify_terminations/param.in b/example/identify_terminations/param.in similarity index 100% rename from examples/identify_terminations/param.in rename to example/identify_terminations/param.in diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR b/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR rename to example/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR diff --git a/examples/pregenerated_interface/DINTERFACES/interface_location.dat b/example/pregenerated_interface/DINTERFACES/interface_location.dat similarity index 100% rename from examples/pregenerated_interface/DINTERFACES/interface_location.dat rename to example/pregenerated_interface/DINTERFACES/interface_location.dat diff --git a/examples/pregenerated_interface/POSCAR b/example/pregenerated_interface/POSCAR similarity index 100% rename from examples/pregenerated_interface/POSCAR rename to example/pregenerated_interface/POSCAR diff --git a/examples/pregenerated_interface/param.in b/example/pregenerated_interface/param.in similarity index 100% rename from examples/pregenerated_interface/param.in rename to example/pregenerated_interface/param.in diff --git a/src/fortran/artemis.f90 b/src/fortran/artemis.f90 new file mode 100644 index 0000000..0c6f2c4 --- /dev/null +++ b/src/fortran/artemis.f90 @@ -0,0 +1,6 @@ +module artemis + use inputs + use artemis__generator + implicit none + +end module artemis \ No newline at end of file diff --git a/src/aspect.f90 b/src/fortran/aspect.f90 similarity index 100% rename from src/aspect.f90 rename to src/fortran/aspect.f90 diff --git a/src/default_infile.f90 b/src/fortran/default_infile.f90 similarity index 100% rename from src/default_infile.f90 rename to src/fortran/default_infile.f90 diff --git a/src/inputs.f90 b/src/fortran/inputs.f90 similarity index 100% rename from src/inputs.f90 rename to src/fortran/inputs.f90 diff --git a/src/interfaces.f90 b/src/fortran/interfaces.f90 similarity index 99% rename from src/interfaces.f90 rename to src/fortran/interfaces.f90 index b408b28..57e3648 100644 --- a/src/interfaces.f90 +++ b/src/fortran/interfaces.f90 @@ -4,7 +4,7 @@ !!! Code part of the ARTEMIS group (Hepplestone research group). !!! Think Hepplestone, think HRG. !!!############################################################################# -module interface_subroutines +module artemis__generator use io use misc_linalg, only: uvec,modu,get_area,inverse,cross use inputs @@ -1740,4 +1740,4 @@ end subroutine output_intf_data !!!############################################################################# -end module interface_subroutines +end module artemis__generator diff --git a/src/io.F90 b/src/fortran/io.F90 similarity index 100% rename from src/io.F90 rename to src/fortran/io.F90 diff --git a/src/lib/mod_constants.f90 b/src/fortran/lib/mod_constants.f90 similarity index 100% rename from src/lib/mod_constants.f90 rename to src/fortran/lib/mod_constants.f90 diff --git a/src/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 similarity index 100% rename from src/lib/mod_edit_geom.f90 rename to src/fortran/lib/mod_edit_geom.f90 diff --git a/src/lib/mod_misc.f90 b/src/fortran/lib/mod_misc.f90 similarity index 100% rename from src/lib/mod_misc.f90 rename to src/fortran/lib/mod_misc.f90 diff --git a/src/lib/mod_misc_linalg.f90 b/src/fortran/lib/mod_misc_linalg.f90 similarity index 100% rename from src/lib/mod_misc_linalg.f90 rename to src/fortran/lib/mod_misc_linalg.f90 diff --git a/src/lib/mod_misc_maths.f90 b/src/fortran/lib/mod_misc_maths.f90 similarity index 100% rename from src/lib/mod_misc_maths.f90 rename to src/fortran/lib/mod_misc_maths.f90 diff --git a/src/lib/mod_rw_geom.f90 b/src/fortran/lib/mod_rw_geom.f90 similarity index 100% rename from src/lib/mod_rw_geom.f90 rename to src/fortran/lib/mod_rw_geom.f90 diff --git a/src/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 similarity index 100% rename from src/lib/mod_sym.f90 rename to src/fortran/lib/mod_sym.f90 diff --git a/src/lib/mod_tools_infile.f90 b/src/fortran/lib/mod_tools_infile.f90 similarity index 100% rename from src/lib/mod_tools_infile.f90 rename to src/fortran/lib/mod_tools_infile.f90 diff --git a/src/mod_help.f90 b/src/fortran/mod_help.f90 similarity index 100% rename from src/mod_help.f90 rename to src/fortran/mod_help.f90 diff --git a/src/mod_intf_identifier.f90 b/src/fortran/mod_intf_identifier.f90 similarity index 100% rename from src/mod_intf_identifier.f90 rename to src/fortran/mod_intf_identifier.f90 diff --git a/src/mod_lat_compare.f90 b/src/fortran/mod_lat_compare.f90 similarity index 100% rename from src/mod_lat_compare.f90 rename to src/fortran/mod_lat_compare.f90 diff --git a/src/mod_plane_matching.f90 b/src/fortran/mod_plane_matching.f90 similarity index 100% rename from src/mod_plane_matching.f90 rename to src/fortran/mod_plane_matching.f90 diff --git a/src/mod_shifting.f90 b/src/fortran/mod_shifting.f90 similarity index 99% rename from src/mod_shifting.f90 rename to src/fortran/mod_shifting.f90 index 836be81..86c820b 100644 --- a/src/mod_shifting.f90 +++ b/src/fortran/mod_shifting.f90 @@ -1132,7 +1132,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !$OMP PARALLEL DO & !$OMP DEFAULT(SHARED) & !$OMP PRIVATE(is,ja,jb,jc,pos,vtmp1,vtmp2,vtmp3,count1,tmp_neigh) & -!$OMP SCHEDULE(DYNAMIC,CHUNK) +!$OMP SCHEDULE(DYNAMIC,8) do k=1,2 nneigh = size(intf(k)%neigh,dim=1) diff --git a/src/mod_swapping.f90 b/src/fortran/mod_swapping.f90 similarity index 100% rename from src/mod_swapping.f90 rename to src/fortran/mod_swapping.f90 diff --git a/tests/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term1 b/test/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term1 similarity index 100% rename from tests/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term1 rename to test/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term1 diff --git a/tests/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term2 b/test/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term2 similarity index 100% rename from tests/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term2 rename to test/cell_edits_identify_terminations_CaZrO3/DCHECK/POSCAR_term2 diff --git a/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 b/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 new file mode 100644 index 0000000..cf8c614 --- /dev/null +++ b/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 @@ -0,0 +1,54 @@ +calcium zirconate + 1.000000000 + 5.591110229 0.000000000 0.000000000 + 0.000000000 5.761280060 0.000000000 + 0.000000000 0.000000000 36.909181416 +Ca Zr O +8 10 28 +Direct + 0.987499999 0.951499996 0.391968676 + 0.987499999 0.951499996 0.174763383 + 0.012499949 0.048500035 0.283366023 + 0.012499949 0.048500035 0.066160730 + 0.487500009 0.548499993 0.283366023 + 0.487500009 0.548499993 0.066160730 + 0.512499991 0.451500007 0.391968676 + 0.512499991 0.451500007 0.174763383 + 0.000000000 0.500000000 0.446269999 + 0.000000000 0.500000000 0.229064706 + 0.000000000 0.500000000 0.011859414 + 0.500000000 0.000000000 0.446269999 + 0.500000000 0.000000000 0.229064706 + 0.500000000 0.000000000 0.011859414 + 0.000000000 0.500000000 0.337667352 + 0.000000000 0.500000000 0.120462060 + 0.500000000 0.000000000 0.337667352 + 0.500000000 0.000000000 0.120462060 + 0.396399980 0.039700040 0.391968676 + 0.396399980 0.039700040 0.174763383 + 0.603600020 0.960299999 0.283366023 + 0.603600020 0.960299999 0.066160730 + 0.896399970 0.460299960 0.283366023 + 0.896399970 0.460299960 0.066160730 + 0.103600062 0.539699999 0.391968676 + 0.103600062 0.539699999 0.174763383 + 0.697800004 0.699999979 0.434410590 + 0.697800004 0.699999979 0.217205297 + 0.697800004 0.699999979 0.000000000 + 0.302199975 0.300000000 0.240924120 + 0.302199975 0.300000000 0.023718827 + 0.302199975 0.300000000 0.458129412 + 0.197800025 0.800000021 0.240924120 + 0.197800025 0.800000021 0.023718827 + 0.197800025 0.800000021 0.458129412 + 0.802199996 0.200000000 0.434410590 + 0.802199996 0.200000000 0.217205297 + 0.802199996 0.200000000 0.000000000 + 0.302199975 0.300000000 0.325807939 + 0.302199975 0.300000000 0.108602646 + 0.697800004 0.699999979 0.349526760 + 0.697800004 0.699999979 0.132321467 + 0.802199996 0.200000000 0.349526760 + 0.802199996 0.200000000 0.132321467 + 0.197800025 0.800000021 0.325807939 + 0.197800025 0.800000021 0.108602646 diff --git a/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp b/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp new file mode 100644 index 0000000..926c98e --- /dev/null +++ b/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp @@ -0,0 +1,48 @@ +calcium zirconate + 1.000000000 + 5.591110229 0.000000000 0.000000000 + 0.000000000 5.761280060 0.000000000 + 0.000000000 0.000000000 15.250490666 +Ca Zr O +8 8 24 +Direct + 0.987499999 0.951499996 0.422961697 + 0.987499999 0.951499996 0.948641147 + 0.012499949 0.048500035 0.160121956 + 0.012499949 0.048500035 0.685801406 + 0.487500009 0.548499993 0.160121956 + 0.487500009 0.548499993 0.685801406 + 0.512499991 0.451500007 0.422961697 + 0.512499991 0.451500007 0.948641147 + 0.000000000 0.500000000 0.554381559 + 0.000000000 0.500000000 0.028702109 + 0.500000000 0.000000000 0.554381559 + 0.500000000 0.000000000 0.028702109 + 0.000000000 0.500000000 0.291541834 + 0.000000000 0.500000000 0.817221284 + 0.500000000 0.000000000 0.291541834 + 0.500000000 0.000000000 0.817221284 + 0.396399980 0.039700040 0.422961697 + 0.396399980 0.039700040 0.948641147 + 0.603600020 0.960299999 0.160121956 + 0.603600020 0.960299999 0.685801406 + 0.896399970 0.460299960 0.160121956 + 0.896399970 0.460299960 0.685801406 + 0.103600062 0.539699999 0.422961697 + 0.103600062 0.539699999 0.948641147 + 0.697800004 0.699999979 0.525679462 + 0.697800004 0.699999979 0.000000012 + 0.302199975 0.300000000 0.057404219 + 0.302199975 0.300000000 0.583083669 + 0.197800025 0.800000021 0.057404219 + 0.197800025 0.800000021 0.583083669 + 0.802199996 0.200000000 0.525679462 + 0.802199996 0.200000000 0.000000012 + 0.302199975 0.300000000 0.262839725 + 0.302199975 0.300000000 0.788519175 + 0.697800004 0.699999979 0.320243928 + 0.697800004 0.699999979 0.845923378 + 0.802199996 0.200000000 0.320243928 + 0.802199996 0.200000000 0.845923378 + 0.197800025 0.800000021 0.262839725 + 0.197800025 0.800000021 0.788519175 diff --git a/tests/cell_edits_identify_terminations_CaZrO3/POSCAR b/test/cell_edits_identify_terminations_CaZrO3/POSCAR similarity index 100% rename from tests/cell_edits_identify_terminations_CaZrO3/POSCAR rename to test/cell_edits_identify_terminations_CaZrO3/POSCAR diff --git a/tests/cell_edits_identify_terminations_CaZrO3/param.in b/test/cell_edits_identify_terminations_CaZrO3/param.in similarity index 100% rename from tests/cell_edits_identify_terminations_CaZrO3/param.in rename to test/cell_edits_identify_terminations_CaZrO3/param.in diff --git a/tests/cell_edits_identify_terminations_TMDC-H/DCHECK/POSCAR_term1 b/test/cell_edits_identify_terminations_TMDC-H/DCHECK/POSCAR_term1 similarity index 100% rename from tests/cell_edits_identify_terminations_TMDC-H/DCHECK/POSCAR_term1 rename to test/cell_edits_identify_terminations_TMDC-H/DCHECK/POSCAR_term1 diff --git a/test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 b/test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 new file mode 100644 index 0000000..42b829c --- /dev/null +++ b/test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 @@ -0,0 +1,17 @@ +Mo2 S4 + 1.000000000 + 3.190316000 0.000000000 0.000000000 + -1.595158000 2.762894000 0.000000000 + 0.000000000 0.000000000 32.008772733 +Mo S +3 6 +Direct + 0.333333000 0.666667000 0.048889234 + 0.333333000 0.666667000 0.513730673 + 0.666667000 0.333333000 0.281309953 + 0.666667000 0.333333000 0.097778467 + 0.666667000 0.333333000 0.562619907 + 0.333333000 0.666667000 0.330199187 + 0.666667000 0.333333000 0.000000000 + 0.666667000 0.333333000 0.464841440 + 0.333333000 0.666667000 0.232420720 diff --git a/tests/cell_edits_identify_terminations_TMDC-H/POSCAR b/test/cell_edits_identify_terminations_TMDC-H/POSCAR similarity index 100% rename from tests/cell_edits_identify_terminations_TMDC-H/POSCAR rename to test/cell_edits_identify_terminations_TMDC-H/POSCAR diff --git a/tests/cell_edits_identify_terminations_TMDC-H/param.in b/test/cell_edits_identify_terminations_TMDC-H/param.in similarity index 100% rename from tests/cell_edits_identify_terminations_TMDC-H/param.in rename to test/cell_edits_identify_terminations_TMDC-H/param.in diff --git a/tests/cell_edits_identify_terminations_TMDC-T/DCHECK/POSCAR_term1 b/test/cell_edits_identify_terminations_TMDC-T/DCHECK/POSCAR_term1 similarity index 100% rename from tests/cell_edits_identify_terminations_TMDC-T/DCHECK/POSCAR_term1 rename to test/cell_edits_identify_terminations_TMDC-T/DCHECK/POSCAR_term1 diff --git a/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 b/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 new file mode 100644 index 0000000..5482f34 --- /dev/null +++ b/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 @@ -0,0 +1,17 @@ +Hf1 S2 + 1.000000000 + 3.643366000 0.000000000 0.000000000 + -1.821683000 3.155247000 0.000000000 + 0.000000000 0.000000000 30.058821447 +Hf S +3 6 +Direct + 0.000000000 0.000000000 0.486175706 + 0.000000000 0.000000000 0.048070838 + 0.000000000 0.000000000 0.267123272 + 0.666667000 0.333333000 0.000000000 + 0.666667000 0.333333000 0.219052434 + 0.666667000 0.333333000 0.438104868 + 0.333333000 0.666667000 0.534246543 + 0.333333000 0.666667000 0.096141675 + 0.333333000 0.666667000 0.315194109 diff --git a/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp b/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp new file mode 100644 index 0000000..1c7e7f0 --- /dev/null +++ b/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp @@ -0,0 +1,5 @@ +Hf1 S2 + 1.000000000 + 3.643366000 0.000000000 0.000000000 + -1.821683000 3.155247000 0.000000000 + 0.000000000 0.000000000*************** diff --git a/tests/cell_edits_identify_terminations_TMDC-T/POSCAR b/test/cell_edits_identify_terminations_TMDC-T/POSCAR similarity index 100% rename from tests/cell_edits_identify_terminations_TMDC-T/POSCAR rename to test/cell_edits_identify_terminations_TMDC-T/POSCAR diff --git a/tests/cell_edits_identify_terminations_TMDC-T/param.in b/test/cell_edits_identify_terminations_TMDC-T/param.in similarity index 100% rename from tests/cell_edits_identify_terminations_TMDC-T/param.in rename to test/cell_edits_identify_terminations_TMDC-T/param.in diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D01/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D01/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D01/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D01/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D02/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D02/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D02/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D02/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D03/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D03/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D03/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D03/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D04/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D04/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D04/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D04/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D05/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D05/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D05/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D01/DSWAP/D05/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D01/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D01/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D01/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D01/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D01/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D01/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D01/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D01/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D02/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D02/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D02/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D02/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D03/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D03/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D03/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D03/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D04/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D04/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D04/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D04/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D05/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D05/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D05/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D02/DSWAP/D05/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D02/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D02/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D02/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D02/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D01/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D01/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D01/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D01/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D02/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D02/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D02/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D02/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D03/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D03/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D03/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D03/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D04/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D04/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D04/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D04/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D05/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D05/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D05/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D03/DSWAP/D05/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D03/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D03/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D03/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D03/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D01/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D01/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D01/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D01/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D02/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D02/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D02/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D02/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D03/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D03/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D03/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D03/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D04/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D04/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D04/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D04/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D05/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D05/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D05/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D04/DSWAP/D05/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D04/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D04/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D04/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D04/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/D05/POSCAR b/test/generate_interface/DCHECK/D01/DSHIFT/D05/POSCAR similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/D05/POSCAR rename to test/generate_interface/DCHECK/D01/DSHIFT/D05/POSCAR diff --git a/tests/generate_interface/DCHECK/D01/DSHIFT/shift_vals.txt b/test/generate_interface/DCHECK/D01/DSHIFT/shift_vals.txt similarity index 100% rename from tests/generate_interface/DCHECK/D01/DSHIFT/shift_vals.txt rename to test/generate_interface/DCHECK/D01/DSHIFT/shift_vals.txt diff --git a/tests/generate_interface/DCHECK/settings.txt b/test/generate_interface/DCHECK/settings.txt similarity index 100% rename from tests/generate_interface/DCHECK/settings.txt rename to test/generate_interface/DCHECK/settings.txt diff --git a/tests/generate_interface/POSCAR_Ge b/test/generate_interface/POSCAR_Ge similarity index 100% rename from tests/generate_interface/POSCAR_Ge rename to test/generate_interface/POSCAR_Ge diff --git a/tests/generate_interface/POSCAR_Si b/test/generate_interface/POSCAR_Si similarity index 100% rename from tests/generate_interface/POSCAR_Si rename to test/generate_interface/POSCAR_Si diff --git a/examples/generate_interface/param.in b/test/generate_interface/param.in similarity index 100% rename from examples/generate_interface/param.in rename to test/generate_interface/param.in diff --git a/tests/identify_terminations/DCHECK/DLW_TERMS/POSCAR_term1 b/test/identify_terminations/DCHECK/DLW_TERMS/POSCAR_term1 similarity index 100% rename from tests/identify_terminations/DCHECK/DLW_TERMS/POSCAR_term1 rename to test/identify_terminations/DCHECK/DLW_TERMS/POSCAR_term1 diff --git a/tests/identify_terminations/POSCAR b/test/identify_terminations/POSCAR similarity index 100% rename from tests/identify_terminations/POSCAR rename to test/identify_terminations/POSCAR diff --git a/tests/identify_terminations/param.in b/test/identify_terminations/param.in similarity index 100% rename from tests/identify_terminations/param.in rename to test/identify_terminations/param.in diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D01/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D01/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D01/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D01/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D02/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D02/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D02/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D02/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D03/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D03/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D03/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D03/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D04/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D04/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D04/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D04/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D05/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D05/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D05/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D01/DSWAP/D05/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D01/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D01/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D01/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D01/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D01/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D01/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D01/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D01/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D02/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D02/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D02/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D02/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D03/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D03/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D03/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D03/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D04/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D04/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D04/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D04/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D05/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D05/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D05/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D02/DSWAP/D05/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D02/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D02/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D02/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D02/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D01/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D01/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D01/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D01/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D02/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D02/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D02/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D02/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D03/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D03/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D03/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D03/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D04/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D04/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D04/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D04/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D05/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D05/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D05/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D03/DSWAP/D05/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D03/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D03/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D03/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D03/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D01/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D01/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D01/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D01/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D02/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D02/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D02/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D02/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D03/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D03/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D03/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D03/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D04/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D04/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D04/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D04/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D05/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D05/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D05/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D04/DSWAP/D05/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D04/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D04/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D04/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D04/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D01/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D01/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D01/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D01/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D02/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D02/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D02/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D02/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D03/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D03/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D03/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D03/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D04/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D04/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D04/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D04/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D05/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D05/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D05/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D05/DSWAP/D05/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/D05/POSCAR b/test/pregenerated_interface/DCHECK/DSHIFT/D05/POSCAR similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/D05/POSCAR rename to test/pregenerated_interface/DCHECK/DSHIFT/D05/POSCAR diff --git a/tests/pregenerated_interface/DCHECK/DSHIFT/shift_vals.txt b/test/pregenerated_interface/DCHECK/DSHIFT/shift_vals.txt similarity index 100% rename from tests/pregenerated_interface/DCHECK/DSHIFT/shift_vals.txt rename to test/pregenerated_interface/DCHECK/DSHIFT/shift_vals.txt diff --git a/tests/pregenerated_interface/DCHECK/interface_location.dat b/test/pregenerated_interface/DCHECK/interface_location.dat similarity index 100% rename from tests/pregenerated_interface/DCHECK/interface_location.dat rename to test/pregenerated_interface/DCHECK/interface_location.dat diff --git a/tests/pregenerated_interface/DCHECK/settings.txt b/test/pregenerated_interface/DCHECK/settings.txt similarity index 100% rename from tests/pregenerated_interface/DCHECK/settings.txt rename to test/pregenerated_interface/DCHECK/settings.txt diff --git a/tests/pregenerated_interface/POSCAR b/test/pregenerated_interface/POSCAR similarity index 100% rename from tests/pregenerated_interface/POSCAR rename to test/pregenerated_interface/POSCAR diff --git a/tests/pregenerated_interface/param.in b/test/pregenerated_interface/param.in similarity index 100% rename from tests/pregenerated_interface/param.in rename to test/pregenerated_interface/param.in diff --git a/tests/tester.sh b/test/tester.sh similarity index 100% rename from tests/tester.sh rename to test/tester.sh diff --git a/tests/tol_sym_thickness/DCHECK/POSCAR_term1 b/test/tol_sym_thickness/DCHECK/POSCAR_term1 similarity index 100% rename from tests/tol_sym_thickness/DCHECK/POSCAR_term1 rename to test/tol_sym_thickness/DCHECK/POSCAR_term1 diff --git a/test/tol_sym_thickness/DTERMINATIONS/POSCAR_term1 b/test/tol_sym_thickness/DTERMINATIONS/POSCAR_term1 new file mode 100644 index 0000000..f3a2970 --- /dev/null +++ b/test/tol_sym_thickness/DTERMINATIONS/POSCAR_term1 @@ -0,0 +1,32 @@ +TiO2 Anastase + 1.000000000 + 3.935910463 0.000000000 0.000000000 + 0.000000000 3.935910463 0.000000000 + 0.000000000 0.000000000 31.978628640 +Ti O +8 16 +Direct + 0.000000000 0.000000000 0.472611422 + 0.500000000 0.500000000 0.012960099 + 0.000000000 0.000000000 0.166177207 + 0.500000000 0.500000000 0.319394314 + 0.000000000 0.500000000 0.549234880 + 0.500000000 0.000000000 0.089583557 + 0.000000000 0.500000000 0.242800665 + 0.500000000 0.000000000 0.396017772 + 0.000000000 0.000000000 0.536242516 + 0.500000000 0.500000000 0.076591193 + 0.000000000 0.000000000 0.229808301 + 0.500000000 0.500000000 0.383025408 + 0.000000000 0.500000000 0.000000000 + 0.500000000 0.000000000 0.153217108 + 0.000000000 0.500000000 0.306434215 + 0.500000000 0.000000000 0.459651323 + 0.000000000 0.500000000 0.485616880 + 0.500000000 0.000000000 0.025965557 + 0.000000000 0.500000000 0.179182664 + 0.500000000 0.000000000 0.332399772 + 0.500000000 0.500000000 0.562207618 + 0.000000000 0.000000000 0.102556295 + 0.500000000 0.500000000 0.255773403 + 0.000000000 0.000000000 0.408990511 diff --git a/tests/tol_sym_thickness/POSCAR b/test/tol_sym_thickness/POSCAR similarity index 100% rename from tests/tol_sym_thickness/POSCAR rename to test/tol_sym_thickness/POSCAR diff --git a/tests/tol_sym_thickness/param.in b/test/tol_sym_thickness/param.in similarity index 100% rename from tests/tol_sym_thickness/param.in rename to test/tol_sym_thickness/param.in From 7512fb38c54dcc68806d6028ac7473046de5ced8 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 15 Apr 2025 16:00:58 +0100 Subject: [PATCH 022/137] Add new build methods --- CMakeLists.txt | 229 +++++++++++++++++++++++++++++++++++++++++++++++++ fpm.toml | 25 ++++++ 2 files changed, 254 insertions(+) create mode 100644 CMakeLists.txt create mode 100644 fpm.toml diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000..2eee661 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,229 @@ +cmake_minimum_required(VERSION 3.17.5) + +# define build environments +set( CMAKE_INSTALL_PREFIX "$ENV{HOME}/.local/" + CACHE STRING "Select where to install the library." ) +set(CMAKE_BUILD_DIR ${CMAKE_CURRENT_BINARY_DIR} + CACHE STRING "Select where to build the library." ) +set(MODULE_DIR ${CMAKE_BUILD_DIR}/mod) + +if (DEFINED SKBUILD_PROJECT_NAME) + set(SKBUILD_PROJECT_NAME ${SKBUILD_PROJECT_NAME}) +else() + set(SKBUILD_PROJECT_NAME "artemis") +endif() + + +# set compiler +set(CMAKE_Fortran_COMPILER gfortran + CACHE STRING "Select Fortran compiler." ) # Change this to your desired compiler +set(CMAKE_C_COMPILER gcc + CACHE STRING "Select C compiler." ) # Change this to your desired compiler +set(CMAKE_Fortran_STANDARD 2018) + +# set the project version +file(READ "fpm.toml" ver) +string(REGEX MATCH "version = \"([0-9]+.[0-9]+.[0-9]+)\"" _ ${ver}) +set(PROJECT_VERSION ${CMAKE_MATCH_1}) +message(STATUS "Project version: ${PROJECT_VERSION}") + +# set the project name +project(artemis + VERSION ${PROJECT_VERSION} + LANGUAGES C Fortran +) + +# set the library name +set( LIB_NAME ${PROJECT_NAME} ) +set( PROJECT_DESCRIPTION + "Fortran materials lattice matcher" ) +set( PROJECT_URL "https://github.com/ExeQuantCode/artemis" ) +set( CMAKE_CONFIGURATION_TYPES "Release" "Dev" "Debug" + CACHE STRING "List of configurations types." ) +set( CMAKE_BUILD_TYPE "Release" + CACHE STRING "Select which configuration to build." ) + +# set options +option(BUILD_EXECUTABLE "Build the Fortran executable" On) + +# Define the sources +set(SRC_DIR src) +set(FORTRAN_SRC_DIR ${SRC_DIR}/fortran) +set(LIB_DIR ${FORTRAN_SRC_DIR}/lib) + +# Library source files +set(LIB_FILES + mod_constants.f90 + mod_misc.f90 + mod_misc_maths.f90 + mod_misc_linalg.f90 + mod_tools_infile.f90 + mod_rw_geom.f90 + mod_edit_geom.f90 + mod_sym.f90 +) + +# Main source files +set(SPECIAL_LIB_FILES + io.F90 + aspect.f90 + mod_help.f90 + mod_intf_identifier.f90 + mod_plane_matching.f90 + mod_lat_compare.f90 + mod_swapping.f90 + mod_shifting.f90 + default_infile.f90 + inputs.f90 + interfaces.f90 +) + + +foreach(lib ${LIB_FILES}) + list(APPEND PREPENDED_LIB_FILES ${LIB_DIR}/${lib}) +endforeach() +foreach(lib ${SPECIAL_LIB_FILES}) + list(APPEND PREPENDED_LIB_FILES ${FORTRAN_SRC_DIR}/${lib}) +endforeach() +message(STATUS "Modified LIB_FILES: ${PREPENDED_LIB_FILES}") + + + +set(SRC_FILES + artemis.f90 +) +foreach(lib ${SPECIAL_LIB_FILES}) + list(APPEND F90WRAP_FORTRAN_SRC_FILES ${CMAKE_CURRENT_LIST_DIR}/${FORTRAN_SRC_DIR}/${lib}) +endforeach() +foreach(src ${SRC_FILES}) + list(APPEND F90WRAP_FORTRAN_SRC_FILES ${CMAKE_CURRENT_LIST_DIR}/${FORTRAN_SRC_DIR}/${src}) + list(APPEND PREPENDED_SRC_FILES ${FORTRAN_SRC_DIR}/${src}) +endforeach() + + +set(EXECUTABLE_FILES + main.f90 +) +set(APP_DIR app) +foreach(src ${EXECUTABLE_FILES}) + list(APPEND PREPENDED_EXECUTABLE_FILES ${APP_DIR}/${src}) +endforeach() + + +# initialise flags +set(CPPFLAGS "") +set(CFLAGS "") +set(MODULEFLAGS "") +set(MPFLAGS "") +set(WARNFLAGS "") +set(DEVFLAGS "") +set(DEBUGFLAGS "") +set(MEMFLAGS "") +set(OPTIMFLAGS "") +set(FASTFLAGS "") + +# set flags based on compiler +if (CMAKE_Fortran_COMPILER MATCHES ".*gfortran.*" OR CMAKE_Fortran_COMPILER MATCHES ".*gcc.*") + message(STATUS "Using gfortran compiler") + set(PPFLAGS -cpp) + set(MPFLAGS -fopenmp -lgomp -floop-parallelize-all -ftree-parallelize-loops=32) + set(WARNFLAGS -Wall) + set(DEVFLAGS -g -fbacktrace -fcheck=all -fbounds-check -Og) + set(DEBUGFLAGS -fbounds-check) + set(MEMFLAGS -mcmodel=large) + set(OPTIMFLAGS -O3 -march=native) + set(FASTFLAGS -Ofast -march=native) + set(PYTHONFLAGS -c -O3 -fPIC) +elseif (CMAKE_Fortran_COMPILER MATCHES ".*nag.*") + message(STATUS "Using nag compiler") + set(PPFLAGS -f2018 -fpp) + set(MPFLAGS -openmp) + set(WARNFLAGS -Wall) + set(DEVFLAGS -g -mtrace -C=all -colour -O0) + set(DEBUGFLAGS -C=array) + set(MEMFLAGS -mcmodel=large) + set(OPTIMFLAGS -O3) + set(FASTFLAGS -Ofast) +elseif (CMAKE_Fortran_COMPILER MATCHES ".*ifort.*" OR CMAKE_Fortran_COMPILER MATCHES ".*ifx.*") + message(STATUS "Using intel compiler") + set(PPFLAGS -fpp) + set(MPFLAGS -qopenmp) + set(WARNFLAGS -warn all) + set(DEVFLAGS -check all -warn) + set(DEBUGFLAGS -check all -fpe0 -warn -tracekback -debug extended) + set(MEMFLAGS -mcmodel=large) + set(OPTIMFLAGS -O3) + set(FASTFLAGS -Ofast) +else() + # Code for other Fortran compilers + message(STATUS "Using a different Fortran compiler") +endif() + + + +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${PPFLAGS}") + + +# create the library +add_library(${PROJECT_NAME} STATIC ${PREPENDED_LIB_FILES} ${PREPENDED_SRC_FILES}) +set_target_properties(${PROJECT_NAME} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIR}) +target_link_libraries(${PROJECT_NAME} PUBLIC) + +# replace ".f90" with ".mod" +string(REGEX REPLACE "\\.[^.]*$" ".mod" MODULE_FILES "${SRC_FILES}") + +set(ETC_MODULE_FILES "") +# Loop through each Fortran file +foreach(FILE ${PREPENDED_LIB_FILES}) + # Read the content of the Fortran file + file(READ "${FILE}" FILE_CONTENTS) + + # Use a regular expression to extract the module name + string(REGEX MATCH "^module[ \t]+([a-zA-Z0-9_]+)" MATCH "${FILE_CONTENTS}") + + # If a match is found, extract the module name (the first capture group) + if(MATCH) + string(REGEX REPLACE "module[ \t]+([a-zA-Z0-9_]+)" "\\1" MODULE_NAME "${MATCH}") + + # Append the module name with .mod to the list + list(APPEND ETC_MODULE_FILES "${MODULE_DIR}/${MODULE_NAME}.mod") + endif() +endforeach() + +# installation +install(FILES ${MODULE_DIR}/${MODULE_FILES} DESTINATION ${SKBUILD_PROJECT_NAME}/include) +install(FILES ${ETC_MODULE_FILES} DESTINATION ${SKBUILD_PROJECT_NAME}/etc) +install(TARGETS ${PROJECT_NAME} DESTINATION ${SKBUILD_PROJECT_NAME}/lib) +set_target_properties(${PROJECT_NAME} PROPERTIES VERSION ${PROJECT_VERSION}) + +# set compile options based on different build configurations +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${OPTIMFLAGS}>") +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${MPFLAGS}>") +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${PYTHONFLAGS}>") + +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${DEVFLAGS}>") + +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${DEBUGFLAGS}>") +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${WARNFLAGS}>") +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${MPFLAGS}>") +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${PYTHONFLAGS}>") + +if (BUILD_EXECUTABLE) + add_executable(${PROJECT_NAME}_executable ${PREPENDED_EXECUTABLE_FILES}) + target_link_libraries(${PROJECT_NAME}_executable PRIVATE ${PROJECT_NAME}) + install(TARGETS ${PROJECT_NAME}_executable DESTINATION ${SKBUILD_PROJECT_NAME}/bin) + set_target_properties(${PROJECT_NAME}_executable PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIR}) + + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${OPTIMFLAGS}>") + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${MPFLAGS}>") + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${PYTHONFLAGS}>") + + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${DEVFLAGS}>") + + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${DEBUGFLAGS}>") + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${WARNFLAGS}>") + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${MPFLAGS}>") + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${PYTHONFLAGS}>") + + set_target_properties(${PROJECT_NAME}_executable PROPERTIES VERSION ${PROJECT_VERSION}) +endif() diff --git a/fpm.toml b/fpm.toml new file mode 100644 index 0000000..40d7aab --- /dev/null +++ b/fpm.toml @@ -0,0 +1,25 @@ +name = "artemis" +version = "1.0.2" +author = "Ned Thaddeus Taylor" +maintainer = "n.t.taylor@exeter.ac.uk" +description = "A Fortran executable for generating interface lattice matches" + +[preprocess] +[preprocess.cpp] +suffixes = ["F90", "f90"] + +[library] +source-dir="src/fortran" + +[dependencies] +openmp = "*" + +[fortran] +implicit-typing = false +implicit-external = false +source-form = "free" + +[[executable]] +name="artemis_executable" +source-dir="app" +main="main.f90" From 3f22c92940f551947a3ab83778e2d8343c57e3a5 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 07:55:16 +0100 Subject: [PATCH 023/137] Remove files --- .../DTERMINATIONS/POSCAR_term2 | 54 ------------------- .../DTERMINATIONS/lw_term.vasp | 48 ----------------- 2 files changed, 102 deletions(-) delete mode 100644 test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 delete mode 100644 test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp diff --git a/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 b/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 deleted file mode 100644 index cf8c614..0000000 --- a/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/POSCAR_term2 +++ /dev/null @@ -1,54 +0,0 @@ -calcium zirconate - 1.000000000 - 5.591110229 0.000000000 0.000000000 - 0.000000000 5.761280060 0.000000000 - 0.000000000 0.000000000 36.909181416 -Ca Zr O -8 10 28 -Direct - 0.987499999 0.951499996 0.391968676 - 0.987499999 0.951499996 0.174763383 - 0.012499949 0.048500035 0.283366023 - 0.012499949 0.048500035 0.066160730 - 0.487500009 0.548499993 0.283366023 - 0.487500009 0.548499993 0.066160730 - 0.512499991 0.451500007 0.391968676 - 0.512499991 0.451500007 0.174763383 - 0.000000000 0.500000000 0.446269999 - 0.000000000 0.500000000 0.229064706 - 0.000000000 0.500000000 0.011859414 - 0.500000000 0.000000000 0.446269999 - 0.500000000 0.000000000 0.229064706 - 0.500000000 0.000000000 0.011859414 - 0.000000000 0.500000000 0.337667352 - 0.000000000 0.500000000 0.120462060 - 0.500000000 0.000000000 0.337667352 - 0.500000000 0.000000000 0.120462060 - 0.396399980 0.039700040 0.391968676 - 0.396399980 0.039700040 0.174763383 - 0.603600020 0.960299999 0.283366023 - 0.603600020 0.960299999 0.066160730 - 0.896399970 0.460299960 0.283366023 - 0.896399970 0.460299960 0.066160730 - 0.103600062 0.539699999 0.391968676 - 0.103600062 0.539699999 0.174763383 - 0.697800004 0.699999979 0.434410590 - 0.697800004 0.699999979 0.217205297 - 0.697800004 0.699999979 0.000000000 - 0.302199975 0.300000000 0.240924120 - 0.302199975 0.300000000 0.023718827 - 0.302199975 0.300000000 0.458129412 - 0.197800025 0.800000021 0.240924120 - 0.197800025 0.800000021 0.023718827 - 0.197800025 0.800000021 0.458129412 - 0.802199996 0.200000000 0.434410590 - 0.802199996 0.200000000 0.217205297 - 0.802199996 0.200000000 0.000000000 - 0.302199975 0.300000000 0.325807939 - 0.302199975 0.300000000 0.108602646 - 0.697800004 0.699999979 0.349526760 - 0.697800004 0.699999979 0.132321467 - 0.802199996 0.200000000 0.349526760 - 0.802199996 0.200000000 0.132321467 - 0.197800025 0.800000021 0.325807939 - 0.197800025 0.800000021 0.108602646 diff --git a/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp b/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp deleted file mode 100644 index 926c98e..0000000 --- a/test/cell_edits_identify_terminations_CaZrO3/DTERMINATIONS/lw_term.vasp +++ /dev/null @@ -1,48 +0,0 @@ -calcium zirconate - 1.000000000 - 5.591110229 0.000000000 0.000000000 - 0.000000000 5.761280060 0.000000000 - 0.000000000 0.000000000 15.250490666 -Ca Zr O -8 8 24 -Direct - 0.987499999 0.951499996 0.422961697 - 0.987499999 0.951499996 0.948641147 - 0.012499949 0.048500035 0.160121956 - 0.012499949 0.048500035 0.685801406 - 0.487500009 0.548499993 0.160121956 - 0.487500009 0.548499993 0.685801406 - 0.512499991 0.451500007 0.422961697 - 0.512499991 0.451500007 0.948641147 - 0.000000000 0.500000000 0.554381559 - 0.000000000 0.500000000 0.028702109 - 0.500000000 0.000000000 0.554381559 - 0.500000000 0.000000000 0.028702109 - 0.000000000 0.500000000 0.291541834 - 0.000000000 0.500000000 0.817221284 - 0.500000000 0.000000000 0.291541834 - 0.500000000 0.000000000 0.817221284 - 0.396399980 0.039700040 0.422961697 - 0.396399980 0.039700040 0.948641147 - 0.603600020 0.960299999 0.160121956 - 0.603600020 0.960299999 0.685801406 - 0.896399970 0.460299960 0.160121956 - 0.896399970 0.460299960 0.685801406 - 0.103600062 0.539699999 0.422961697 - 0.103600062 0.539699999 0.948641147 - 0.697800004 0.699999979 0.525679462 - 0.697800004 0.699999979 0.000000012 - 0.302199975 0.300000000 0.057404219 - 0.302199975 0.300000000 0.583083669 - 0.197800025 0.800000021 0.057404219 - 0.197800025 0.800000021 0.583083669 - 0.802199996 0.200000000 0.525679462 - 0.802199996 0.200000000 0.000000012 - 0.302199975 0.300000000 0.262839725 - 0.302199975 0.300000000 0.788519175 - 0.697800004 0.699999979 0.320243928 - 0.697800004 0.699999979 0.845923378 - 0.802199996 0.200000000 0.320243928 - 0.802199996 0.200000000 0.845923378 - 0.197800025 0.800000021 0.262839725 - 0.197800025 0.800000021 0.788519175 From 032ffcd079564eb990c1b2d2ac1ff4bc7f9a05ae Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 07:55:56 +0100 Subject: [PATCH 024/137] Update types --- CMakeLists.txt | 8 +- app/main.f90 | 29 +- src/fortran/aspect.f90 | 26 +- src/fortran/inputs.f90 | 96 +- src/fortran/lib/mod_constants.f90 | 22 +- src/fortran/lib/mod_edit_geom.f90 | 988 +++--- src/fortran/{io.F90 => lib/mod_io_utils.F90} | 163 +- src/fortran/lib/mod_io_utils_extd.F90 | 134 + src/fortran/lib/mod_misc.f90 | 288 +- src/fortran/lib/mod_misc_linalg.f90 | 383 +-- src/fortran/lib/mod_misc_maths.f90 | 405 +-- src/fortran/lib/mod_misc_types.f90 | 33 + src/fortran/lib/mod_rw_geom.f90 | 2895 ++++++++++++----- src/fortran/lib/mod_sym.f90 | 374 +-- src/fortran/lib/mod_tools_infile.f90 | 55 +- .../{interfaces.f90 => mod_generator.f90} | 698 ++-- src/fortran/mod_help.f90 | 21 +- src/fortran/mod_intf_identifier.f90 | 177 +- src/fortran/mod_lat_compare.f90 | 270 +- src/fortran/mod_plane_matching.f90 | 186 +- src/fortran/mod_shifting.f90 | 269 +- src/fortran/mod_swapping.f90 | 64 +- 22 files changed, 4272 insertions(+), 3312 deletions(-) rename src/fortran/{io.F90 => lib/mod_io_utils.F90} (77%) create mode 100644 src/fortran/lib/mod_io_utils_extd.F90 create mode 100644 src/fortran/lib/mod_misc_types.f90 rename src/fortran/{interfaces.f90 => mod_generator.f90} (77%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2eee661..1bcf9c1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -55,17 +55,19 @@ set(LIB_DIR ${FORTRAN_SRC_DIR}/lib) set(LIB_FILES mod_constants.f90 mod_misc.f90 + mod_misc_types.f90 + mod_io_utils.F90 mod_misc_maths.f90 mod_misc_linalg.f90 - mod_tools_infile.f90 mod_rw_geom.f90 mod_edit_geom.f90 + mod_io_utils_extd.F90 mod_sym.f90 + mod_tools_infile.f90 ) # Main source files set(SPECIAL_LIB_FILES - io.F90 aspect.f90 mod_help.f90 mod_intf_identifier.f90 @@ -75,7 +77,7 @@ set(SPECIAL_LIB_FILES mod_shifting.f90 default_infile.f90 inputs.f90 - interfaces.f90 + mod_generator.f90 ) diff --git a/app/main.f90 b/app/main.f90 index ee3bd6b..5f1bc80 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -9,6 +9,9 @@ program artemis_executable implicit none + type(artemis_generator_type) :: generator + + !!!----------------------------------------------------------------------------- !!! set up global variables @@ -28,8 +31,12 @@ program artemis_executable write(6,'(1X,"task ",I0," set",/,1X,"Performing Cell Edits")') task if(lsurf_gen)then write(0,'(1X,"Finding terminations for lower material.")') - call gen_terminations(struc1_lat,struc1_bas,lw_mplane,axis,& - num_layers=lw_num_layers, thickness=lw_thickness) + generator%layer_separation_cutoff(1) = layer_sep + call generator%gen_terminations(struc1_bas,lw_mplane,axis,& + num_layers = lw_num_layers, & + thickness = lw_thickness & + ) + call generator%write_terminations(directory = "DTERMINATIONS") write(0,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop end if @@ -54,22 +61,22 @@ program artemis_executable write(6,'("Skipping...")') else write(6,'(1X,"Finding terminations for lower material.")') - call gen_terminations(struc1_lat,struc1_bas,lw_mplane,axis,& - directory="DLW_TERMS", & - num_layers=lw_num_layers, & - thickness=lw_thickness, & - udef_layer_sep=lw_layer_sep) + generator%layer_separation_cutoff(1) = lw_layer_sep + call generator%gen_terminations(struc1_bas,lw_mplane,axis,& + num_layers = lw_num_layers, & + thickness = lw_thickness & + ) end if if(all(up_mplane.eq.0))then write(6,'("No Miller plane defined for upper material.")') write(6,'("Skipping...")') else write(6,'(1X,"Finding terminations for upper material.")') - call gen_terminations(struc2_lat,struc2_bas,up_mplane,axis,& - directory="DUP_TERMS", & + generator%layer_separation_cutoff(2) = up_layer_sep + call generator%gen_terminations(struc2_bas,up_mplane,axis,& num_layers = up_num_layers, & - thickness = up_thickness, & - udef_layer_sep=up_layer_sep) + thickness = up_thickness & + ) end if write(6,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop diff --git a/src/fortran/aspect.f90 b/src/fortran/aspect.f90 index 0602de3..21220ff 100644 --- a/src/fortran/aspect.f90 +++ b/src/fortran/aspect.f90 @@ -5,8 +5,8 @@ !!! Code part of the ARTEMIS group !!!############################################################################# module aspect - use io - use rw_geom, only: bas_type,clone_bas + use artemis__io_utils, only: err_abort + use artemis__geom_rw, only: basis_type use edit_geom implicit none @@ -25,9 +25,9 @@ module aspect integer :: nedits integer, dimension(nopt_edits) :: list !! lists order of edits to perform integer, dimension(nopt_edits) :: axis - double precision, dimension(nopt_edits) :: val !BOUNDS FOR EACH? - double precision, dimension(nopt_edits,2) :: bounds !BOUNDS FOR EACH? - double precision, dimension(3,3) :: tfmat + real(real32), dimension(nopt_edits) :: val !BOUNDS FOR EACH? + real(real32), dimension(nopt_edits,2) :: bounds !BOUNDS FOR EACH? + real(real32), dimension(3,3) :: tfmat end type aspect_type @@ -46,13 +46,13 @@ module aspect subroutine edit_structure(lat,bas,ofile,edits,lnorm) implicit none integer :: GEOMunit,i - type(bas_type) :: edited_bas - double precision, dimension(3,3) :: edited_lat + type(basis_type) :: edited_bas + real(real32), dimension(3,3) :: edited_lat character(len=*), intent(in) :: ofile logical, optional, intent(in) :: lnorm - type(bas_type), intent(in) :: bas + type(basis_type), intent(in) :: bas type(aspect_type), intent(in) :: edits - double precision, dimension(3,3), intent(in) :: lat + real(real32), dimension(3,3), intent(in) :: lat !!! TAKE ORDER OF TASKS FROM THE ARTEMIS USER INPUT @@ -61,9 +61,7 @@ subroutine edit_structure(lat,bas,ofile,edits,lnorm) !!! YEAH, STORE THIS AS AN ASPECT CUSTOM STRUCTURE, CONTAINS LIST AND ALL OF THIS !!! PUT CUSTOM STRUCTURE ELSEWHERE, BUT WRITING IT HERE FOR NOW - call clone_bas(& - inbas=bas,outbas=edited_bas,& - inlat=lat,outlat=edited_lat) + call edited_bas%copy(bas) do i=1,edits%nedits @@ -76,7 +74,7 @@ subroutine edit_structure(lat,bas,ofile,edits,lnorm) call vacuumer(edited_lat,edited_bas,& edits%axis(i),edits%bounds(i,1),edits%val(i)) case(itransform_index) - call transformer(lat=edited_lat,bas=edited_bas,tfmat=edits%tfmat) + call transformer(basis=edited_bas,tfmat=edits%tfmat) case(islab_index) call err_abort('ERROR: SLAB PRINTER NOT YET SET UP') end select @@ -90,7 +88,7 @@ subroutine edit_structure(lat,bas,ofile,edits,lnorm) GEOMunit=101 open(unit=GEOMunit,file=trim(ofile)) - call geom_write(GEOMunit,edited_lat,edited_bas) + call geom_write(GEOMunit,edited_bas) close(GEOMunit) diff --git a/src/fortran/inputs.f90 b/src/fortran/inputs.f90 index c4a4fc6..e67d531 100644 --- a/src/fortran/inputs.f90 +++ b/src/fortran/inputs.f90 @@ -8,12 +8,16 @@ !!!############################################################################# !!! MAYBE HAVE FINDSYM IN HERE IN ORDER TO EDIT TOLSYM? module inputs - use constants, only: ierror,pi - use misc, only: flagmaker,file_check,to_lower,to_upper - use rw_geom, only: bas_type,geom_read,geom_write - use io + use artemis__constants, only: real32, ierror, pi + use artemis__misc, only: flagmaker,file_check + use artemis__geom_rw, only: basis_type,geom_read + use artemis__io_utils, only: & + artemis__version__, & + print_warning, print_header, & + err_abort + use artemis__io_utils_extd, only: setup_input_fmt, setup_output_fmt use aspect, only: aspect_type, edit_structure - use lat_compare, only: lreduce,get_best_match,latmatch_type,tol_type + use lat_compare, only: lreduce,tol_type use infile_tools use infile_print use mod_sym, only: set_symmetry_tolerance @@ -23,10 +27,10 @@ module inputs integer :: lw_num_layers,up_num_layers integer :: nshift,nterm,nintf,nswap,nmiller real :: max_bondlength,swap_sigma,swap_depth - double precision :: lw_thickness, up_thickness - double precision :: lw_bulk_modulus, up_bulk_modulus - double precision :: c_scale,intf_depth,vacuum - double precision :: layer_sep,lw_layer_sep,up_layer_sep,swap_den,tol_sym + real(real32) :: lw_thickness, up_thickness + real(real32) :: lw_bulk_modulus, up_bulk_modulus + real(real32) :: c_scale,intf_depth,vacuum + real(real32) :: layer_sep,lw_layer_sep,up_layer_sep,swap_den,tol_sym character(len=20) :: input_fmt,output_fmt character(200) :: struc1_file,struc2_file,out_filename character(100) :: dirname,shiftdir,swapdir,subdir_prefix @@ -39,15 +43,15 @@ module inputs logical :: lswap_mirror logical :: lc_fix logical :: lbreak_on_no_term - type(bas_type) :: struc1_bas,struc2_bas + type(basis_type) :: struc1_bas,struc2_bas type(tol_type) :: tolerance type(aspect_type) :: edits integer, dimension(2) :: lw_surf,up_surf integer, dimension(3) :: lw_mplane,up_mplane integer, allocatable, dimension(:) :: seed - double precision, dimension(2) :: udef_intf_loc - double precision, allocatable, dimension(:,:) :: offset - double precision, dimension(3,3) :: struc1_lat,struc2_lat + real(real32), dimension(2) :: udef_intf_loc + real(real32), allocatable, dimension(:,:) :: offset + real(real32), dimension(3,3) :: struc1_lat,struc2_lat !!!updated 2023/03/27 @@ -88,10 +92,10 @@ subroutine set_global_vars() imatch=0 ishift=4 idepth=0 !!! SWAP DEFAULT DEPTH METHOD !!! - intf_depth=1.5D0 - layer_sep=1.D0 - lw_layer_sep=0.D0 - up_layer_sep=0.D0 + intf_depth=1.5_real32 + layer_sep=1._real32 + lw_layer_sep=0._real32 + up_layer_sep=0._real32 lortho = .true. lsurf_gen=.false. up_mplane=(/0,0,0/) @@ -99,25 +103,25 @@ subroutine set_global_vars() axis=3 lw_num_layers=0 up_num_layers=0 - lw_thickness=-1.D0 - up_thickness=-1.D0 - vacuum=14.D0 + lw_thickness=-1._real32 + up_thickness=-1._real32 + vacuum=14._real32 lw_surf=0 up_surf=0 - c_scale=1.5D0 + c_scale=1.5_real32 max_bondlength=4.0 nmiller=10 nshift=5 nterm=5 nintf=100 tolerance%nstore=5 - tolerance%maxlen=20.D0 - tolerance%maxarea=400.D0 + tolerance%maxlen=20._real32 + tolerance%maxarea=400._real32 tolerance%maxfit=100 tolerance%maxsize=10 - tolerance%vec=5.D0 - tolerance%ang=1.D0 - tolerance%area=10.D0 + tolerance%vec=5._real32 + tolerance%ang=1._real32 + tolerance%area=10._real32 lprint_terms=.false. lprint_shifts=.false. lprint_matches=.false. @@ -140,7 +144,7 @@ subroutine set_global_vars() up_surf=0 iintf=-1 tol_sym = 1.D-6 - udef_intf_loc = [ -1.D0, -1.D0 ] + udef_intf_loc = [ -1._real32, -1._real32 ] lw_use_pricel=.true. up_use_pricel=.true. @@ -230,7 +234,7 @@ subroutine set_global_vars() if(.not.empty) read(buffer,*) ierror elseif(index(buffer,'--version').eq.1)then flag="--version" - write(6,'(1X,"ARTEMIS version: ",A)') trim(version) + write(6,'(1X,"ARTEMIS version: ",A)') trim(artemis__version__) stop elseif(index(buffer,'-h').eq.1.or.index(buffer,'--help').eq.1)then flag="--help" @@ -314,9 +318,9 @@ subroutine set_global_vars() !!!----------------------------------------------------------------------------- !!! readjust interface tolerances !!!----------------------------------------------------------------------------- - tolerance%vec=tolerance%vec/100.D0 - tolerance%ang=tolerance%ang*pi/180.D0 - tolerance%area=tolerance%area/100.D0 + tolerance%vec=tolerance%vec/100._real32 + tolerance%ang=tolerance%ang*pi/180._real32 + tolerance%area=tolerance%area/100._real32 !!!----------------------------------------------------------------------------- @@ -335,7 +339,7 @@ subroutine set_global_vars() !!!----------------------------------------------------------------------------- GEOMunit=10 call file_check(GEOMunit,struc1_file) - call geom_read(GEOMunit,struc1_lat,struc1_bas,4) + call geom_read(GEOMunit,struc1_bas,4) close(GEOMunit) lpresent_struc2 = .false. !!-------------------------------------------------------------------------- @@ -357,7 +361,7 @@ subroutine set_global_vars() lpresent_struc2 = .true. GEOMunit=11 call file_check(GEOMunit,struc2_file) - call geom_read(GEOMunit,struc2_lat,struc2_bas,4) + call geom_read(GEOMunit,struc2_bas,4) close(GEOMunit) end if @@ -365,7 +369,7 @@ subroutine set_global_vars() !!!----------------------------------------------------------------------------- !!! changes interface depth depending on IDEPTH method !!!----------------------------------------------------------------------------- - if(idepth.eq.0) intf_depth=0.D0 + if(idepth.eq.0) intf_depth=0._real32 @@ -385,19 +389,19 @@ subroutine set_global_vars() write(6,'(A)') repeat("#",50) - if(lw_thickness.gt.0.D0.and.lw_num_layers.gt.0)then + if(lw_thickness.gt.0._real32.and.lw_num_layers.gt.0)then write(0,'(1X,A)') "WARNING: SLAB THICKNESS AND NUMBER OF LAYERS BOTH DEFINED" write(0,'(1X,A)') " SLAB THICKNESS OVERRIDES NUMBER OF LAYERS" lw_num_layers=0 - elseif(lw_thickness.le.0.D0.and.lw_num_layers.le.0)then - lw_thickness = 10.D0 + elseif(lw_thickness.le.0._real32.and.lw_num_layers.le.0)then + lw_thickness = 10._real32 end if - if(up_thickness.gt.0.D0.and.up_num_layers.gt.0)then + if(up_thickness.gt.0._real32.and.up_num_layers.gt.0)then write(0,'(1X,A)') "WARNING: SLAB THICKNESS AND NUMBER OF LAYERS BOTH DEFINED" write(0,'(1X,A)') " SLAB THICKNESS OVERRIDES NUMBER OF LAYERS" up_num_layers=0 - elseif(up_thickness.le.0.D0.and.up_num_layers.le.0)then - up_thickness = 10.D0 + elseif(up_thickness.le.0._real32.and.up_num_layers.le.0)then + up_thickness = 10._real32 end if return @@ -756,12 +760,12 @@ subroutine read_card_interfaces(unit,count,skip) allocate(offset(1,3)) select case(icount(store)) case(1) - offset(1,:)=0.D0 + offset(1,:)=0._real32 read(store,*) offset(1,3) iudef_nshift = 1 case(3) read(store,*) offset(1,:) - if(all(offset.ge.0.D0)) iudef_nshift=1 + if(all(offset.ge.0._real32)) iudef_nshift=1 case default call err_abort('ERROR: Invalid number of arguments provided to SHIFT& &\nValid number of arguments is 1 or 3.&') @@ -877,13 +881,13 @@ subroutine read_card_interfaces(unit,count,skip) if(readvar(25).eq.0)then select case(ishift) case(0,4) - c_scale = 1.D0 + c_scale = 1._real32 end select end if if(ludef_offset)then - if(readvar(22).eq.1.and.ishift.ne.0.and.all(offset.ge.0.D0))then + if(readvar(22).eq.1.and.ishift.ne.0.and.all(offset.ge.0._real32))then write(0,*) "ISHIFT = ",ishift write(0,*) "SHIFT = ",offset call err_abort('ERROR: Contradictory tags used (ISHIFT and SHIFT) & @@ -892,13 +896,13 @@ subroutine read_card_interfaces(unit,count,skip) elseif(readvar(22).eq.1.and.ishift.ne.0.and.size(offset(:,1),dim=1).gt.1)then call err_abort('ERROR: Contradictory tags used (ISHIFT and SHIFT) & &\nExiting...',.true.) - elseif(all(offset.ge.0.D0))then + elseif(all(offset.ge.0._real32))then ishift=0 nshift=iudef_nshift end if else allocate(offset(1,3)) - offset(1,:)=(/-1.D0,-1.D0,-1.D0/) + offset(1,:)=(/-1._real32,-1._real32,-1._real32/) end if ! set lw_ and up_layer_sep if not defined diff --git a/src/fortran/lib/mod_constants.f90 b/src/fortran/lib/mod_constants.f90 index bd301c7..63e6102 100644 --- a/src/fortran/lib/mod_constants.f90 +++ b/src/fortran/lib/mod_constants.f90 @@ -1,13 +1,13 @@ -MODULE constants +module artemis__constants implicit none - real, parameter, public :: k_b = 1.3806503e-23 - real, parameter, public :: hbar = 1.05457148e-34 - real, parameter, public :: h = 6.626068e-34 - real, parameter, public :: atomic_mass=1.67262158e-27 - real, parameter, public :: avogadros=6.022e23 - real, parameter, public :: bohrtoang=0.529177249 - integer, parameter, public :: real12 = Selected_real_kind(15,307) - double precision, parameter, public :: pi = 4.D0*atan(1.D0) - double precision, parameter, public :: INF = huge(0.D0) + integer, parameter, public :: real32 = Selected_real_kind(6,37) + real(real32), parameter, public :: k_b = 1.3806503e-23_real32 + real(real32), parameter, public :: hbar = 1.05457148e-34_real32 + real(real32), parameter, public :: h = 6.626068e-34_real32 + real(real32), parameter, public :: atomic_mass=1.67262158e-27_real32 + real(real32), parameter, public :: avogadros=6.022e23_real32 + real(real32), parameter, public :: bohrtoang=0.529177249_real32 + real(real32), parameter, public :: pi = 4._real32*atan(1._real32) + real(real32), parameter, public :: INF = huge(0._real32) integer, public :: ierror = -1 -end MODULE constants +end MODULE artemis__constants diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 index 8b68b89..07f583a 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_edit_geom.f90 @@ -36,8 +36,9 @@ !!! get_shortest_bond !!!############################################################################# module edit_geom - use rw_geom, only: bas_type,geom_write,convert_bas,clone_bas - use misc, only: swap_i,swap_d,swap_vec + use artemis__constants, only: real32 + use artemis__geom_rw, only: basis_type,geom_write + use artemis__misc, only: swap use misc_linalg, only: cross,outer_product,cross_matrix,uvec,modu,& get_vol,det,inverse,inverse_3x3,LUinv,reduce_vec_gcd,get_vec_multiple,& proj,GramSchmidt,LLL_reduce @@ -50,7 +51,7 @@ module edit_geom type(wyck_atom_type), allocatable, dimension(:) :: spec end type wyck_spec_type type bond_type - double precision :: length + real(real32) :: length integer, dimension(2,2) :: atoms end type bond_type @@ -73,7 +74,7 @@ module edit_geom !!!############################################################################# function MATNORM(lat) result(nlat) implicit none - double precision, dimension(3,3) :: lat, nlat + real(real32), dimension(3,3) :: lat, nlat nlat(1,1)=sqrt(lat(1,1)**2+lat(1,2)**2+lat(1,3)**2) nlat(1,2)=0.0 nlat(1,3)=0.0 @@ -106,9 +107,9 @@ end function MATNORM function min_dist(bas,axis,loc,above) implicit none integer :: is,axis - double precision :: min_dist,pos - double precision, intent(in) :: loc - type(bas_type) :: bas + real(real32) :: min_dist,pos + real(real32), intent(in) :: loc + type(basis_type) :: bas logical :: labove logical,optional :: above @@ -117,25 +118,25 @@ function min_dist(bas,axis,loc,above) labove=.false. if(present(above)) labove=above aboveloop: if(labove)then - min_dist=huge(0.D0) + min_dist=huge(0._real32) if(all( (/ (bas%spec(is)%atom(:,axis),is=1,bas%nspec) /).lt.pos))& - pos=pos-1.D0 + pos=pos-1._real32 else - min_dist=-huge(0.D0) + min_dist=-huge(0._real32) if(all( (/ (bas%spec(is)%atom(:,axis),is=1,bas%nspec) /).gt.pos))& - pos=pos-1.D0 + pos=pos-1._real32 end if aboveloop do is=1,bas%nspec if(.not.labove.and.maxval(bas%spec(is)%atom(:,axis)-pos,& - mask=(bas%spec(is)%atom(:,axis)-pos.le.0.D0)).gt.min_dist) then + mask=(bas%spec(is)%atom(:,axis)-pos.le.0._real32)).gt.min_dist) then min_dist=maxval(bas%spec(is)%atom(:,axis)-pos,& - mask=(bas%spec(is)%atom(:,axis)-pos.le.0.D0)) + mask=(bas%spec(is)%atom(:,axis)-pos.le.0._real32)) elseif(labove.and.minval(bas%spec(is)%atom(:,axis)-pos,& - mask=(bas%spec(is)%atom(:,axis)-pos.ge.0.D0)).lt.min_dist) then + mask=(bas%spec(is)%atom(:,axis)-pos.ge.0._real32)).lt.min_dist) then min_dist=minval(bas%spec(is)%atom(:,axis)-pos,& - mask=(bas%spec(is)%atom(:,axis)-pos.ge.0.D0)) + mask=(bas%spec(is)%atom(:,axis)-pos.ge.0._real32)) end if end do @@ -149,10 +150,10 @@ end function min_dist function get_atom_height(bas,atom,axis) result(val) implicit none integer :: i,axis,atom,sum_atom - double precision :: val - type(bas_type) :: bas + real(real32) :: val + type(basis_type) :: bas - val=0.D0 + val=0._real32 sum_atom=0 do i=1,bas%nspec if(atom.le.sum_atom+bas%spec(i)%num)then @@ -173,13 +174,13 @@ end function get_atom_height function get_min_bulk_bond(lat,bas) result(min_bond) implicit none integer :: is,ia,js,ja - double precision :: dtmp1,min_bond - type(bas_type) :: bas - double precision, dimension(3) :: vdtmp1 - double precision, dimension(3,3) :: lat + real(real32) :: dtmp1,min_bond + type(basis_type) :: bas + real(real32), dimension(3) :: vdtmp1 + real(real32), dimension(3,3) :: lat - min_bond=huge(0.D0) + min_bond=huge(0._real32) if(bas%natom.eq.1)then min_bond = min(modu(lat(1,:3)),modu(lat(2,:3)),modu(lat(3,:3))) return @@ -215,16 +216,16 @@ function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) implicit none integer :: js,ja integer :: iaxis - double precision :: dtmp1,min_bond,dtol + real(real32) :: dtmp1,min_bond,dtol logical :: ludef_above - double precision, dimension(3) :: vdtmp1, vsave + real(real32), dimension(3) :: vdtmp1, vsave integer, intent(in) :: is,ia - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in) :: lat integer, intent(in), optional :: axis - double precision, intent(in), optional :: tol + real(real32), intent(in), optional :: tol logical, intent(in), optional :: labove if(present(tol))then @@ -245,7 +246,7 @@ function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) iaxis=0 end if - min_bond=huge(0.D0) + min_bond=huge(0._real32) do js=1,bas%nspec atmloop: do ja=1,bas%spec(js)%num @@ -254,9 +255,9 @@ function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) if(iaxis.gt.0)then if(abs(vdtmp1(iaxis)).lt.dtol) cycle atmloop if(ludef_above)then - vdtmp1(iaxis) = 1.D0 + vdtmp1(iaxis) + vdtmp1(iaxis) = 1._real32 + vdtmp1(iaxis) else - vdtmp1(iaxis) = vdtmp1(iaxis) - 1.D0 + vdtmp1(iaxis) = vdtmp1(iaxis) - 1._real32 end if end if vdtmp1 = & @@ -284,17 +285,17 @@ function get_min_dist(lat,bas,loc,lignore_close,axis,labove,lreal,tol) & implicit none integer :: js,ja integer :: iaxis - double precision :: dtmp1,min_bond,dtol + real(real32) :: dtmp1,min_bond,dtol logical :: ludef_above,ludef_real - double precision, dimension(3) :: vdtmp1,vdtmp2,vsave + real(real32), dimension(3) :: vdtmp1,vdtmp2,vsave logical, intent(in) :: lignore_close - type(bas_type), intent(in) :: bas - double precision, dimension(3), intent(in) :: loc - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3), intent(in) :: loc + real(real32), dimension(3,3), intent(in) :: lat integer, intent(in), optional :: axis - double precision, intent(in), optional :: tol + real(real32), intent(in), optional :: tol logical, intent(in), optional :: labove, lreal !! CORRECT tol TO ACCOUNT FOR LATTICE SIZE @@ -322,8 +323,8 @@ function get_min_dist(lat,bas,loc,lignore_close,axis,labove,lreal,tol) & iaxis=0 end if - min_bond=huge(0.D0) - vsave = 0.D0 + min_bond=huge(0._real32) + vsave = 0._real32 do js=1,bas%nspec atmloop: do ja=1,bas%spec(js)%num vdtmp1 = bas%spec(js)%atom(ja,:3) - loc @@ -331,9 +332,9 @@ function get_min_dist(lat,bas,loc,lignore_close,axis,labove,lreal,tol) & if(iaxis.gt.0)then if(abs(vdtmp1(iaxis)).lt.dtol) cycle atmloop if(ludef_above)then - vdtmp1(iaxis) = 1.D0 + vdtmp1(iaxis) + vdtmp1(iaxis) = 1._real32 + vdtmp1(iaxis) else - vdtmp1(iaxis) = vdtmp1(iaxis) - 1.D0 + vdtmp1(iaxis) = vdtmp1(iaxis) - 1._real32 end if end if vdtmp2 = & @@ -363,8 +364,8 @@ end function get_min_dist subroutine shifter(bas,axis,shift,ltmp) implicit none integer :: i,j,k,axis - double precision :: shift - type(bas_type) :: bas + real(real32) :: shift + type(basis_type) :: bas logical, optional ::ltmp logical :: lrenorm @@ -390,8 +391,8 @@ end subroutine shifter subroutine shift_region(bas,region_axis,region_lw,region_up,shift_axis,shift,renorm) implicit none integer :: is,ia,shift_axis,region_axis - double precision :: shift,region_lw,region_up - type(bas_type) :: bas + real(real32) :: shift,region_lw,region_up + type(basis_type) :: bas logical, optional ::renorm logical :: lrenorm @@ -420,16 +421,16 @@ end subroutine shift_region !!!############################################################################# function get_surface_normal(lat,axis) result(normal) implicit none - double precision :: component + real(real32) :: component integer, dimension(3) :: order=(/1,2,3/) - double precision, dimension(3) :: normal + real(real32), dimension(3) :: normal integer, intent(in) :: axis - double precision, dimension(3,3), intent(in) :: lat + real(real32), dimension(3,3), intent(in) :: lat order = cshift(order,3-axis) normal = cross([lat(order(1),:)],[lat(order(2),:)]) - component = dot_product(lat(3,:),normal) / modu(normal)**2.D0 + component = dot_product(lat(3,:),normal) / modu(normal)**2._real32 normal = normal * component return @@ -444,16 +445,16 @@ end function get_surface_normal subroutine vacuumer(lat,bas,axis,loc,add,tol) implicit none integer :: is,ia - double precision :: rtol,rloc,ortho_scale - double precision :: cur_vac,inc,diff,mag_old,mag_new - double precision,dimension(3) :: normal + real(real32) :: rtol,rloc,ortho_scale + real(real32) :: cur_vac,inc,diff,mag_old,mag_new + real(real32),dimension(3) :: normal integer, intent(in) :: axis - double precision, intent(in) :: add,loc - type(bas_type), intent(inout) :: bas - double precision,dimension(3,3), intent(inout) :: lat + real(real32), intent(in) :: add,loc + type(basis_type), intent(inout) :: bas + real(real32),dimension(3,3), intent(inout) :: lat - double precision, optional, intent(in) :: tol + real(real32), optional, intent(in) :: tol !! get surface normal vector @@ -467,7 +468,7 @@ subroutine vacuumer(lat,bas,axis,loc,add,tol) cur_vac = min_dist(bas,axis,loc,.true.) - min_dist(bas,axis,loc,.false.) cur_vac = cur_vac * modu(lat(axis,:)) diff = cur_vac + inc - if(diff.lt.0.D0)then + if(diff.lt.0._real32)then write(0,*) "WARNING! Removing vacuum entirely" end if @@ -497,49 +498,48 @@ end subroutine vacuumer !!! Adjusts the amount of vacuum at a location ... !!! ... within a cell and adjusts the basis accordingly !!!############################################################################# - subroutine set_vacuum(lat,bas,axis,loc,vac,tol) + subroutine set_vacuum(basis,axis,loc,vac,tol) implicit none integer :: is,ia - double precision :: rtol,rloc,ortho_scale - double precision :: cur_vac,diff,mag_old,mag_new - double precision,dimension(3) :: normal + real(real32) :: rtol,rloc,ortho_scale + real(real32) :: cur_vac,diff,mag_old,mag_new + real(real32),dimension(3) :: normal integer, intent(in) :: axis - double precision, intent(in) :: vac,loc - type(bas_type), intent(inout) :: bas - double precision,dimension(3,3), intent(inout) :: lat + real(real32), intent(in) :: vac,loc + type(basis_type), intent(inout) :: basis - double precision, optional, intent(in) :: tol + real(real32), optional, intent(in) :: tol !! get surface normal vector - normal = get_surface_normal(lat,axis) - ortho_scale = modu(lat(axis,:))/modu(normal) + normal = get_surface_normal(basis%lat,axis) + ortho_scale = modu(basis%lat(axis,:))/modu(normal) - rtol = 0.D0 + rtol = 0._real32 if(present(tol)) rtol = tol - if(vac.lt.0.D0)then + if(vac.lt.0._real32)then write(0,*) "WARNING! Removing vacuum entirely" end if - cur_vac = min_dist(bas,axis,loc,.true.) - min_dist(bas,axis,loc,.false.) + cur_vac = min_dist(basis,axis,loc,.true.) - min_dist(basis,axis,loc,.false.) cur_vac = cur_vac * modu(normal) diff = ( vac - cur_vac ) * ortho_scale - mag_old = modu(lat(axis,:)) + mag_old = modu(basis%lat(axis,:)) mag_new = ( mag_old + diff ) / mag_old - lat(axis,:) = lat(axis,:) * mag_new - diff = diff / modu(lat(axis,:)) + basis%lat(axis,:) = basis%lat(axis,:) * mag_new + diff = diff / modu(basis%lat(axis,:)) rtol = rtol / mag_old rloc = loc / mag_new + rtol - do is=1,bas%nspec - do ia=1,bas%spec(is)%num - bas%spec(is)%atom(ia,axis) = bas%spec(is)%atom(ia,axis) / mag_new - if(bas%spec(is)%atom(ia,axis).gt.rloc) then - bas%spec(is)%atom(ia,axis) = bas%spec(is)%atom(ia,axis) + diff + do is=1,basis%nspec + do ia=1,basis%spec(is)%num + basis%spec(is)%atom(ia,axis) = basis%spec(is)%atom(ia,axis) / mag_new + if(basis%spec(is)%atom(ia,axis).gt.rloc) then + basis%spec(is)%atom(ia,axis) = basis%spec(is)%atom(ia,axis) + diff end if end do end do @@ -556,25 +556,23 @@ end subroutine set_vacuum subroutine ortho_axis(lat,bas,axis) implicit none integer :: axis - double precision :: ortho_comp - type(bas_type) :: bas + real(real32) :: ortho_comp + type(basis_type) :: bas integer, dimension(3) :: order - double precision, dimension(3) :: ortho_vec - double precision, dimension(3,3) :: invlat,lat + real(real32), dimension(3) :: ortho_vec + real(real32), dimension(3,3) :: invlat,lat - bas=convert_bas(bas,transpose(lat)) + call bas%convert() order=(/1,2,3/) order=cshift(order,3-axis) ortho_vec=cross(lat(order(1),:),lat(order(2),:)) - ortho_comp=dot_product(lat(3,:),ortho_vec)/modu(ortho_vec)**2.D0 + ortho_comp=dot_product(lat(3,:),ortho_vec)/modu(ortho_vec)**2._real32 ortho_vec=ortho_vec*ortho_comp lat(3,:)=ortho_vec - invlat=inverse_3x3(lat) - bas=convert_bas(bas,transpose(invlat)) - + call bas%change_lattice(lat) return end subroutine ortho_axis @@ -585,37 +583,38 @@ end subroutine ortho_axis !!! Applies a transformation matrix to a lattice ... !!! ... and extends the basis where needed !!!############################################################################# - subroutine transformer(lat,bas,tfmat,map) + subroutine transformer(basis, tfmat, map) implicit none integer :: i,j,k,l,m,n,is,ia integer :: satom,dim - double precision :: tol,vol_inc + real(real32) :: tol,vol_inc logical :: lmap - type(bas_type) :: bas,sbas + type(basis_type), intent(inout) :: basis + type(basis_type) :: sbas integer, dimension(3) :: latmin,latmax - double precision, dimension(3):: translvec,tolvec + real(real32), dimension(3):: translvec,tolvec integer, allocatable, dimension(:) :: tmp_map_atom integer, allocatable, dimension(:,:,:) :: new_map - double precision, allocatable, dimension(:,:) :: tmpbas - double precision, dimension(3,3) :: lat,slat,tfmat,invmat + real(real32), allocatable, dimension(:,:) :: tmpbas + real(real32), dimension(3,3) :: tfmat,invmat integer, allocatable, dimension(:,:,:), optional, intent(inout) :: map - vol_inc = abs(det(lat)) - if(vol_inc.lt.0.5D0)then + vol_inc = abs(det(basis%lat)) + if(vol_inc.lt.0.5_real32)then write(0,'(1X,"ERROR: Internal error in transformer function")') write(0,'(2X,"transformer in mod_edit_geom.f90 been supplied a& & lattice with almost zero determinant")') write(0,'(2X,"determinant = ",F0.9)') vol_inc - write(0,'(3(1X,F7.2))') lat + write(0,'(3(1X,F7.2))') basis%lat stop end if - call normalise_basis(bas,1.D0,lfloor=.true.,lround=.false.) + call basis%normalise(ceil_val = 1._real32, floor_coords = .true., round_coords = .false.) vol_inc=abs(det(tfmat)) - slat=matmul(tfmat,lat) + sbas%lat=matmul(tfmat,basis%lat) invmat=inverse_3x3(tfmat) - translvec=0.D0 - dim=size(bas%spec(1)%atom(1,:)) + translvec=0._real32 + dim=size(basis%spec(1)%atom(1,:)) !!-------------------------------------------------------------------------- @@ -628,13 +627,13 @@ subroutine transformer(lat,bas,tfmat,map) end if lmap = .true. allocate(new_map(& - bas%nspec,& - ceiling(vol_inc)*maxval(bas%spec(:)%num,dim=1),2)) + basis%nspec,& + ceiling(vol_inc)*maxval(basis%spec(:)%num,dim=1),2)) new_map=0 if(all(map.eq.0))then - do is=1,bas%nspec - map(is,:bas%spec(is)%num,1) = is - do ia=1,bas%spec(is)%num + do is=1,basis%nspec + map(is,:basis%spec(is)%num,1) = is + do ia=1,basis%spec(is)%num map(is,ia,2) = ia end do end do @@ -647,7 +646,7 @@ subroutine transformer(lat,bas,tfmat,map) !!-------------------------------------------------------------------------- tol=1.D-3 !! in Å do i=1,3 - tolvec(i)=tol/modu(slat(i,:)) + tolvec(i)=tol/modu(sbas%lat(i,:)) end do if(vol_inc.lt.minval(tolvec))then write(0,'(1X,"ERROR: Internal error in transformer function")') @@ -685,20 +684,20 @@ subroutine transformer(lat,bas,tfmat,map) !!---------------------------------- !latmin(i)=(minval(invmat(i,:))-ceiling(minval(invmat(i,:))))*vol !latmax(i)=(maxval(invmat(i,:))-floor(minval(invmat(i,:))))*vol - !latmin(i)=(min(minval(invmat(i,:)),0.D0)-ceiling(minval(invmat(i,:))))*vol + !latmin(i)=(min(minval(invmat(i,:)),0._real32)-ceiling(minval(invmat(i,:))))*vol !latmax(i)=(ceiling(maxval(invmat(i,:3)))-maxval(invmat(i,:3)) )*vol do i=1,3 - latmin(i)=floor(sum(tfmat(:3,i),mask=tfmat(:3,i).lt.0.D0))-1 - latmax(i)=ceiling(sum(tfmat(:3,i),mask=tfmat(:3,i).gt.0.D0))+1 + latmin(i)=floor(sum(tfmat(:3,i),mask=tfmat(:3,i).lt.0._real32))-1 + latmax(i)=ceiling(sum(tfmat(:3,i),mask=tfmat(:3,i).gt.0._real32))+1 end do !!-------------------------------------------------------------------------- !! transform the basis !!-------------------------------------------------------------------------- - do i=1,bas%nspec - do j=1,bas%spec(i)%num - bas%spec(i)%atom(j,:3)=matmul(bas%spec(i)%atom(j,:3),invmat) + do i=1,basis%nspec + do j=1,basis%spec(i)%num + basis%spec(i)%atom(j,:3)=matmul(basis%spec(i)%atom(j,:3),invmat) end do end do @@ -706,21 +705,21 @@ subroutine transformer(lat,bas,tfmat,map) !!-------------------------------------------------------------------------- !! generates atoms to fill the supercell !!-------------------------------------------------------------------------- - allocate(sbas%spec(bas%nspec)) - sbas%sysname=bas%sysname - sbas%nspec=0 - sbas%natom=0 - spec_loop1: do is=1,bas%nspec + allocate(sbas%spec(basis%nspec)) + sbas%sysname = basis%sysname + sbas%nspec = 0 + sbas%natom = 0 + spec_loop1: do is = 1, basis%nspec if(allocated(tmpbas)) deallocate(tmpbas) - allocate(tmpbas(bas%spec(is)%num*(& + allocate(tmpbas(basis%spec(is)%num*(& (abs(latmax(3))+abs(latmin(3))+1)*& (abs(latmax(2))+abs(latmin(2))+1)*& (abs(latmax(1))+abs(latmin(1))+1)),3)) satom=0 if(lmap)then - allocate(tmp_map_atom(ceiling(vol_inc)*bas%spec(is)%num)) + allocate(tmp_map_atom(ceiling(vol_inc)*basis%spec(is)%num)) end if - do ia=1,bas%spec(is)%num + do ia = 1, basis%spec(is)%num do n=latmin(3),latmax(3)!,1 translvec(3)=dble(n) do m=latmin(2),latmax(2)!,1 @@ -728,22 +727,22 @@ subroutine transformer(lat,bas,tfmat,map) inloop: do l=latmin(1),latmax(1)!,1 translvec(1)=dble(l) tmpbas(satom+1,:3) = & - bas%spec(is)%atom(ia,:3) + matmul(translvec,invmat) + basis%spec(is)%atom(ia,:3) + matmul(translvec,invmat) !!tmpbas(satom+1,:3)=& - !! matmul((bas%spec(is)%atom(ia,:3)+translvec),invmat) + !! matmul((basis%spec(is)%atom(ia,:3)+translvec),invmat) !where(abs(tmpbas(satom+1,:3)-nint(tmpbas(satom+1,k))).lt.tol) ! tmpbas(satom+1,:3)=nint(tmpbas(satom+1,:3)) !end where - !if(any(tmpbas(satom+1,:).ge.1.D0).or.& - ! any(tmpbas(satom+1,:).lt.0.D0)) cycle - !if(any(tmpbas(satom+1,:).ge.1.D0+tol).or.& - ! any(tmpbas(satom+1,:).lt.0.D0-tol)) cycle - if(any(tmpbas(satom+1,:).ge.1.D0-tol).or.& - any(tmpbas(satom+1,:).lt.0.D0-tol)) cycle inloop !??? cycle inloop or spec_loop1? + !if(any(tmpbas(satom+1,:).ge.1._real32).or.& + ! any(tmpbas(satom+1,:).lt.0._real32)) cycle + !if(any(tmpbas(satom+1,:).ge.1._real32+tol).or.& + ! any(tmpbas(satom+1,:).lt.0._real32-tol)) cycle + if(any(tmpbas(satom+1,:).ge.1._real32-tol).or.& + any(tmpbas(satom+1,:).lt.0._real32-tol)) cycle inloop !??? cycle inloop or spec_loop1? tmpbas(satom+1,:3) = tmpbas(satom+1,:3) - & dble(floor(tmpbas(satom+1,:3))) do k=1,satom - if(all(mod(abs(tmpbas(satom+1,:3)-tmpbas(k,:3)),1.D0).le.& + if(all(mod(abs(tmpbas(satom+1,:3)-tmpbas(k,:3)),1._real32).le.& tol)) cycle inloop end do if(lmap) tmp_map_atom(satom+1)=map(is,ia,2) @@ -759,12 +758,12 @@ subroutine transformer(lat,bas,tfmat,map) sbas%nspec=sbas%nspec+1 sbas%spec(sbas%nspec)%num=satom sbas%natom=sbas%natom+satom - sbas%spec(sbas%nspec)%name=bas%spec(is)%name + sbas%spec(sbas%nspec)%name=basis%spec(is)%name allocate(sbas%spec(sbas%nspec)%atom(satom,dim)) sbas%spec(sbas%nspec)%atom(1:satom,:3)=tmpbas(1:satom,:3) - if(dim.eq.4) sbas%spec(sbas%nspec)%atom(1:satom,4)=1.D0 + if(dim.eq.4) sbas%spec(sbas%nspec)%atom(1:satom,4)=1._real32 deallocate(tmpbas) - deallocate(bas%spec(is)%atom) + deallocate(basis%spec(is)%atom) if(lmap)then new_map(sbas%nspec,:satom,1) = is new_map(sbas%nspec,:satom,2) = tmp_map_atom(:satom) @@ -777,16 +776,16 @@ subroutine transformer(lat,bas,tfmat,map) !! check to see if successfully generated correct number of atoms !!-------------------------------------------------------------------------- if(all(abs(tfmat-nint(tfmat)).lt.tol))then - if(nint(bas%natom*vol_inc).ne.sbas%natom)then + if(nint(basis%natom*vol_inc).ne.sbas%natom)then write(0,'(1X,"ERROR: Internal error in transformer function")') write(0,'(2X,"Transformer in mod_edit_geom.f90 has failed to & &generate enough atoms when extending the cell")') write(0,'(2X,"Generated ",I0," atoms, whilst expecting ",I0," atoms")') & - sbas%natom,nint(bas%natom*vol_inc) - write(0,*) bas%natom,nint(vol_inc) + sbas%natom,nint(basis%natom*vol_inc) + write(0,*) basis%natom,nint(vol_inc) write(0,'(3(1X,F7.2))') tfmat open(60,file="broken_cell.vasp") - call geom_write(60,slat,sbas) + call geom_write(60,sbas) close(60) stop end if @@ -796,15 +795,15 @@ subroutine transformer(lat,bas,tfmat,map) !!-------------------------------------------------------------------------- !! saves new lattice and basis to original set !!-------------------------------------------------------------------------- - lat=slat - deallocate(bas%spec) - allocate(bas%spec(sbas%nspec)) - bas%sysname=sbas%sysname - bas%nspec=sbas%nspec - bas%natom=sbas%natom + basis%lat = sbas%lat + deallocate(basis%spec) + allocate(basis%spec(sbas%nspec)) + basis%sysname=sbas%sysname + basis%nspec=sbas%nspec + basis%natom=sbas%natom do i=1,sbas%nspec - allocate(bas%spec(i)%atom(sbas%spec(i)%num,dim)) - bas%spec(i)=sbas%spec(i) + allocate(basis%spec(i)%atom(sbas%spec(i)%num,dim)) + basis%spec(i)=sbas%spec(i) end do @@ -828,9 +827,9 @@ end subroutine transformer !!!############################################################################# function change_basis(vec,old_lat,new_lat) implicit none - double precision, dimension(3) :: change_basis,vec - double precision, dimension(3,3), intent(in) :: old_lat,new_lat - double precision, dimension(3,3) :: inew_lat + real(real32), dimension(3) :: change_basis,vec + real(real32), dimension(3,3), intent(in) :: old_lat,new_lat + real(real32), dimension(3,3) :: inew_lat inew_lat=inverse_3x3(new_lat) change_basis=matmul(transpose(inew_lat),matmul(old_lat,vec)) end function change_basis @@ -843,22 +842,22 @@ end function change_basis subroutine region_rot(bas,lat,angle,axis,bound1,bound2,tvec) implicit none integer :: axis,i,j - double precision :: angle,bound1,bound2 - double precision, dimension(3) :: u,centre - double precision, dimension(3,3) :: rotmat,ident,lat,invlat - type(bas_type) :: bas - double precision, optional, dimension(3) :: tvec + real(real32) :: angle,bound1,bound2 + real(real32), dimension(3) :: u,centre + real(real32), dimension(3,3) :: rotmat,ident,lat,invlat + type(basis_type) :: bas + real(real32), optional, dimension(3) :: tvec centre=(/0.5,0.5,0.0/) if(present(tvec)) centre=tvec - ident=0.D0 + ident=0._real32 do i=1,3 - ident(i,i)=1.D0 + ident(i,i)=1._real32 end do !!! DEFINE ROTMAT BEFORE THIS - u=0.D0 - u(axis)=-1.D0 + u=0._real32 + u(axis)=-1._real32 rotmat=& (cos(angle)*ident)+& (sin(angle))*cross_matrix(u)+& @@ -887,67 +886,16 @@ end subroutine region_rot !!!############################################################################# -!!!############################################################################# -!!! convert basis coordinates to be within +val -> val-1 -!!!############################################################################# - subroutine normalise_basis(bas,dtmp,lfloor,lround,zero_round) - implicit none - integer :: is,ia,j - double precision :: ceil,flr,dround - double precision, optional :: dtmp, zero_round - type(bas_type) :: bas - logical :: lfloor1,lround1 - logical, optional :: lfloor,lround - - - ceil=1.D0 - lfloor1=.false. - if(present(dtmp)) ceil=dtmp - if(present(lfloor)) lfloor1=lfloor - flr=ceil-1.D0 - lround1=.false. - dround=1.D-8 - if(present(lround)) lround1=lround - - do is=1,bas%nspec - do ia=1,bas%spec(is)%num - do j=1,3 - if(lfloor1)then - bas%spec(is)%atom(ia,j)=bas%spec(is)%atom(ia,j)& - -floor(bas%spec(is)%atom(ia,j)-flr) - else - bas%spec(is)%atom(ia,j)=bas%spec(is)%atom(ia,j)& - -ceiling(bas%spec(is)%atom(ia,j)-ceil) - end if - if(lround1)then - if(abs(bas%spec(is)%atom(ia,j)-ceil).lt.dround.or.& - abs(bas%spec(is)%atom(ia,j)).lt.dround) & - bas%spec(is)%atom(ia,j)=flr - end if - if(present(zero_round))then - if(abs(bas%spec(is)%atom(ia,j)).lt.dround) & - bas%spec(is)%atom(ia,j)=zero_round - end if - end do - end do - end do - - - return - end subroutine normalise_basis -!!!############################################################################# - - !!!############################################################################# !!! finds the centre of geometry of the supplied basis !!!############################################################################# function centre_of_geom(bas) result(centre) implicit none integer :: is,ia,j - double precision, dimension(3) :: centre - type(bas_type) :: bas + real(real32), dimension(3) :: centre + type(basis_type) :: bas - centre=0.D0 + centre=0._real32 do is=1,bas%nspec do ia=1,bas%spec(is)%num do j=1,3 @@ -969,12 +917,12 @@ end function centre_of_geom function centre_of_mass(bas) result(centre) implicit none integer :: is,ia,j - double precision :: tot_mass - double precision, dimension(3) :: centre - type(bas_type) :: bas + real(real32) :: tot_mass + real(real32), dimension(3) :: centre + type(basis_type) :: bas - centre=0.D0 - tot_mass=0.D0 + centre=0._real32 + tot_mass=0._real32 do is=1,bas%nspec tot_mass=tot_mass+bas%spec(is)%mass*bas%spec(is)%num do ia=1,bas%spec(is)%num @@ -998,11 +946,11 @@ end function centre_of_mass function primitive_lat(inlat) result(plat) implicit none integer :: i,j - double precision :: dtmp1 - double precision, dimension(3) :: scal - double precision, dimension(3,3) :: lat,plat,tmat1,tmat2 - double precision, dimension(3,3), intent(in) :: inlat - double precision, dimension(4,3,3) :: special + real(real32) :: dtmp1 + real(real32), dimension(3) :: scal + real(real32), dimension(3,3) :: lat,plat,tmat1,tmat2 + real(real32), dimension(3,3), intent(in) :: inlat + real(real32), dimension(4,3,3) :: special !!--------------------------------------------------------------- @@ -1020,23 +968,23 @@ function primitive_lat(inlat) result(plat) !! sets up the special set of primitive lattices !!--------------------------------------------------------------- special(1,:,:) = transpose( reshape( (/& - 1.D0, 0.D0, 0.D0,& - 0.D0, 1.D0, 0.D0,& - 0.D0, 0.D0, 1.D0/), shape(lat) ) ) + 1._real32, 0._real32, 0._real32,& + 0._real32, 1._real32, 0._real32,& + 0._real32, 0._real32, 1._real32/), shape(lat) ) ) special(2,:,:) = transpose( reshape( (/& - 1.D0, 0.D0, 0.D0,& - -0.5D0, sqrt(3.D0)/2.D0, 0.D0,& - 0.D0, 0.D0, 1.0D0/), shape(lat) ) ) + 1._real32, 0._real32, 0._real32,& + -0.5_real32, sqrt(3._real32)/2._real32, 0._real32,& + 0._real32, 0._real32, 1.0_real32/), shape(lat) ) ) special(3,:,:) = transpose( reshape( (/& - 0.0D0, 1.D0, 1.D0,& - 1.D0, 0.0D0, 1.D0,& - 1.D0, 1.D0, 0.0D0/), shape(lat) ) ) - special(3,:,:) = special(3,:,:)/sqrt(2.D0) + 0.0_real32, 1._real32, 1._real32,& + 1._real32, 0._real32, 1._real32,& + 1._real32, 1._real32, 0.0_real32/), shape(lat) ) ) + special(3,:,:) = special(3,:,:)/sqrt(2._real32) special(4,:,:) = transpose( reshape( (/& - -1.D0, 1.D0, 1.D0,& - 1.D0, -1.D0, 1.D0,& - 1.D0, 1.D0, -1.D0/), shape(lat) ) ) - special(4,:,:) = special(4,:,:)/sqrt(3.D0) + -1._real32, 1._real32, 1._real32,& + 1._real32, -1._real32, 1._real32,& + 1._real32, 1._real32, -1._real32/), shape(lat) ) ) + special(4,:,:) = special(4,:,:)/sqrt(3._real32) !!--------------------------------------------------------------- @@ -1069,12 +1017,12 @@ subroutine reducer(lat,bas,tmptype,ltmp) implicit none integer :: cell_type integer :: i,j,k,count,limit - double precision, dimension(3,3) :: lat,newlat,transmat,S,tmp_mat - double precision :: tiny,pi,pi2 + real(real32), dimension(3,3) :: lat,newlat,transmat,S,tmp_mat + real(real32) :: tiny,pi,pi2 logical :: verb,lreduced integer, optional :: tmptype logical, optional :: ltmp - type(bas_type) :: bas + type(basis_type) :: bas @@ -1085,16 +1033,16 @@ subroutine reducer(lat,bas,tmptype,ltmp) if(present(ltmp)) verb=ltmp cell_type=2 if(present(tmptype)) cell_type=tmptype - S=0.D0 + S=0._real32 count=0 limit=100 lreduced=.false. tiny=1E-5*(get_vol(lat))**(1.E0/3.E0) - pi=4.D0*atan(1.D0) - pi2=2.D0*atan(1.D0) - transmat=0.D0 + pi=4._real32*atan(1._real32) + pi2=2._real32*atan(1._real32) + transmat=0._real32 do i=1,3 - transmat(i,i)=1.D0 + transmat(i,i)=1._real32 end do newlat=lat @@ -1125,7 +1073,7 @@ subroutine reducer(lat,bas,tmptype,ltmp) do i=1,2 j=i+1 if(S(i,i)-S(j,j).gt.tiny) then - call swap_vec(transmat(i,:),transmat(j,:)) + call swap(transmat(i,:),transmat(j,:)) transmat=-transmat if(i.eq.2) cycle find_reduced call mkNiggli_lat(lat,newlat,transmat,S) @@ -1161,12 +1109,12 @@ subroutine reducer(lat,bas,tmptype,ltmp) !! A5 if(abs(2*S(2,3)).gt.S(2,2)+tiny.or.& (abs(2*S(2,3)-S(2,2)).le.tiny.and.2*S(1,3).lt.S(1,2)).or.& - (abs(2*S(2,3)+S(2,2)).le.tiny.and.S(1,2).lt.0.D0))then + (abs(2*S(2,3)+S(2,2)).le.tiny.and.S(1,2).lt.0._real32))then tmp_mat(2,3)=((-1)**(cell_type+1))*floor((2*S(2,3)+S(2,2))/(2*S(2,2))) transmat=matmul(transpose(tmp_mat),transmat) cycle find_reduced - ! elseif(cell_type.eq.1.and.S(2,3).lt.0.D0)then - ! tmp_mat(2,3)=1.D0 + ! elseif(cell_type.eq.1.and.S(2,3).lt.0._real32)then + ! tmp_mat(2,3)=1._real32 ! transmat=matmul(transpose(tmp_mat),transmat) ! cycle find_reduced end if @@ -1175,12 +1123,12 @@ subroutine reducer(lat,bas,tmptype,ltmp) !! A6 if(abs(2*S(1,3)).gt.S(1,1)+tiny.or.& (abs(2*S(1,3)-S(1,1)).le.tiny.and.2*S(2,3).lt.S(1,2)).or.& - (abs(2*S(1,3)+S(1,1)).le.tiny.and.S(1,2).lt.0.D0))then + (abs(2*S(1,3)+S(1,1)).le.tiny.and.S(1,2).lt.0._real32))then tmp_mat(1,3)=((-1)**(cell_type+1))*floor((2*S(1,3)+S(1,1))/(2*S(1,1))) transmat=matmul(transpose(tmp_mat),transmat) cycle find_reduced - ! elseif(cell_type.eq.1.and.S(1,3).lt.0.D0)then - ! tmp_mat(1,3)=1.D0 + ! elseif(cell_type.eq.1.and.S(1,3).lt.0._real32)then + ! tmp_mat(1,3)=1._real32 ! transmat=matmul(transpose(tmp_mat),transmat) ! cycle find_reduced end if @@ -1189,12 +1137,12 @@ subroutine reducer(lat,bas,tmptype,ltmp) !! A7 if(abs(2*S(1,2)).gt.S(1,1)+tiny.or.& (abs(2*S(1,2)-S(1,1)).le.tiny.and.2*S(2,3).lt.S(1,3)).or.& - (abs(2*S(1,2)+S(1,1)).le.tiny.and.S(1,3).lt.0.D0))then + (abs(2*S(1,2)+S(1,1)).le.tiny.and.S(1,3).lt.0._real32))then tmp_mat(1,2)=((-1)**(cell_type+1))*floor((2*S(1,2)+S(1,1))/(2*S(1,1))) transmat=matmul(transpose(tmp_mat),transmat) cycle find_reduced - ! elseif(cell_type.eq.1.and.S(1,2).lt.0.D0)then - ! tmp_mat(1,2)=1.D0 + ! elseif(cell_type.eq.1.and.S(1,2).lt.0._real32)then + ! tmp_mat(1,2)=1._real32 ! transmat=matmul(transpose(tmp_mat),transmat) ! cycle find_reduced end if @@ -1217,7 +1165,7 @@ subroutine reducer(lat,bas,tmptype,ltmp) end do find_reduced - if(abs(det(transmat)+1.D0).le.tiny)then + if(abs(det(transmat)+1._real32).le.tiny)then tmp_mat=reshape((/-1,0,0, 0,-1,0, 0,0,-1/),shape(tmp_mat)) transmat=matmul(transpose(tmp_mat),transmat) end if @@ -1256,8 +1204,8 @@ end subroutine reducer !!! S(1,2) = a.b, S(1,3) = a.c, S(2,3) = b.c subroutine mkNiggli_lat(lat,newlat,transmat,S) implicit none - double precision, dimension(3,3) :: lat,newlat,transmat,S - double precision, dimension(3) :: a,b,c + real(real32), dimension(3,3) :: lat,newlat,transmat,S + real(real32), dimension(3) :: a,b,c newlat=matmul(transmat,lat) @@ -1291,9 +1239,9 @@ end subroutine mkNiggli_lat function reduced_check(lat,cell_type,S,tchar) result(check) implicit none integer :: cell_type - double precision :: tiny,alpha,beta,gamma,pi2 - double precision, dimension(3) :: a,b,c - double precision, dimension(3,3) :: lat,S + real(real32) :: tiny,alpha,beta,gamma,pi2 + real(real32), dimension(3) :: a,b,c + real(real32), dimension(3,3) :: lat,S character(1) :: quiet character(1), optional :: tchar logical :: check @@ -1303,7 +1251,7 @@ function reduced_check(lat,cell_type,S,tchar) result(check) if(present(tchar)) quiet=tchar if(quiet.ne."y".and.quiet.ne."q") quiet="n" - pi2 = 2.D0*atan(1.D0) + pi2 = 2._real32*atan(1._real32) check=.false. tiny=1E-3 @@ -1327,22 +1275,22 @@ function reduced_check(lat,cell_type,S,tchar) result(check) end if if(cell_type.eq.1.and.& alpha.le.pi2.and.beta.le.pi2.and.gamma.le.pi2.and.& - S(1,2)-0.5D0*S(1,1).lt.tiny.and.& - S(1,3)-0.5D0*S(1,1).lt.tiny.and.& - S(2,3)-0.5D0*S(2,2).lt.tiny) then !Type I + S(1,2)-0.5_real32*S(1,1).lt.tiny.and.& + S(1,3)-0.5_real32*S(1,1).lt.tiny.and.& + S(2,3)-0.5_real32*S(2,2).lt.tiny) then !Type I check=.true. if(quiet.eq."n") write(0,*) "Found Type I reduced Niggli cell" elseif(cell_type.eq.2.and.& alpha.ge.pi2-tiny.and.beta.ge.pi2-tiny.and.gamma.ge.pi2-tiny.and.& - abs(S(1,2))-0.5D0*S(1,1).lt.tiny.and.& - abs(S(1,3))-0.5D0*S(1,1).lt.tiny.and.& - abs(S(2,3))-0.5D0*S(2,2).lt.tiny.and.& - (abs(S(2,3))+abs(S(1,3))+abs(S(1,2)))-0.5D0*(S(1,1)+S(2,2)).lt.tiny) then !Type II - if(abs(S(1,2))-0.5D0*S(1,1).le.tiny.and.S(1,3).gt.tiny) return - if(abs(S(1,3))-0.5D0*S(1,1).le.tiny.and.S(1,2).gt.tiny) return - if(abs(S(2,3))-0.5D0*S(2,2).le.tiny.and.S(1,2).gt.tiny) return - if((abs(S(2,3))+abs(S(1,3))+abs(S(1,2)))-0.5D0*(S(1,1)+S(2,2)).gt.tiny.and.& - S(1,1)-(2.D0*abs(S(1,3))+abs(S(1,2))).gt.tiny) return + abs(S(1,2))-0.5_real32*S(1,1).lt.tiny.and.& + abs(S(1,3))-0.5_real32*S(1,1).lt.tiny.and.& + abs(S(2,3))-0.5_real32*S(2,2).lt.tiny.and.& + (abs(S(2,3))+abs(S(1,3))+abs(S(1,2)))-0.5_real32*(S(1,1)+S(2,2)).lt.tiny) then !Type II + if(abs(S(1,2))-0.5_real32*S(1,1).le.tiny.and.S(1,3).gt.tiny) return + if(abs(S(1,3))-0.5_real32*S(1,1).le.tiny.and.S(1,2).gt.tiny) return + if(abs(S(2,3))-0.5_real32*S(2,2).le.tiny.and.S(1,2).gt.tiny) return + if((abs(S(2,3))+abs(S(1,3))+abs(S(1,2)))-0.5_real32*(S(1,1)+S(2,2)).gt.tiny.and.& + S(1,1)-(2._real32*abs(S(1,3))+abs(S(1,2))).gt.tiny) return check=.true. if(quiet.eq."n") write(0,*) "Found Type II reduced Niggli cell" else @@ -1360,12 +1308,12 @@ end function reduced_check function planecutter(inlat,invec) result(tfmat) implicit none integer :: i,j,itmp1 - double precision :: tol + real(real32) :: tol integer, dimension(3) :: order - double precision, dimension(3) :: vec,tvec1 - double precision, dimension(3,3) :: lat,b,tfmat,invlat,reclat - double precision, dimension(3), intent(in) :: invec - double precision, dimension(3,3), intent(in) :: inlat + real(real32), dimension(3) :: vec,tvec1 + real(real32), dimension(3,3) :: lat,b,tfmat,invlat,reclat + real(real32), dimension(3), intent(in) :: invec + real(real32), dimension(3,3), intent(in) :: inlat @@ -1386,14 +1334,14 @@ function planecutter(inlat,invec) result(tfmat) !!!----------------------------------------------------------------------------- do i=1,2 if(vec(i).eq.0)then - if(all(vec(i:).eq.0.D0)) exit + if(all(vec(i:).eq.0._real32)) exit itmp1=maxloc(vec(i+1:),mask=vec(i+1:).ne.0,dim=1)+i - call swap_i(order(i),order(itmp1)) - call swap_d(vec(i),vec(itmp1)) - call swap_vec(lat(:,i),lat(:,itmp1)) - call swap_vec(lat(i,:),lat(itmp1,:)) - call swap_vec(reclat(:,i),reclat(:,itmp1)) - call swap_vec(reclat(i,:),reclat(itmp1,:)) + call swap(order(i),order(itmp1)) + call swap(vec(i),vec(itmp1)) + call swap(lat(:,i),lat(:,itmp1)) + call swap(lat(i,:),lat(itmp1,:)) + call swap(reclat(:,i),reclat(:,itmp1)) + call swap(reclat(i,:),reclat(itmp1,:)) end if end do !vec=matmul(vec,reclat) @@ -1402,8 +1350,8 @@ function planecutter(inlat,invec) result(tfmat) !!!----------------------------------------------------------------------------- !!! Perform Lenstra-Lenstra-Lovász reduction !!!----------------------------------------------------------------------------- - b(1,:) = (/-vec(2),vec(1),0.D0/) - b(2,:) = (/-vec(3),0.D0,vec(1)/) + b(1,:) = (/-vec(2),vec(1),0._real32/) + b(2,:) = (/-vec(3),0._real32,vec(1)/) b(3,:) = vec tfmat = b b(:2,:) = LLL_reduce(b(:2,:)) @@ -1459,10 +1407,10 @@ function planecutter(inlat,invec) result(tfmat) !!!----------------------------------------------------------------------------- do i=1,3 if(i.eq.order(i)) cycle - call swap_vec(lat(i,:),lat(order(i),:)) - call swap_vec(lat(:,i),lat(:,order(i))) - call swap_vec(b(:,i),b(:,order(i))) - call swap_i(order(order(i)),order(i)) + call swap(lat(i,:),lat(order(i),:)) + call swap(lat(:,i),lat(:,order(i))) + call swap(b(:,i),b(:,order(i))) + call swap(order(order(i)),order(i)) end do @@ -1472,7 +1420,7 @@ function planecutter(inlat,invec) result(tfmat) !!!----------------------------------------------------------------------------- !b=matmul(b,invlat) where(abs(b(:,:)).lt.tol) - b(:,:)=0.D0 + b(:,:)=0._real32 end where !write(0,'(3(2X,F9.3))') (b(j,:),j=1,3) !write(0,*) @@ -1486,11 +1434,11 @@ function planecutter(inlat,invec) result(tfmat) write(0,'(1X,"ERROR: Internal error in planecutter function")') write(0,'(2X,"Planecutter in mod_edit_geom.f90 is unable to find a& & perpendicular plane")') - b=0.D0 + b=0._real32 exit end if end do reduce_loop - if(det(b).lt.0.D0)then + if(det(b).lt.0._real32)then tvec1=b(2,:) b(2,:)=b(1,:) b(1,:)=tvec1 @@ -1500,7 +1448,7 @@ function planecutter(inlat,invec) result(tfmat) write(0,'(2X,"Planecutter in mod_edit_geom.f90 has generated a 0& & determinant matrix")') write(0,'(3(2X,F9.3))') (b(j,:),j=1,3) - b=0.D0 + b=0._real32 !stop end if tfmat=b @@ -1511,209 +1459,270 @@ end function planecutter !!!############################################################################# -!!!############################################################################# -!!! merges two supplied bases -!!!############################################################################# -!!! Assumes the same lattice for each - function bas_merge(bas1,bas2,length,map1,map2) result(mergbas) +!############################################################################### + 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 - integer :: i,j,k,itmp,dim + + ! 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. - type(bas_type) :: mergbas - type(bas_type), intent(in) :: bas1,bas2 - integer, intent(in), optional :: length - integer, allocatable, dimension(:,:,:), optional, intent(inout) :: map1,map2 - !!-------------------------------------------------------------------------- - !! Set up number of species - !!-------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! set up number of species + !--------------------------------------------------------------------------- dim=3 if(present(length)) dim=length - allocate(match(bas2%nspec)) + allocate(match(basis2%nspec)) match=0 - mergbas%nspec=bas1%nspec - do i=1,bas2%nspec - if(.not.any(bas2%spec(i)%name.eq.bas1%spec(:)%name))then - mergbas%nspec=mergbas%nspec+1 + 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(mergbas%spec(mergbas%nspec)) - mergbas%spec(:bas1%nspec)%num=bas1%spec(:)%num - mergbas%spec(:bas1%nspec)%name=bas1%spec(:)%name - - - write(mergbas%sysname,'(A,"+",A)') & - trim(bas1%sysname),trim(bas2%sysname) - k=bas1%nspec - spec1check: do i=1,bas2%nspec - do j=1,bas1%nspec - if(bas2%spec(i)%name.eq.bas1%spec(j)%name)then - mergbas%spec(j)%num=mergbas%spec(j)%num+bas2%spec(i)%num + 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 - mergbas%spec(k)%num=bas2%spec(i)%num - mergbas%spec(k)%name=bas2%spec(i)%name + 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 - !!-------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! 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(& - mergbas%nspec,& - maxval(mergbas%spec(:)%num,dim=1),2)) + 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,bas1%nspec - allocate(mergbas%spec(i)%atom(mergbas%spec(i)%num,dim)) - mergbas%spec(i)%atom(:,:)=0.D0 - mergbas%spec(i)%atom(1:bas1%spec(i)%num,:3)=bas1%spec(i)%atom(:,:3) - if(lmap) new_map(i,:bas1%spec(i)%num,:)=map1(i,:bas1%spec(i)%num,:) + !--------------------------------------------------------------------------- + ! 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,bas2%nspec - if(match(i).gt.bas1%nspec)then - allocate(mergbas%spec(match(i))%atom(mergbas%spec(match(i))%num,dim)) - mergbas%spec(match(i))%atom(:,:)=0.D0 - mergbas%spec(match(i))%atom(:,:3)=bas2%spec(i)%atom(:,:3) - if(lmap) new_map(match(i),:bas2%spec(i)%num,:) = & - map2(i,:bas2%spec(i)%num,:) + 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=bas1%spec(match(i))%num - mergbas%spec(match(i))%atom(itmp+1:bas2%spec(i)%num+itmp,:3) = & - bas2%spec(i)%atom(:,:3) - if(lmap) new_map(match(i),itmp+1:bas2%spec(i)%num+itmp,:) = & - map2(i,:bas2%spec(i)%num,:) + 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 - mergbas%natom=sum(mergbas%spec(:)%num) + output%natom=sum(output%spec(:)%num) if(lmap) call move_alloc(new_map,map1) return - end function bas_merge -!!!############################################################################# + end function basis_merge +!############################################################################### -!!!############################################################################# -!!! merges two supplied bases and lattices -!!! Does so by stitching one onto the top of the other -!!!############################################################################# - subroutine bas_lat_merge(merglat,mergbas,inlat1,inlat2,inbas1,inbas2,axis,inoffset,map1,map2) +!############################################################################### + function basis_stack(basis1,basis2,axis,offset,length,map1,map2) result(output) + !! Merge two supplied bases + !! + !! Merge two bases assuming that the lattice is the same implicit none - integer :: i,k,axis - double precision :: c1_ratio,c2_ratio,add,loc,zgap - type(bas_type) :: mergbas,bas1,bas2 - type(bas_type), intent(in) :: inbas1,inbas2 - integer, dimension(3) :: order - double precision, dimension(3) :: unit_vec,offset - double precision, dimension(3), intent(in) :: inoffset - double precision, dimension(3,3) :: merglat,lat1,lat2 - double precision, dimension(3,3), intent(in) :: inlat1,inlat2 + ! 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, intent(in) :: axis + !! Axis for the offset. + real(real32), dimension(3), intent(in) :: offset + !! Offset for the merged basis. integer, allocatable, dimension(:,:,:), optional, intent(inout) :: map1,map2 + !! Maps for atoms in the two bases. + + ! Local variables + integer :: i, j, k, itmp, length_ + !! Loop counters. + real(real32) :: loc, c1_ratio, c2_ratio, zgap, add + !! Lattice parameters. + logical :: lmap + !! Boolean for map presence. + type(basis_type) :: basis1_, basis2_ + integer, dimension(3) :: order + !! Order of axes. + real(real32), dimension(3) :: unit_vec + !! Unit vector for the axis. + real(real32), dimension(3) :: offset_ + !! Offset for the merged basis. + integer, allocatable, dimension(:) :: match + !! Array to match species. + integer, allocatable, dimension(:,:,:) :: new_map + !! New map for merged basis. + + + !--------------------------------------------------------------------------- + ! copy basis1 and basis2 + !--------------------------------------------------------------------------- + call basis1_%copy(basis1) + call basis2_%copy(basis2) - offset=inoffset - if(allocated(mergbas%spec))then - do i=1,mergbas%nspec - if(allocated(mergbas%spec(i)%atom)) deallocate(mergbas%spec(i)%atom) + + !--------------------------------------------------------------------------- + ! set up number of species + !--------------------------------------------------------------------------- + length_ = 3 + if(present(length)) length_ = 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 - deallocate(mergbas%spec) - end if + 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 - call clone_bas(inbas1,bas1,inlat1,lat1) - call clone_bas(inbas2,bas2,inlat2,lat2) -!!!----------------------------------------------------------------------------- -!!! Shifts cells to -!!!----------------------------------------------------------------------------- + + !----------------------------------------------------------------------------- + ! Shifts cells to + !----------------------------------------------------------------------------- loc=0.D0 - lat1=MATNORM(lat1) - add=-min_dist(bas1,axis,loc,.true.) - call shifter(bas1,axis,add,.true.) + basis1_%lat=MATNORM(basis1_%lat) + add = -min_dist(basis1_,axis,loc,.true.) + call shifter(basis1_,axis,add,.true.) - add=-min_dist(bas2,axis,loc,.true.) - lat2=MATNORM(lat2) - call shifter(bas2,axis,add,.true.) + basis2_%lat=MATNORM(basis2_%lat) + add = -min_dist(basis2_,axis,loc,.true.) + call shifter(basis2_,axis,add,.true.) -!!!----------------------------------------------------------------------------- -!!! reduces vacuum between materials to desired sizes -!!!----------------------------------------------------------------------------- - loc=1.D0 - call set_vacuum(lat1,bas1,axis,loc,offset(axis)) - call set_vacuum(lat2,bas2,axis,loc,offset(axis)) - order=(/1,2,3/) - order=cshift(order,3-axis) - do k=1,2 - offset(order(k))=offset(order(k))/modu(lat1(order(k),:)) + !--------------------------------------------------------------------------- + ! handle offset + !--------------------------------------------------------------------------- + loc = 1._real32 + call set_vacuum(basis1_,axis,loc,offset(axis)) + call set_vacuum(basis2_,axis,loc,offset(axis)) + + order = [ 1, 2, 3 ] + order = cshift(order,3-axis) + do k = 1, 2 + offset_(order(k)) = offset(order(k)) / modu(basis1_%lat(order(k),:)) end do - unit_vec=uvec(lat1(order(3),:)) - zgap=offset(order(3))/unit_vec(order(3)) - !!NOT SET UP OFFSET FEATURE MADE ABOVE!!! MIGHT BE FIXED NOW! NEED TO TEST + unit_vec = uvec(basis1_%lat(order(3),:)) + zgap = offset_(order(3)) / unit_vec(order(3)) - !loc=1.D0 - !add=zgap+min_dist(bas1,axis,loc)*modu(lat1(axis,:)) - !call vacuumer(lat1,bas1,axis,loc,add) - !add=zgap+min_dist(bas2,axis,loc)*modu(lat2(axis,:)) - !call vacuumer(lat2,bas2,axis,loc,add) - -!!!----------------------------------------------------------------------------- -!!! makes supercell -!!!----------------------------------------------------------------------------- - merglat(order(1),:)=lat1(order(1),:) - merglat(order(2),:)=lat1(order(2),:) - unit_vec=uvec(lat1(axis,:)) - ! slat(axis,:)=lat1(axis,:) + ( modu(lat2(axis,:)) + zgap/unit_vec(axis) )*unit_vec - merglat(axis,:)=lat1(axis,:) + modu(lat2(axis,:))*unit_vec - c1_ratio=modu(lat1(axis,:))/modu(merglat(axis,:)) - c2_ratio=modu(lat2(axis,:))/modu(merglat(axis,:)) + !--------------------------------------------------------------------------- + ! makes supercell + !--------------------------------------------------------------------------- + output%lat(order(1),:) = basis1_%lat(order(1),:) + output%lat(order(2),:) = basis1_%lat(order(2),:) + unit_vec = uvec(basis1_%lat(axis,:)) + output%lat(axis,:) = basis1_%lat(axis,:) + modu(basis2_%lat(axis,:)) * unit_vec + c1_ratio = modu(basis1_%lat(axis,:)) / modu(output%lat(axis,:)) + c2_ratio = modu(basis2_%lat(axis,:)) / modu(output%lat(axis,:)) !!!----------------------------------------------------------------------------- !!! merge list of atomic types and respective numbers for both structures !!!----------------------------------------------------------------------------- - do i=1,bas1%nspec - bas1%spec(i)%atom(:,axis)=bas1%spec(i)%atom(:,axis)*c1_ratio + do i=1,basis1_%nspec + basis1_%spec(i)%atom(:,axis) = basis1_%spec(i)%atom(:,axis) * c1_ratio end do - do i=1,bas2%nspec - bas2%spec(i)%atom(:,axis)=bas2%spec(i)%atom(:,axis)*c2_ratio + c1_ratio + do i=1,basis2_%nspec + basis2_%spec(i)%atom(:,axis) = basis2_%spec(i)%atom(:,axis)*c2_ratio + c1_ratio do k=1,2 - bas2%spec(i)%atom(:,order(k))=bas2%spec(i)%atom(:,order(k))+offset(order(k)) + basis2_%spec(i)%atom(:,order(k)) = basis2_%spec(i)%atom(:,order(k)) + offset_(order(k)) end do end do if(present(map1).and.present(map2))then - mergbas=bas_merge(bas1,bas2,map1=map1,map2=map2) + output = basis_merge(basis1_,basis2_,map1=map1,map2=map2) else - mergbas=bas_merge(bas1,bas2) + output = basis_merge(basis1_,basis2_) end if - call normalise_basis(mergbas,1.D0,.true.) - + call output%normalise(ceil_val = 1._real32, floor_coords = .true.) return - end subroutine bas_lat_merge -!!!############################################################################# + end function basis_stack +!############################################################################### !!!############################################################################# @@ -1724,13 +1733,13 @@ function split_bas(inbas,loc_vec,axis,lall_same_nspec,map1,map2) result(bas_arr) integer :: i,is,ia,itmp1,nregions,axis,nspec logical :: lsame logical :: lmap,lmove - type(bas_type) :: tbas - double precision, allocatable, dimension(:,:) :: dloc_vec + type(basis_type) :: tbas + real(real32), allocatable, dimension(:,:) :: dloc_vec logical, optional :: lall_same_nspec - type(bas_type),intent(in) :: inbas - double precision, dimension(:,:), intent(in) :: loc_vec - type(bas_type), allocatable, dimension(:) :: bas_arr + type(basis_type),intent(in) :: inbas + real(real32), dimension(:,:), intent(in) :: loc_vec + type(basis_type), allocatable, dimension(:) :: bas_arr type map_type integer, allocatable, dimension(:,:,:) :: spec @@ -1758,7 +1767,7 @@ function split_bas(inbas,loc_vec,axis,lall_same_nspec,map1,map2) result(bas_arr) allocate(dloc_vec(nregions,2)) dloc_vec(:,:)=loc_vec(:,:)-floor(loc_vec(:,:)) where(dloc_vec(:,2).lt.dloc_vec(:,1)) - dloc_vec(:,2)=dloc_vec(:,2)+1.D0 + dloc_vec(:,2)=dloc_vec(:,2)+1._real32 end where allocate(bas_arr(nregions)) @@ -1832,14 +1841,11 @@ function split_bas(inbas,loc_vec,axis,lall_same_nspec,map1,map2) result(bas_arr) end if nspec=nspec+1 end do specloop2 - call clone_bas(tbas,bas_arr(i)) + call bas_arr(i)%copy(tbas) deallocate(tbas%spec) end do end if - - - end function split_bas !!!############################################################################# @@ -1851,17 +1857,17 @@ subroutine get_bulk(lat,bas,axis,bulk_lat,bulk_bas) implicit none integer :: is,ia,ja,len,itmp1 integer :: minspecloc,minatomloc,nxtatomloc - double precision, dimension(3) :: transvec - double precision, dimension(2,2) :: regions - double precision, dimension(3,3) :: tf + real(real32), dimension(3) :: transvec + real(real32), dimension(2,2) :: regions + real(real32), dimension(3,3) :: tf logical, allocatable, dimension(:) :: atom_mask - type(bas_type), allocatable, dimension(:) :: splitbas + type(basis_type), allocatable, dimension(:) :: splitbas integer, intent(in) :: axis - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in):: lat - type(bas_type), intent(out) :: bulk_bas - double precision, dimension(3,3), intent(out) :: bulk_lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in):: lat + type(basis_type), intent(out) :: bulk_bas + real(real32), dimension(3,3), intent(out) :: bulk_lat minspecloc = minloc(bas%spec(:)%num,mask=bas%spec(:)%num.ne.0,dim=1) @@ -1946,14 +1952,8 @@ subroutine get_bulk(lat,bas,axis,bulk_lat,bulk_bas) bulk_lat(axis,:) = matmul(transvec,lat) - tf=matmul(inverse(bulk_lat),lat) - write(0,*) tf - call clone_bas(splitbas(1),bulk_bas) - bulk_bas = convert_bas(splitbas(1),tf) - - - - + call bulk_bas%copy(splitbas(1)) + call bulk_bas%change_lattice(bulk_lat) end subroutine get_bulk !!!############################################################################# @@ -1966,23 +1966,23 @@ function get_centre_atom(bas,spec,axis,lw,up) result(iatom) implicit none integer :: ia integer :: iatom - double precision :: dtmp1,dtmp2,centre - double precision :: dlw,dup + real(real32) :: dtmp1,dtmp2,centre + real(real32) :: dlw,dup integer, intent(in) :: spec,axis - double precision, intent(in) :: lw,up - type(bas_type), intent(in) :: bas + real(real32), intent(in) :: lw,up + type(basis_type), intent(in) :: bas iatom=0 - dtmp1 = 1.D0 + dtmp1 = 1._real32 if(lw.gt.up)then dlw = lw - dup = 1.D0 + up + dup = 1._real32 + up else dlw = lw dup = up end if - centre = (dlw + dup)/2.D0 + centre = (dlw + dup)/2._real32 do ia=1,bas%spec(spec)%num dtmp2=bas%spec(spec)%atom(ia,axis)& -ceiling(bas%spec(spec)%atom(ia,axis)-dup) @@ -2004,19 +2004,19 @@ function get_closest_atom_1D(bas,axis,loc,species,above,below) result(atom) implicit none integer :: is,ia integer :: is_start,is_end - double precision :: dtmp1,dtmp2 + real(real32) :: dtmp1,dtmp2 logical :: labove,lbelow integer, intent(in) :: axis - double precision, intent(in) :: loc + real(real32), intent(in) :: loc integer, dimension(2) :: atom - type(bas_type), intent(in) :: bas + type(basis_type), intent(in) :: bas integer, optional, intent(in) :: species logical, optional, intent(in) :: above,below atom=[0,0] - dtmp1 = 1.D0 + dtmp1 = 1._real32 if(present(species))then is_start=species is_end=species @@ -2037,7 +2037,7 @@ function get_closest_atom_1D(bas,axis,loc,species,above,below) result(atom) cycle atom_loop1 end if dtmp2=bas%spec(is)%atom(ia,axis)& - -ceiling(bas%spec(is)%atom(ia,axis)-(loc+0.5D0)) + -ceiling(bas%spec(is)%atom(ia,axis)-(loc+0.5_real32)) if(abs(dtmp2-loc).lt.dtmp1)then dtmp1=abs(dtmp2-loc) atom=[is,ia] @@ -2055,18 +2055,18 @@ function get_closest_atom_3D(lat,bas,loc,species) result(atom) implicit none integer :: is,ia integer :: is_start,is_end - double precision :: dtmp1,dtmp2 - double precision, dimension(3) :: vtmp1 - double precision, dimension(3), intent(in) :: loc - double precision, dimension(3,3), intent(in) :: lat + real(real32) :: dtmp1,dtmp2 + real(real32), dimension(3) :: vtmp1 + real(real32), dimension(3), intent(in) :: loc + real(real32), dimension(3,3), intent(in) :: lat integer, dimension(2) :: atom - type(bas_type), intent(in) :: bas + type(basis_type), intent(in) :: bas integer, optional, intent(in) :: species atom=[0,0] - dtmp1 = 1.D0 + dtmp1 = 1._real32 if(present(species))then is_start=species is_end=species @@ -2078,7 +2078,7 @@ function get_closest_atom_3D(lat,bas,loc,species) result(atom) spec_loop1: do is=is_start,is_end atom_loop1: do ia=1,bas%spec(is)%num vtmp1 = bas%spec(is)%atom(ia,:) - loc - vtmp1 = vtmp1 - ceiling(vtmp1 - 0.5D0) + vtmp1 = vtmp1 - ceiling(vtmp1 - 0.5_real32) vtmp1 = matmul(vtmp1,lat) dtmp2 = modu(vtmp1) if(dtmp2.lt.dtmp1)then @@ -2100,12 +2100,12 @@ function get_wyckoff(bas,axis) result(wyckoff) implicit none integer :: is,ia,ja,itmp1,itmp2!ref_atom integer :: minspecloc,minatomloc,nxtatomloc - double precision :: up_loc,lw_loc,up_loc2,lw_loc2 - double precision, dimension(3) :: transvec,tmp_vec1,tmp_vec2,tmp_vec3,tvec + real(real32) :: up_loc,lw_loc,up_loc2,lw_loc2 + real(real32), dimension(3) :: transvec,tmp_vec1,tmp_vec2,tmp_vec3,tvec logical, allocatable, dimension(:) :: atom_mask type(wyck_spec_type) :: wyckoff integer, intent(in) :: axis - type(bas_type), intent(in) :: bas + type(basis_type), intent(in) :: bas type l_bulk_type logical, allocatable, dimension(:) :: atom @@ -2125,8 +2125,8 @@ function get_wyckoff(bas,axis) result(wyckoff) lw_loc = bas%spec(minspecloc)%atom(minatomloc,axis) up_loc = bas%spec(minspecloc)%atom(nxtatomloc,axis) minatomloc = & - maxloc(bas%spec(minspecloc)%atom(:,axis)-(lw_loc+up_loc)/2.D0,dim=1,& - mask=bas%spec(minspecloc)%atom(:,axis)-(lw_loc+up_loc)/2.D0.le.0.D0) + maxloc(bas%spec(minspecloc)%atom(:,axis)-(lw_loc+up_loc)/2._real32,dim=1,& + mask=bas%spec(minspecloc)%atom(:,axis)-(lw_loc+up_loc)/2._real32.le.0._real32) allocate(atom_mask(bas%spec(minspecloc)%num)) atom_mask = .true. @@ -2141,7 +2141,7 @@ function get_wyckoff(bas,axis) result(wyckoff) !!!----------------------------------------------------------------------------- itmp1 = minatomloc lw_loc = bas%spec(minspecloc)%atom(minatomloc,axis) - up_loc = 1.D0 + up_loc = 1._real32 allocate(l_bulk_atoms(bas%nspec)) do is=1,bas%nspec allocate(l_bulk_atoms(is)%atom(bas%spec(is)%num)) @@ -2211,7 +2211,7 @@ function get_wyckoff(bas,axis) result(wyckoff) bas%spec(is)%atom(ja,:3) !! SAME ISSUE HERE AS BELOW !! NEED TO TAKE INTO ACCOUNT THAT THEY WORK IN UNISON - tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5D0 ) + tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5_real32 ) if( all( abs(tmp_vec2).lt.1.D-5 ) )then @@ -2244,7 +2244,7 @@ function get_wyckoff(bas,axis) result(wyckoff) if( all(bas%spec(is)%atom(:,axis).lt.tmp_vec1(axis)-1.D-5) ) cycle atom_loop3 atom_loop4: do ja=1,bas%spec(is)%num tmp_vec2 = tmp_vec1 - bas%spec(is)%atom(ja,:3) - tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5D0 ) + tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5_real32 ) if( all( abs(tmp_vec2).lt.1.D-5 ) )then cycle atom_loop3 end if @@ -2289,14 +2289,14 @@ function get_wyckoff(bas,axis) result(wyckoff) tmp_vec3 = tmp_vec2 - bas%spec(is)%atom(ja,:3) itmp1 = nint(tmp_vec3(axis)/transvec(axis)) tvec = itmp1*transvec - tvec = tvec - ceiling(tvec-1.D0) + tvec = tvec - ceiling(tvec-1._real32) !tmp_vec3 = tmp_vec3/transvec !tmp_vec3 = reduce_vec_gcd(tmp_vec3) itmp2 = nint(get_vec_multiple(tvec,tmp_vec3)) if(itmp1.eq.0) cycle atom_loop6 tmp_vec3 = tmp_vec3 - tvec!itmp1*tvec - tmp_vec3 = tmp_vec3 - ceiling(tmp_vec3 - 0.5D0) + tmp_vec3 = tmp_vec3 - ceiling(tmp_vec3 - 0.5_real32) !THIS IS WHERE WE NEED TO MAKE IT RIGHT !! FIND THE GCD AND DIVIDE if(all(abs(tmp_vec3).lt.1.D-5))then @@ -2337,14 +2337,14 @@ end function get_wyckoff function get_shortest_bond(lat,bas) result(bond) implicit none integer :: is,js,ia,ja,ja_start - double precision :: dist,min_bond - type(bas_type), intent(in) :: bas + real(real32) :: dist,min_bond + type(basis_type), intent(in) :: bas type(bond_type) :: bond - double precision, dimension(3) :: vec + real(real32), dimension(3) :: vec integer, dimension(2,2) :: atoms - double precision, dimension(3,3) :: lat + real(real32), dimension(3,3) :: lat - min_bond = 100.D0 + min_bond = 100._real32 atoms = 0 do is=1,bas%nspec do js=is,bas%nspec @@ -2356,7 +2356,7 @@ function get_shortest_bond(lat,bas) result(bond) end if do ja=ja_start,bas%spec(js)%num vec = bas%spec(is)%atom(ia,:3) - bas%spec(js)%atom(ja,:3) - vec = vec - ceiling(vec - 0.5D0) + vec = vec - ceiling(vec - 0.5_real32) vec = matmul(vec,lat) dist = modu(vec) if(dist.lt.min_bond)then @@ -2383,12 +2383,12 @@ subroutine share_strain(lat1,lat2,bulk_mod1,bulk_mod2,axis,lcompensate) implicit none integer :: i integer :: iaxis - double precision :: area1,area2,delta1,delta2 + real(real32) :: area1,area2,delta1,delta2 integer, dimension(3) :: abc=(/1,2,3/) - double precision, dimension(3) :: strain + real(real32), dimension(3) :: strain - double precision, intent(in) :: bulk_mod1,bulk_mod2 - double precision, dimension(3,3), intent(inout) :: lat1,lat2 + real(real32), intent(in) :: bulk_mod1,bulk_mod2 + real(real32), dimension(3,3), intent(inout) :: lat1,lat2 integer, optional, intent(in) :: axis logical, optional, intent(in) :: lcompensate @@ -2399,22 +2399,22 @@ subroutine share_strain(lat1,lat2,bulk_mod1,bulk_mod2,axis,lcompensate) abc=cshift(abc,3-iaxis) area1 = modu(cross(lat1(abc(1),:),lat1(abc(2),:))) area2 = modu(cross(lat2(abc(1),:),lat2(abc(2),:))) - delta1 = - (1.D0 - area2/area1)/(1.D0 + (area2/area1)*(bulk_mod1/bulk_mod2)) - delta2 = - (1.D0 - area1/area2)/(1.D0 + (area1/area2)*(bulk_mod2/bulk_mod1)) + delta1 = - (1._real32 - area2/area1)/(1._real32 + (area2/area1)*(bulk_mod1/bulk_mod2)) + delta2 = - (1._real32 - area1/area2)/(1._real32 + (area1/area2)*(bulk_mod2/bulk_mod1)) write(0,*) "areas", area1,area2 write(0,*) "deltas", delta1,delta2 write(0,*) "modulus", bulk_mod1,bulk_mod2 do i=1,3 if(i.eq.iaxis) cycle strain(:) = lat1(i,:)-lat2(i,:) - lat1(i,:) = lat1(i,:) * (1.D0 + delta1) + lat1(i,:) = lat1(i,:) * (1._real32 + delta1) lat2(i,:) = lat1(i,:) end do if(present(lcompensate))then if(lcompensate)then - lat1(abc(3),:) = lat1(abc(3),:) * (1.D0 - delta1/(1.D0 + delta1)) - lat2(abc(3),:) = lat2(abc(3),:) * (1.D0 - delta2/(1.D0 + delta2)) + lat1(abc(3),:) = lat1(abc(3),:) * (1._real32 - delta1/(1._real32 + delta1)) + lat2(abc(3),:) = lat2(abc(3),:) * (1._real32 - delta2/(1._real32 + delta2)) end if end if diff --git a/src/fortran/io.F90 b/src/fortran/lib/mod_io_utils.F90 similarity index 77% rename from src/fortran/io.F90 rename to src/fortran/lib/mod_io_utils.F90 index 0caf584..1e787a2 100644 --- a/src/fortran/io.F90 +++ b/src/fortran/lib/mod_io_utils.F90 @@ -4,13 +4,23 @@ !!! Ned Thaddeus Taylor !!! Code part of the ARTEMIS group !!!############################################################################# -module io - use misc +module artemis__io_utils + use artemis__constants, only: real32 + use artemis__misc implicit none + logical :: test_error_handling = .false. + + logical :: suppress_warnings = .false. - private !everything is private unless explicitly defined as public + private - character(25), public, parameter :: version="development version 1.0.3a" + public :: write_fmtd + public :: err_abort,print_warning, stop_program + public :: io_print_help + public :: print_header + + + character(25), public, parameter :: artemis__version__="development version 1.0.2a" !character(30), public, parameter :: & ! author(3) = [& ! "N. T. Taylor",& @@ -27,7 +37,7 @@ module io ! "S. G. Davies"& ! ] - + type, public :: tag_type character(25) :: name character(1) :: type @@ -41,18 +51,42 @@ module io character(20) :: deprecated_version end type tag_type - public :: write_fmtd - public :: err_abort,print_warning - public :: err_abort_print_struc - public :: io_print_help - public :: print_header - public :: setup_input_fmt,setup_output_fmt -!!!updated 2021/11/11 +contains + +!############################################################################### + subroutine stop_program(message, exit_code, block_stop) + !! Stop the program and print an error message. + implicit none + character(len=*), intent(in) :: message + integer, intent(in), optional :: exit_code + logical, intent(in), optional :: block_stop + + integer :: exit_code_ + logical :: block_stop_ + + if(present(exit_code)) then + exit_code_ = exit_code + else + exit_code_ = 1 + end if + if(present(block_stop)) then + block_stop_ = block_stop + else + block_stop_ = .false. + end if + + write(0,*) 'ERROR: ', trim(message) + if(.not.block_stop_)then + if(.not.test_error_handling) then + stop exit_code_ + end if + end if + end subroutine stop_program +!############################################################################### -contains !!!############################################################################# !!! prints the ARTEMIS logo and author list !!!############################################################################# @@ -76,7 +110,7 @@ subroutine print_header(unit) write(unit,'(A)') " Ab Initio Restructuring Tool " write(unit,'(A)') " Enabling Modelling of Interface Structures " write(unit,*) - write(unit,'(A,A)') " Welcome to ARTEMIS version ",version + write(unit,'(A,A)') " Welcome to ARTEMIS version ", artemis__version__ write(unit,'(A,A,1X,A,A)') " (build ",__DATE__,__TIME__,")" write(unit,*) write(unit,'(A)') " Authors:" @@ -255,28 +289,6 @@ end subroutine err_abort !!!############################################################################# -!!!############################################################################# -!!! Prints to stderr, prints structure and stops -!!!############################################################################# - subroutine err_abort_print_struc(in_lat,in_bas,name,message,lstop) - use rw_geom - implicit none - integer :: unit=0 - character(len=*) :: name,message - type(bas_type) :: in_bas - double precision, dimension(3,3) :: in_lat - logical, optional :: lstop - - - open(100,file=name) - call geom_write(100,in_lat,in_bas) - close(100) - if(message.ne.'') write(unit,'(A)') trim(message) - if(.not.present(lstop).or.lstop) stop - - end subroutine err_abort_print_struc -!!!############################################################################# - !!!############################################################################# !!! help and search @@ -413,82 +425,5 @@ subroutine io_print_help(unit, helpword, tags, search) end subroutine io_print_help !!!############################################################################# - - -!!!############################################################################# -!!! sets up the name of output files and subroutines to read files -!!!############################################################################# - subroutine setup_input_fmt(fmt) - use rw_geom, only : igeom_input - implicit none - character(len=*), intent(in) :: fmt - character(len=:), allocatable :: form - - - allocate(character(len=len(trim(adjustl(fmt)))) :: form) - form = trim(adjustl(to_upper(fmt))) - - select case(form) - case("VASP") - write(6,*) "Input files will be VASP formatted" - igeom_input=1 - case("CASTEP") - write(6,*) "Input files will be CASTEP formatted" - igeom_input=2 - !call err_abort('ERROR: ARTEMIS not yet set up for CASTEP') - case("QE","QUANTUMESPRESSO") - write(6,*) "Input files will be QuantumEspresso formatted" - igeom_input=3 - !call err_abort('ERROR: ARTEMIS not yet set up for Quantum Espresso') - case("CRYSTAL") - write(6,*) "Input files will be CRYSTAL formatted" - igeom_input=4 - call err_abort('ERROR: ARTEMIS not yet set up for CRYSTAL') - end select - - - end subroutine setup_input_fmt -!!!############################################################################# - - -!!!############################################################################# -!!! sets up the name of output files and subroutines to read files -!!!############################################################################# - subroutine setup_output_fmt(fmt,out_filename) - use rw_geom, only : igeom_output - implicit none - character(len=*) :: out_filename - character(len=*), intent(in) :: fmt - character(len=:), allocatable :: form - - - allocate(character(len=len(trim(adjustl(fmt)))) :: form) - form = trim(adjustl(to_upper(fmt))) - - select case(form) - case("VASP") - write(6,*) "Output files will be VASP formatted" - if(out_filename.eq.'') out_filename="POSCAR" - igeom_output=1 - case("CASTEP") - write(6,*) "Output files will be CASTEP formatted" - if(out_filename.eq.'') out_filename="struc.cell" - igeom_output=2 - !call err_abort('ERROR: ARTEMIS not yet set up for CASTEP') - case("QE","QUANTUMESPRESSO") - write(6,*) "Output files will be QuantumEspresso formatted" - if(out_filename.eq.'') out_filename="struc.geom" - igeom_output=3 - !call err_abort('ERROR: ARTEMIS not yet set up for Quantum Espresso') - case("CRYSTAL") - write(6,*) "Output files will be CRYSTAL formatted" - if(out_filename.eq.'') out_filename="INPUT_geom" - igeom_output=4 - call err_abort('ERROR: ARTEMIS not yet set up for CRYSTAL') - end select - - - end subroutine setup_output_fmt -!!!############################################################################# -end module io +end module artemis__io_utils diff --git a/src/fortran/lib/mod_io_utils_extd.F90 b/src/fortran/lib/mod_io_utils_extd.F90 new file mode 100644 index 0000000..3d5ac62 --- /dev/null +++ b/src/fortran/lib/mod_io_utils_extd.F90 @@ -0,0 +1,134 @@ +module artemis__io_utils_extd + use artemis__misc, only: to_upper + use artemis__io_utils, only: err_abort + + private + + public :: err_abort_print_struc + public :: setup_input_fmt, setup_output_fmt + + + +contains + +!############################################################################### + subroutine err_abort_print_struc(basis,filename,msg,lstop) + !! Print structure to file and stops + use artemis__geom_rw, only: basis_type, geom_write + implicit none + + ! Arguments + type(basis_type), intent(in) :: basis + !! Structure to print + character(len=*), intent(in) :: filename + !! File name to print to + character(len=*), intent(in) :: msg + !! Message to print + logical, intent(in), optional :: lstop + !! Boolean whether to stop or not + + ! Local variables + integer :: unit + !! File unit + + + open(newunit=unit,file=filename) + call geom_write(unit, basis) + close(unit) + if(msg.ne.'') write(0,'(A)') trim(msg) + if(present(lstop))then + if(lstop) stop + else + stop + end if + + end subroutine err_abort_print_struc +!############################################################################### + + +!############################################################################### + subroutine setup_input_fmt(fmt) + !! Set the structure file input format for the program + use artemis__geom_rw, only : igeom_input + implicit none + + ! Arguments + character(len=*), intent(in) :: fmt + !! Format of the input file + + ! Local variables + character(len=:), allocatable :: form + !! Formatted string for the input file + + + allocate(character(len=len(trim(adjustl(fmt)))) :: form) + form = trim(adjustl(to_upper(fmt))) + + select case(form) + case("VASP") + write(6,*) "Input files will be VASP formatted" + igeom_input=1 + case("CASTEP") + write(6,*) "Input files will be CASTEP formatted" + igeom_input=2 + !call err_abort('ERROR: ARTEMIS not yet set up for CASTEP') + case("QE","QUANTUMESPRESSO") + write(6,*) "Input files will be QuantumEspresso formatted" + igeom_input=3 + !call err_abort('ERROR: ARTEMIS not yet set up for Quantum Espresso') + case("CRYSTAL") + write(6,*) "Input files will be CRYSTAL formatted" + igeom_input=4 + call err_abort('ERROR: ARTEMIS not yet set up for CRYSTAL') + end select + + end subroutine setup_input_fmt +!############################################################################### + + +!############################################################################### + subroutine setup_output_fmt(fmt,out_filename) + !! Set the structure file input format for the program + use artemis__geom_rw, only : igeom_output + implicit none + + ! Arguments + character(len=*), intent(in) :: fmt + !! Format of the output file + character(len=*), intent(inout) :: out_filename + !! File name to print to + + ! Local variables + character(len=:), allocatable :: form + !! Formatted string for the output file + + + allocate(character(len=len(trim(adjustl(fmt)))) :: form) + form = trim(adjustl(to_upper(fmt))) + + select case(form) + case("VASP") + write(6,*) "Output files will be VASP formatted" + if(out_filename.eq.'') out_filename="POSCAR" + igeom_output=1 + case("CASTEP") + write(6,*) "Output files will be CASTEP formatted" + if(out_filename.eq.'') out_filename="struc.cell" + igeom_output=2 + !call err_abort('ERROR: ARTEMIS not yet set up for CASTEP') + case("QE","QUANTUMESPRESSO") + write(6,*) "Output files will be QuantumEspresso formatted" + if(out_filename.eq.'') out_filename="struc.geom" + igeom_output=3 + !call err_abort('ERROR: ARTEMIS not yet set up for Quantum Espresso') + case("CRYSTAL") + write(6,*) "Output files will be CRYSTAL formatted" + if(out_filename.eq.'') out_filename="INPUT_geom" + igeom_output=4 + call err_abort('ERROR: ARTEMIS not yet set up for CRYSTAL') + end select + + end subroutine setup_output_fmt +!############################################################################### + +end module artemis__io_utils_extd \ No newline at end of file diff --git a/src/fortran/lib/mod_misc.f90 b/src/fortran/lib/mod_misc.f90 index 3b45407..17ed52c 100644 --- a/src/fortran/lib/mod_misc.f90 +++ b/src/fortran/lib/mod_misc.f90 @@ -5,8 +5,6 @@ !!!############################################################################# !!! module contains various miscellaneous functions and subroutines. !!! module includes the following functions and subroutines: -!!! closest_below (returns closest element below input number) -!!! closest_above (returns closest element above input number) !!! sort1D (sort 1st col of array by size. Opt:sort 2nd array wrt 1st) !!! sort2D (sort 1st two columns of an array by size) !!! set (return the sorted set of unique elements) @@ -16,9 +14,7 @@ !!! swap_vec (swap two vectors around) !!!################## !!! Icount (counts words on line) -!!! readcl (read string and separate into a char array using user fs) !!! grep (finds 1st line containing the pattern) -!!! count_occ (count number of occurances of substring in string) !!! flagmaker (read flag inputs supplied and stores variable if present) !!! loadbar (writes out a loading bar to the terminal) !!! jump (moves file to specified line number) @@ -26,78 +22,26 @@ !!! to_upper (converts all characters in string to upper case) !!! to_lower (converts all characters in string to lower case) !!!############################################################################# -module misc +module artemis__misc + use artemis__constants, only: real32 implicit none + interface swap + procedure iswap, rswap, rswap_vec + end interface swap + interface sort1D - procedure isort1D,rsort1D,dsort1D + procedure isort1D,rsort1D end interface sort1D interface set - procedure iset,rset,dset + procedure iset,rset end interface set -!!!updated 2021/12/08 - contains -!!!##################################################### -!!! function to find closest -ve element in array -!!!##################################################### - function closest_below(vec,val,optmask) result(int) - implicit none - integer :: i,int - double precision :: val,best,dtmp1 - double precision, dimension(:) :: vec - logical, dimension(:), optional :: optmask - - int=0 - best=-huge(0.D0) - do i=1,size(vec) - dtmp1=vec(i)-val - if(present(optmask))then - if(.not.optmask(i)) cycle - end if - if(dtmp1.gt.best.and.dtmp1.lt.-1.D-8)then - best=dtmp1 - int=i - end if - end do - - return - end function closest_below -!!!##################################################### - - -!!!##################################################### -!!! function to find closest +ve element in array -!!!##################################################### - function closest_above(vec,val,optmask) result(int) - implicit none - integer :: i,int - double precision :: val,best,dtmp1 - double precision, dimension(:) :: vec - logical, dimension(:), optional :: optmask - - int=0 - best=huge(0.D0) - do i=1,size(vec) - dtmp1=vec(i)-val - if(present(optmask))then - if(.not.optmask(i)) cycle - end if - if(dtmp1.lt.best.and.dtmp1.gt.1.D-8)then - best=dtmp1 - int=i - end if - end do - - return - end function closest_above -!!!##################################################### - !!!##################################################### !!! sorts two arrays from min to max @@ -143,46 +87,9 @@ end subroutine isort1D subroutine rsort1D(arr1,arr2,reverse) implicit none integer :: i,dim,loc,ibuff - real :: rbuff + real(real32) :: dbuff logical :: udef_reverse - real, dimension(:) :: arr1 - integer, dimension(:),intent(inout),optional :: arr2 - logical, optional, intent(in) :: reverse - - if(present(reverse))then - udef_reverse=reverse - else - udef_reverse=.false. - end if - - dim=size(arr1,dim=1) - do i=1,dim - if(udef_reverse)then - loc=maxloc(arr1(i:dim),dim=1)+i-1 - else - loc=minloc(arr1(i:dim),dim=1)+i-1 - end if - rbuff=arr1(i) - arr1(i)=arr1(loc) - arr1(loc)=rbuff - - if(present(arr2)) then - ibuff=arr2(i) - arr2(i)=arr2(loc) - arr2(loc)=ibuff - end if - end do - - return - end subroutine rsort1D -!!!----------------------------------------------------- -!!!----------------------------------------------------- - subroutine dsort1D(arr1,arr2,reverse) - implicit none - integer :: i,dim,loc,ibuff - double precision :: dbuff - logical :: udef_reverse - double precision, dimension(:) :: arr1 + real(real32), dimension(:) :: arr1 integer, dimension(:),intent(inout),optional :: arr2 logical, optional, intent(in) :: reverse @@ -211,7 +118,7 @@ subroutine dsort1D(arr1,arr2,reverse) end do return - end subroutine dsort1D + end subroutine rsort1D !!!##################################################### @@ -222,8 +129,8 @@ subroutine sort2D(arr,dim) implicit none integer :: i,j,dim,loc,istart integer, dimension(3) :: a123 - double precision, dimension(3) :: buff - double precision, dimension(dim,3) :: arr + real(real32), dimension(3) :: buff + real(real32), dimension(dim,3) :: arr a123(:)=(/1,2,3/) istart=1 @@ -280,41 +187,11 @@ end subroutine iset subroutine rset(arr, tol) implicit none integer :: i,n - real :: tiny - real, allocatable, dimension(:) :: tmp_arr - - real, allocatable, dimension(:) :: arr - real, optional :: tol - - if(present(tol))then - tiny = tol - else - tiny = 1.E-4 - end if - - call sort1D(arr) - allocate(tmp_arr(size(arr))) - - tmp_arr(1) = arr(1) - n=1 - do i=2,size(arr) - if(abs(arr(i)-tmp_arr(n)).lt.tiny) cycle - n = n + 1 - tmp_arr(n) = arr(i) - end do - call move_alloc(tmp_arr, arr) - - end subroutine rset -!!!----------------------------------------------------- -!!!----------------------------------------------------- - subroutine dset(arr, tol) - implicit none - integer :: i,n - double precision :: tiny - double precision, allocatable, dimension(:) :: tmp_arr + real(real32) :: tiny + real(real32), allocatable, dimension(:) :: tmp_arr - double precision, allocatable, dimension(:) :: arr - double precision, optional :: tol + real(real32), allocatable, dimension(:) :: arr + real(real32), optional :: tol if(present(tol))then tiny = tol @@ -334,7 +211,7 @@ subroutine dset(arr, tol) end do call move_alloc(tmp_arr, arr) - end subroutine dset + end subroutine rset !!!##################################################### @@ -347,8 +224,8 @@ subroutine sort_col(arr1,col,reverse) implicit none integer :: i,dim,loc logical :: udef_reverse - double precision, allocatable, dimension(:) :: dbuff - double precision, dimension(:,:) :: arr1 + real(real32), allocatable, dimension(:) :: dbuff + real(real32), dimension(:,:) :: arr1 integer, intent(in) :: col logical, optional, intent(in) :: reverse @@ -383,44 +260,44 @@ end subroutine sort_col !!!##################################################### !!! swap two ints !!!##################################################### - subroutine swap_i(i1,i2) + subroutine iswap(i1,i2) implicit none integer :: i1,i2,itmp itmp=i1 i1=i2 i2=itmp - end subroutine swap_i + end subroutine iswap !!!##################################################### !!!##################################################### !!! swap two doubles !!!##################################################### - subroutine swap_d(d1,d2) + subroutine rswap(d1,d2) implicit none - double precision :: d1,d2,dtmp + real(real32) :: d1,d2,dtmp dtmp=d1 d1=d2 d2=dtmp - end subroutine swap_d + end subroutine rswap !!!##################################################### !!!##################################################### !!! swap two vectors !!!##################################################### - subroutine swap_vec(vec1,vec2) + subroutine rswap_vec(vec1,vec2) implicit none - double precision,dimension(:)::vec1,vec2 - double precision,allocatable,dimension(:)::tvec + real(real32),dimension(:)::vec1,vec2 + real(real32),allocatable,dimension(:)::tvec allocate(tvec(size(vec1))) tvec=vec1(:) vec1(:)=vec2(:) vec2(:)=tvec - end subroutine swap_vec + end subroutine rswap_vec !!!##################################################### @@ -467,52 +344,6 @@ end function Icount !!!##################################################### -!!!##################################################### -!!! counts the number of words on a line -!!!##################################################### - subroutine readcl(full_line,store,tmpchar) - character(*) :: full_line - !ONLY WORKS WITH IFORT COMPILER - ! character(1) :: fs - character(len=:),allocatable :: fs - character(*),optional :: tmpchar - character(100),dimension(1000) :: tmp_store - character(*),allocatable,dimension(:),optional :: store - integer ::items,pos,k,length - items=0 - pos=1 - - length=1 - if(present(tmpchar)) length=len(trim(tmpchar)) - allocate(character(len=length) :: fs) - if(present(tmpchar)) then - fs=tmpchar - else - fs=" " - end if - - loop: do - k=verify(full_line(pos:),fs) - if (k.eq.0) exit loop - pos=k+pos-1 - k=scan(full_line(pos:),fs) - if (k.eq.0) exit loop - items=items+1 - tmp_store(items)=full_line(pos:pos+k-1) - pos=k+pos-1 - end do loop - - if(present(store))then - if(.not.allocated(store)) allocate(store(items)) - do k=1,items - store(k)=trim(tmp_store(k)) - end do - end if - - end subroutine readcl -!!!##################################################### - - !!!##################################################### !!! grep !!!##################################################### @@ -532,32 +363,6 @@ end subroutine grep !!!##################################################### -!!!##################################################### -!!! count number of occurances of substring in string -!!!##################################################### - function count_occ(string,substring) - implicit none - integer :: pos,i,count_occ - character(*) :: string,substring - - pos=1 - count_occ=0 - countloop: do - i=verify(string(pos:), substring) - if (i.eq.0) exit countloop - if(pos.eq.len(string)) exit countloop - count_occ=count_occ+1 - pos=i+pos-1 - i=scan(string(pos:), ' ') - if (i.eq.0) exit countloop - pos=i+pos-1 - end do countloop - - return - end function count_occ -!!!##################################################### - - !!!##################################################### !!! Assigns variables of flags from getarg !!!##################################################### @@ -722,4 +527,37 @@ function to_lower(buffer) result(lower) end function to_lower !!!##################################################### -end module misc + +!############################################################################### + function strip_null(buffer) result(stripped) + !! Strip null characters from a string. + !! + !! This is meant for handling strings passed from Python, which gain + !! null characters at the end. The procedure finds the first null + !! character and truncates the string at that point. + !! Null characters are represented by ASCII code 0. + implicit none + + ! Arguments + character(*), intent(in) :: buffer + !! String to be stripped. + character(len=len(buffer)) :: stripped + !! Stripped string. + + ! Local variables + integer :: i + !! Loop index. + + stripped = "" + do i = 1, len(buffer) + if(iachar(buffer(i:i)).ne.0)then + stripped(i:i)=buffer(i:i) + else + exit + end if + end do + + end function strip_null +!############################################################################### + +end module artemis__misc diff --git a/src/fortran/lib/mod_misc_linalg.f90 b/src/fortran/lib/mod_misc_linalg.f90 index 5fd9467..fa09f82 100644 --- a/src/fortran/lib/mod_misc_linalg.f90 +++ b/src/fortran/lib/mod_misc_linalg.f90 @@ -40,25 +40,10 @@ !!! gen_group (generate group from a subset of elements) !!!############################################################################# module misc_linalg + use artemis__constants, only: real32 implicit none integer, parameter, private :: QuadInt_K = selected_int_kind (16) - interface uvec - procedure ruvec,duvec - end interface uvec - - interface modu - procedure rmodu,dmodu - end interface modu - - interface proj - procedure rproj,dproj - end interface proj - - interface cross - procedure rcross,dcross - end interface cross - interface gcd procedure gcd_vec,gcd_num end interface gcd @@ -80,42 +65,25 @@ module misc_linalg !!!##################################################### !!! finds unit vector of an arbitrary vector !!!##################################################### - function ruvec(vec) result(uvec) - implicit none - real,dimension(:)::vec - real,allocatable,dimension(:)::uvec - allocate(uvec(size(vec))) - uvec=vec/rmodu(vec) - end function ruvec -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function duvec(vec) result(uvec) + function uvec(vec) result(output) implicit none - double precision,dimension(:)::vec - double precision,allocatable,dimension(:)::uvec - allocate(uvec(size(vec))) - uvec=vec/dmodu(vec) - end function duvec + real(real32),dimension(:)::vec + real(real32),allocatable,dimension(:) :: output + allocate(output(size(vec))) + output = vec/modu(vec) + end function uvec !!!##################################################### !!!##################################################### !!! finds modulus of an arbitrary length vector !!!##################################################### - function rmodu(vec) result(modu) - implicit none - real,dimension(:)::vec - real::modu - modu=abs(sqrt(sum(vec(:)**2))) - end function rmodu -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function dmodu(vec) result(modu) + function modu(vec) result(output) implicit none - double precision,dimension(:)::vec - double precision::modu - modu=abs(sqrt(sum(vec(:)**2))) - end function dmodu + real(real32),dimension(:)::vec + real(real32)::output + output = abs(sqrt(sum(vec(:)**2))) + end function modu !!!##################################################### @@ -123,26 +91,15 @@ end function dmodu !!! projection operator !!!##################################################### !!! projection of v on u - function rproj(u,v) result(proj) + function proj(u,v) result(output) implicit none - real, dimension(:) :: u,v - real, allocatable, dimension(:) :: proj + real(real32), dimension(:) :: u,v + real(real32), allocatable, dimension(:) :: output - allocate(proj(size(u,dim=1))) - proj = u*dot_product(v,u)/dot_product(u,u) + allocate(output(size(u,dim=1))) + output = u*dot_product(v,u)/dot_product(u,u) - end function rproj -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function dproj(u,v) result(proj) - implicit none - double precision, dimension(:) :: u,v - double precision, allocatable, dimension(:) :: proj - - allocate(proj(size(u,dim=1))) - proj = u*dot_product(v,u)/dot_product(u,u) - - end function dproj + end function proj !!!##################################################### @@ -155,9 +112,9 @@ end function dproj function GramSchmidt(basis,normalise,cmo) result(u) implicit none integer :: num,dim,i,j - double precision, allocatable, dimension(:) :: vtmp - double precision, dimension(:,:), intent(in) :: basis - double precision, allocatable, dimension(:,:) :: u + real(real32), allocatable, dimension(:) :: vtmp + real(real32), dimension(:,:), intent(in) :: basis + real(real32), allocatable, dimension(:,:) :: u logical, optional, intent(in) :: cmo logical, optional, intent(in) :: normalise @@ -184,7 +141,7 @@ function GramSchmidt(basis,normalise,cmo) result(u) !! Evaluates the Gram-Schmidt basis u(1,:) = basis(1,:) do i=2,num - vtmp = 0.D0 + vtmp = 0._real32 do j=1,i-1,1 vtmp(:) = vtmp(:) + proj(u(j,:),basis(i,:)) end do @@ -209,28 +166,16 @@ end function GramSchmidt !!!##################################################### !!! cross product !!!##################################################### - pure function rcross(a,b) result(cross) - implicit none - real, dimension(3) :: cross - real, dimension(3), intent(in) :: a,b - - cross(1) = a(2)*b(3) - a(3)*b(2) - cross(2) = a(3)*b(1) - a(1)*b(3) - cross(3) = a(1)*b(2) - a(2)*b(1) - - end function rcross -!!!----------------------------------------------------- -!!!----------------------------------------------------- - pure function dcross(a,b) result(cross) + pure function cross(a,b) result(output) implicit none - double precision, dimension(3) :: cross - double precision, dimension(3), intent(in) :: a,b + real(real32), dimension(3) :: output + real(real32), dimension(3), intent(in) :: a,b - cross(1) = a(2)*b(3) - a(3)*b(2) - cross(2) = a(3)*b(1) - a(1)*b(3) - cross(3) = a(1)*b(2) - a(2)*b(1) + output(1) = a(2)*b(3) - a(3)*b(2) + output(2) = a(3)*b(1) - a(1)*b(3) + output(3) = a(1)*b(2) - a(2)*b(1) - end function dcross + end function cross !!!##################################################### @@ -245,10 +190,10 @@ end function dcross !!!##################################################### function cross_matrix(a) implicit none - double precision, dimension(3,3) :: cross_matrix - double precision, dimension(3), intent(in) :: a + real(real32), dimension(3,3) :: cross_matrix + real(real32), dimension(3), intent(in) :: a - cross_matrix=0.D0 + cross_matrix=0._real32 cross_matrix(1,2) = -a(3) cross_matrix(1,3) = a(2) @@ -269,8 +214,8 @@ end function cross_matrix function outer_product(a,b) implicit none integer :: j - double precision, dimension(:) :: a,b - double precision,allocatable,dimension(:,:)::outer_product + real(real32), dimension(:) :: a,b + real(real32),allocatable,dimension(:,:)::outer_product allocate(outer_product(size(a),size(b))) @@ -290,10 +235,10 @@ function ivec_dmat_mul(a,mat) result(vec) implicit none integer :: j integer, dimension(:) :: a - double precision, dimension(:,:) :: mat - double precision,allocatable,dimension(:) :: vec + real(real32), dimension(:,:) :: mat + real(real32),allocatable,dimension(:) :: vec - vec=0.D0 + vec=0._real32 allocate(vec(size(a))) do j=1,size(a) vec(:)=vec(:)+dble(a(j))*mat(j,:) @@ -306,11 +251,11 @@ end function ivec_dmat_mul function dvec_dmat_mul(a,mat) result(vec) implicit none integer :: j - double precision, dimension(:) :: a - double precision, dimension(:,:) :: mat - double precision,allocatable,dimension(:) :: vec + real(real32), dimension(:) :: a + real(real32), dimension(:,:) :: mat + real(real32),allocatable,dimension(:) :: vec - vec=0.D0 + vec=0._real32 allocate(vec(size(a))) do j=1,size(a) vec(:)=vec(:)+a(j)*mat(j,:) @@ -327,21 +272,21 @@ end function dvec_dmat_mul function get_vec_multiple(a,b) result(multi) implicit none integer :: i - double precision :: multi - double precision, dimension(:) :: a,b + real(real32) :: multi + real(real32), dimension(:) :: a,b - multi=1.D0 + multi=1._real32 do i=1,size(a) - if(a(i).eq.0.D0.or.b(i).eq.0.D0) cycle + if(abs(a(i)).lt.1.E-6_real32.or.abs(b(i)).lt.1.E-6_real32) cycle multi=b(i)/a(i) exit end do checkloop: do i=1,size(a) - if(a(i).eq.0.D0.or.b(i).eq.0.D0) cycle - if(abs(a(i)*multi-b(i)).gt.1.D-8)then + if(abs(a(i)).lt.1.E-6_real32.or.abs(b(i)).lt.1.E-6_real32) cycle + if(abs(a(i)*multi-b(i)).gt.1.E-6_real32)then - multi=0.D0 + multi=0._real32 exit checkloop end if end do checkloop @@ -363,12 +308,12 @@ end function get_vec_multiple !!!##################################################### function get_angle(vec1,vec2) result(angle) implicit none - double precision :: angle - double precision, dimension(3) :: vec1,vec2 + real(real32) :: angle + real(real32), dimension(3) :: vec1,vec2 angle = acos( dot_product(vec1,vec2)/& ( modu(vec1) * modu(vec2) )) - if (isnan(angle)) angle = 0.D0 + if (isnan(angle)) angle = 0._real32 return end function get_angle @@ -380,8 +325,8 @@ end function get_angle !!!##################################################### function get_area(a,b) result(area) implicit none - double precision :: area - double precision, dimension(3) :: vec,a,b + real(real32) :: area + real(real32), dimension(3) :: vec,a,b vec = cross(a,b) area = sqrt(dot_product(vec,vec)) @@ -397,21 +342,21 @@ end function get_area function get_vol(lat) result(vol) implicit none integer :: n,i,j,k,l - double precision :: vol,scale - double precision, dimension(3,3) :: lat - double precision, dimension(3) :: a,b,c + real(real32) :: vol,scale + real(real32), dimension(3,3) :: lat + real(real32), dimension(3) :: a,b,c a=lat(1,:) b=lat(2,:) c=lat(3,:) - vol = 0.D0;scale = 1.D0 + vol = 0._real32;scale = 1._real32 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.D0) goto 1 + if(scale<0._real32) goto 1 return end function get_vol @@ -423,8 +368,8 @@ end function get_vol !!!##################################################### function trace(mat) integer::j - double precision,dimension(:,:)::mat - double precision::trace + real(real32),dimension(:,:)::mat + real(real32)::trace do j=1,size(mat,1) trace=trace+mat(j,j) end do @@ -447,8 +392,8 @@ end function idet !!!----------------------------------------------------- !!!----------------------------------------------------- function ddet(mat) result(det) - double precision :: det - double precision, dimension(3,3) :: mat + real(real32) :: det + real(real32), dimension(3,3) :: 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)& @@ -462,8 +407,8 @@ end function ddet !!! returns inverse of 2x2 or 3x3 matrix !!!##################################################### pure function inverse(mat) - double precision, dimension(:,:), intent(in) :: mat - double precision, dimension(size(mat(:,1),dim=1),size(mat(1,:),dim=1)) :: inverse + real(real32), dimension(:,:), intent(in) :: mat + real(real32), dimension(size(mat(:,1),dim=1),size(mat(1,:),dim=1)) :: inverse if(size(mat(1,:),dim=1).eq.2)then inverse=inverse_2x2(mat) @@ -479,22 +424,22 @@ end function inverse !!! returns inverse of 2 x 2 matrix !!!##################################################### pure function inverse_2x2(mat) result(inverse) - double precision :: det - double precision, dimension(2,2) :: inverse - double precision, dimension(2,2), intent(in) :: mat + real(real32) :: det + real(real32), dimension(2,2) :: inverse + real(real32), dimension(2,2), intent(in) :: mat det=mat(1,1)*mat(2,2)-mat(1,2)*mat(2,1) - !if(det.eq.0.D0)then + !if(det.eq.0._real32)then ! write(0,'("ERROR: Internal error in inverse_2x2")') ! write(0,'(2X,"inverse_2x2 in mod_misc_linalg found determinant of 0")') ! write(0,'(2X,"Exiting...")') ! stop !end if - inverse(1,1)=+1.D0/det*(mat(2,2)) - inverse(2,1)=-1.D0/det*(mat(1,2)) - inverse(1,2)=-1.D0/det*(mat(2,1)) - inverse(2,2)=+1.D0/det*(mat(1,1)) + inverse(1,1)=+1._real32/det*(mat(2,2)) + inverse(2,1)=-1._real32/det*(mat(1,2)) + inverse(1,2)=-1._real32/det*(mat(2,1)) + inverse(2,2)=+1._real32/det*(mat(1,1)) end function inverse_2x2 !!!##################################################### @@ -504,30 +449,30 @@ end function inverse_2x2 !!! returns inverse of 3 x 3 matrix !!!##################################################### pure function inverse_3x3(mat) result(inverse) - double precision :: det - double precision, dimension(3,3) :: inverse - double precision, dimension(3,3), intent(in) :: mat + real(real32) :: det + real(real32), dimension(3,3) :: inverse + 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) - !if(det.eq.0.D0)then + !if(det.eq.0._real32)then ! write(0,'("ERROR: Internal error in inverse_3x3")') ! write(0,'(2X,"inverse_3x3 in mod_misc_linalg found determinant of 0")') ! write(0,'(2X,"Exiting...")') ! stop !end if - inverse(1,1)=+1.D0/det*(mat(2,2)*mat(3,3)-mat(2,3)*mat(3,2)) - inverse(2,1)=-1.D0/det*(mat(2,1)*mat(3,3)-mat(2,3)*mat(3,1)) - inverse(3,1)=+1.D0/det*(mat(2,1)*mat(3,2)-mat(2,2)*mat(3,1)) - inverse(1,2)=-1.D0/det*(mat(1,2)*mat(3,3)-mat(1,3)*mat(3,2)) - inverse(2,2)=+1.D0/det*(mat(1,1)*mat(3,3)-mat(1,3)*mat(3,1)) - inverse(3,2)=-1.D0/det*(mat(1,1)*mat(3,2)-mat(1,2)*mat(3,1)) - inverse(1,3)=+1.D0/det*(mat(1,2)*mat(2,3)-mat(1,3)*mat(2,2)) - inverse(2,3)=-1.D0/det*(mat(1,1)*mat(2,3)-mat(1,3)*mat(2,1)) - inverse(3,3)=+1.D0/det*(mat(1,1)*mat(2,2)-mat(1,2)*mat(2,1)) + inverse(1,1)=+1._real32/det*(mat(2,2)*mat(3,3)-mat(2,3)*mat(3,2)) + inverse(2,1)=-1._real32/det*(mat(2,1)*mat(3,3)-mat(2,3)*mat(3,1)) + inverse(3,1)=+1._real32/det*(mat(2,1)*mat(3,2)-mat(2,2)*mat(3,1)) + inverse(1,2)=-1._real32/det*(mat(1,2)*mat(3,3)-mat(1,3)*mat(3,2)) + inverse(2,2)=+1._real32/det*(mat(1,1)*mat(3,3)-mat(1,3)*mat(3,1)) + inverse(3,2)=-1._real32/det*(mat(1,1)*mat(3,2)-mat(1,2)*mat(3,1)) + inverse(1,3)=+1._real32/det*(mat(1,2)*mat(2,3)-mat(1,3)*mat(2,2)) + inverse(2,3)=-1._real32/det*(mat(1,1)*mat(2,3)-mat(1,3)*mat(2,1)) + inverse(3,3)=+1._real32/det*(mat(1,1)*mat(2,2)-mat(1,2)*mat(2,1)) end function inverse_3x3 !!!##################################################### @@ -538,15 +483,15 @@ end function inverse_3x3 !!!##################################################### recursive function rec_det(a,n) result(res) integer :: i, sign - double precision :: res + real(real32) :: res integer, intent(in) :: n - double precision, dimension(n,n), intent(in) :: a - double precision, dimension(n-1, n-1) :: tmp + real(real32), dimension(n,n), intent(in) :: a + real(real32), dimension(n-1, n-1) :: tmp if(n.eq.1) then res = a(1,1) else - res = 0.D0 + res = 0._real32 sign = 1 do i=1, n tmp(:,:(i-1))=a(2:,:i-1) @@ -572,16 +517,16 @@ end function rec_det function LUdet(inmat) implicit none integer :: i,N - double precision :: LUdet - double precision, dimension(:,:) :: inmat - double precision, dimension(size(inmat,1),size(inmat,1)) :: L,U + real(real32) :: LUdet + real(real32), dimension(:,:) :: inmat + real(real32), dimension(size(inmat,1),size(inmat,1)) :: L,U - L=0.D0 - U=0.D0 + L=0._real32 + U=0._real32 N=size(inmat,1) call LUdecompose(inmat,L,U) - LUdet=(-1.D0)**N + LUdet=(-1._real32)**N do i=1,N LUdet=LUdet*L(i,i)*U(i,i) end do @@ -605,13 +550,13 @@ end function LUdet function LUinv(inmat) implicit none integer :: i,m,N - double precision, dimension(:,:) :: inmat - double precision, dimension(size(inmat,1),size(inmat,1)) :: LUinv - double precision, dimension(size(inmat,1),size(inmat,1)) :: L,U - double precision, dimension(size(inmat,1)) :: c,z,x + real(real32), dimension(:,:) :: inmat + real(real32), dimension(size(inmat,1),size(inmat,1)) :: LUinv + real(real32), dimension(size(inmat,1),size(inmat,1)) :: L,U + real(real32), dimension(size(inmat,1)) :: c,z,x - L=0.D0 - U=0.D0 + L=0._real32 + U=0._real32 N=size(inmat,1) call LUdecompose(inmat,L,U) @@ -619,8 +564,8 @@ function LUinv(inmat) !!! c are column vectors of the identity matrix !!! uses forward substitution to solve do m=1,N - c=0.D0 - c(m)=1.D0 + c=0._real32 + c(m)=1._real32 z(1)=c(1) do i=2,N @@ -656,16 +601,16 @@ end function LUinv subroutine LUdecompose(inmat,L,U) implicit none integer :: i,j,N - double precision, dimension(:,:) :: inmat,L,U - double precision, dimension(size(inmat,1),size(inmat,1)) :: mat + real(real32), dimension(:,:) :: inmat,L,U + real(real32), dimension(size(inmat,1),size(inmat,1)) :: mat N=size(inmat,1) mat=inmat - L=0.D0 - U=0.D0 + L=0._real32 + U=0._real32 do j=1,N - L(j,j)=1.D0 + L(j,j)=1._real32 end do !!! Solves the lower matrix do j=1,N-1 @@ -703,8 +648,8 @@ end subroutine LUdecompose !!!##################################################### function find_tf(mat1,mat2) result(tf) implicit none - double precision, dimension(:,:) :: mat1,mat2 - double precision, allocatable, dimension(:,:) :: tf + real(real32), dimension(:,:) :: mat1,mat2 + real(real32), allocatable, dimension(:,:) :: tf allocate(tf(size(mat2(:,1),dim=1),size(mat1(1,:),dim=1))) tf=matmul(inverse(mat1),mat2) @@ -729,15 +674,15 @@ end function find_tf !!! hence, qA=qY P^-1 function simeq(qX,qY) integer :: i,j,n,loc - double precision, dimension(:) :: qX,qY - double precision, dimension(size(qY)) :: funcY - double precision, dimension(size(qY)) :: simeq,tmpqY - double precision, dimension(size(qY),size(qY)) :: P,invP,tmpP + real(real32), dimension(:) :: qX,qY + real(real32), dimension(size(qY)) :: funcY + real(real32), dimension(size(qY)) :: simeq,tmpqY + real(real32), dimension(size(qY),size(qY)) :: P,invP,tmpP n=size(qX) funcy=qY - P=0.D0 + P=0._real32 do i=1,n do j=1,n P(i,j)=(qX(i)**dble(n-j)) @@ -775,19 +720,19 @@ end function simeq function LLL_reduce(basis,delta) result(obas) implicit none integer :: num,dim,i,j,k,loc - double precision :: d,dtmp - double precision, allocatable, dimension(:) :: vtmp,mag_bas - double precision, allocatable, dimension(:,:) :: mu,GSbas,obas + real(real32) :: d,dtmp + real(real32), allocatable, dimension(:) :: vtmp,mag_bas + real(real32), allocatable, dimension(:,:) :: mu,GSbas,obas - double precision, dimension(:,:), intent(in) :: basis - double precision, optional, intent(in) :: delta + real(real32), dimension(:,:), intent(in) :: basis + real(real32), optional, intent(in) :: delta !! set up the value for delta if(present(delta))then d = delta else - d = 0.75D0 + d = 0.75_real32 end if !! allocate and initialise arrays @@ -830,7 +775,7 @@ function LLL_reduce(basis,delta) result(obas) do while(k.le.num) jloop: do j=k-1,1!,-1 - if(abs(mu(k,j)).lt.0.5D0)then + if(abs(mu(k,j)).lt.0.5_real32)then obas(k,:) = obas(k,:) - & nint(mu(k,j))*obas(j,:) !! only need to update GSbas(k:,:) and mu @@ -841,7 +786,7 @@ function LLL_reduce(basis,delta) result(obas) end do jloop if(dot_product(GSbas(k,:),GSbas(k,:)).ge.& - (d - mu(k,k-1)**2.D0)*& + (d - mu(k,k-1)**2._real32)*& dot_product(GSbas(k-1,:),GSbas(k-1,:)) )then k = k + 1 else @@ -867,7 +812,7 @@ function LLL_reduce(basis,delta) result(obas) function get_mu(bas1,bas2) result(mu) implicit none integer :: num1,num2 - double precision, allocatable, dimension(:,:) :: mu,bas1,bas2 + real(real32), allocatable, dimension(:,:) :: mu,bas1,bas2 num1 = size(bas1(:,1),dim=1) num2 = size(bas2(:,1),dim=1) @@ -888,10 +833,10 @@ end function get_mu subroutine update_GS_and_mu(GSbas,mu,basis,k) implicit none integer :: num,dim,i,j - double precision, allocatable, dimension(:) :: vtmp + real(real32), allocatable, dimension(:) :: vtmp integer, intent(in) :: k - double precision, allocatable, dimension(:,:) :: GSbas,basis,mu + real(real32), allocatable, dimension(:,:) :: GSbas,basis,mu num = size(basis(:,1),dim=1) dim = size(basis(1,:),dim=1) @@ -900,7 +845,7 @@ subroutine update_GS_and_mu(GSbas,mu,basis,k) !!update Gram-Schmidt vectors do i=k,num,1 - vtmp = 0.D0 + vtmp = 0._real32 do j=1,i-1,1 vtmp(:) = vtmp(:) + proj(GSbas(j,:),basis(i,:)) end do @@ -933,25 +878,25 @@ end function LLL_reduce !!!##################################################### function rotvec(a,theta,phi,psi,new_length) implicit none - double precision :: magold,theta,phi,psi - double precision, dimension(3) :: a,rotvec - double precision, dimension(3,3) :: rotmat,rotmatx,rotmaty,rotmatz - double precision, optional :: new_length + real(real32) :: magold,theta,phi,psi + real(real32), dimension(3) :: a,rotvec + real(real32), dimension(3,3) :: rotmat,rotmatx,rotmaty,rotmatz + real(real32), optional :: new_length - ! if(phi.ne.0.D0) phi=-phi + ! if(phi.ne.0._real32) phi=-phi rotmatx=reshape((/& - 1.D0, 0.D0, 0.D0, & - 0.D0, cos(theta), -sin(theta),& - 0.D0, sin(theta), cos(theta)/), shape(rotmatx)) + 1._real32, 0._real32, 0._real32, & + 0._real32, cos(theta), -sin(theta),& + 0._real32, sin(theta), cos(theta)/), shape(rotmatx)) rotmaty=reshape((/& - cos(phi), 0.D0, sin(phi),& - 0.D0, 1.D0, 0.D0, & - -sin(phi), 0.D0, cos(phi)/), shape(rotmaty)) + cos(phi), 0._real32, sin(phi),& + 0._real32, 1._real32, 0._real32, & + -sin(phi), 0._real32, cos(phi)/), shape(rotmaty)) rotmatz=reshape((/& - cos(psi), -sin(psi), 0.D0,& - sin(psi), cos(psi), 0.D0, & - 0.D0, 0.D0, 1.D0/), shape(rotmatz)) + cos(psi), -sin(psi), 0._real32,& + sin(psi), cos(psi), 0._real32, & + 0._real32, 0._real32, 1._real32/), shape(rotmatz)) rotmat=matmul(rotmaty,rotmatx) @@ -974,13 +919,13 @@ end function rotvec function rot_arb_lat(a,lat,ang) result(vec) implicit none integer :: i - double precision, dimension(3) :: a,u,ang,vec - double precision, dimension(3,3) :: rotmat,ident,lat + real(real32), dimension(3) :: a,u,ang,vec + real(real32), dimension(3,3) :: rotmat,ident,lat - ident=0.D0 + ident=0._real32 do i=1,3 - ident(i,i)=1.D0 + ident(i,i)=1._real32 end do vec=a @@ -1096,17 +1041,17 @@ end function lcm integer function get_frac_denom(val) implicit none integer :: i - double precision :: val - double precision :: a,b,c,tiny + real(real32) :: val + real(real32) :: a,b,c,tiny - a=mod(val,1.D0) - b=1.D0 + a=mod(val,1._real32) + b=1._real32 tiny=1.D-6 i=0 do i=i+1 - if(abs(nint(1.D0/a)-(1.D0/a)).lt.tiny.and.& - abs(nint(val*1.D0/a)-val*(1.D0/a)).lt.tiny) exit + if(abs(nint(1._real32/a)-(1._real32/a)).lt.tiny.and.& + abs(nint(val*1._real32/a)-val*(1._real32/a)).lt.tiny) exit c=abs(b-a) b=a a=c @@ -1116,7 +1061,7 @@ integer function get_frac_denom(val) end if end do - get_frac_denom=nint(1.D0/a) + get_frac_denom=nint(1._real32/a) return end function get_frac_denom @@ -1129,9 +1074,9 @@ end function get_frac_denom function reduce_vec_gcd(invec) result(vec) implicit none integer :: i,a - double precision :: div,old_div,tol - double precision, allocatable, dimension(:) :: vec,tvec - double precision, dimension(:), intent(in) :: invec + real(real32) :: div,old_div,tol + real(real32), allocatable, dimension(:) :: vec,tvec + real(real32), dimension(:), intent(in) :: invec !!! MAKE IT DO SOMETHING IF IT CANNOT FULLY INTEGERISE @@ -1163,7 +1108,7 @@ function reduce_vec_gcd(invec) result(vec) div=a end if - if(div.eq.0.D0) return + if(div.eq.0._real32) return allocate(tvec(size(invec))) tvec=vec/div if(any(abs(tvec(:)-nint(tvec(:))).gt.tol)) return @@ -1180,14 +1125,14 @@ end function reduce_vec_gcd function gen_group(elem,mask,tol) result(group) implicit none integer :: i,j,k,nelem,ntot_elem,dim1,dim2,iter - double precision :: tiny - double precision, allocatable, dimension(:,:) :: tmp_elem,cur_elem,apply_elem - double precision, allocatable, dimension(:,:,:) :: tmp_group + real(real32) :: tiny + real(real32), allocatable, dimension(:,:) :: tmp_elem,cur_elem,apply_elem + real(real32), allocatable, dimension(:,:,:) :: tmp_group - double precision, dimension(:,:,:), intent(in) :: elem + real(real32), dimension(:,:,:), intent(in) :: elem logical, dimension(:,:), optional, intent(in) :: mask - double precision, allocatable, dimension(:,:,:) :: group - double precision, optional, intent(in) :: tol + real(real32), allocatable, dimension(:,:,:) :: group + real(real32), optional, intent(in) :: tol if(present(tol))then @@ -1213,7 +1158,7 @@ function gen_group(elem,mask,tol) result(group) !write(0,'(2(2X,F9.6))') cur_elem(:,:) !write(0,*) if(present(mask))then - where(mask.and.(cur_elem(:,:).lt.-tiny.or.cur_elem(:,:).ge.1.D0-tiny)) + where(mask.and.(cur_elem(:,:).lt.-tiny.or.cur_elem(:,:).ge.1._real32-tiny)) cur_elem(:,:) = cur_elem(:,:) - floor(cur_elem(:,:)+tiny) end where end if @@ -1237,7 +1182,7 @@ function gen_group(elem,mask,tol) result(group) end if tmp_elem(:,:) = matmul((apply_elem(:,:)),tmp_elem(:,:)) if(present(mask))then - where(mask.and.(tmp_elem(:,:).lt.-tiny.or.tmp_elem(:,:).ge.1.D0-tiny)) + where(mask.and.(tmp_elem(:,:).lt.-tiny.or.tmp_elem(:,:).ge.1._real32-tiny)) tmp_elem(:,:) = tmp_elem(:,:) - floor(tmp_elem(:,:)+tiny) end where end if diff --git a/src/fortran/lib/mod_misc_maths.f90 b/src/fortran/lib/mod_misc_maths.f90 index 869b0b0..7f7ef58 100644 --- a/src/fortran/lib/mod_misc_maths.f90 +++ b/src/fortran/lib/mod_misc_maths.f90 @@ -31,35 +31,11 @@ !!! slater_array (apply slater distribution to a set of points in array) !!!############################################################################# module misc_maths + use artemis__constants, only: real32 implicit none integer, parameter :: QuadInt_K = selected_int_kind (16) - interface gauss - procedure rgauss,dgauss - end interface gauss - interface range - procedure rrange,drange - end interface range - interface normalise - procedure rnormalise,dnormalise - end interface normalise - interface running_avg - procedure rrunning_avg,drunning_avg - end interface running_avg - - interface gauss_array - procedure rgauss_array,dgauss_array - end interface gauss_array - interface cauchy_array - procedure rcauchy_array,dcauchy_array - end interface cauchy_array - interface slater_array - procedure rslater_array,dslater_array - end interface slater_array - - -!!!updated 2020/02/03 contains @@ -84,42 +60,23 @@ end function times !!!##################################################### !!! evaluates a gausssian at a point !!!##################################################### - function rgauss(pos,centre,sigma,tol) result(gauss) - real :: gauss,x - real :: pos,centre,sigma - real :: udef_tol - real, optional :: tol + function gauss(pos,centre,sigma,tol) result(output) + real(real32) :: output,x + real(real32) :: pos,centre,sigma + real(real32) :: udef_tol + real(real32), optional :: tol if(present(tol))then udef_tol=tol else - udef_tol=16.D0 + udef_tol=38._real32 end if - x=(pos-centre)**2.E0/(2.E0*sigma) + x=(pos-centre)**2._real32/(2._real32*sigma) if(abs(x).lt.udef_tol) then - gauss=exp(-(x)) + output=exp(-(x)) else - gauss=0.D0 + output=0._real32 end if - end function rgauss -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function dgauss(pos,centre,sigma,tol) result(gauss) - double precision :: gauss,x - double precision :: pos,centre,sigma - double precision :: udef_tol - double precision, optional :: tol - if(present(tol))then - udef_tol=tol - else - udef_tol=38.D0 - end if - x=(pos-centre)**2.D0/(2.D0*sigma) - if(abs(x).lt.udef_tol) then - gauss=exp(-(x)) - else - gauss=0.D0 - end if - end function dgauss + end function gauss !!!##################################################### @@ -142,7 +99,7 @@ end function fact !!!##################################################### !!! Sum of logs of range from 1 to n !!!##################################################### - double precision function lnsum(n) + real(real32) function lnsum(n) implicit none integer :: i,n lnsum=0 @@ -159,11 +116,11 @@ end function lnsum !!! safe cos !!!##################################################### pure elemental function safe_acos(inval) result(val) - double precision, intent(in) :: inval - double precision :: val + real(real32), intent(in) :: inval + real(real32) :: val - if(abs(inval).ge.1.D0)then - val=acos(sign(1.D0,inval)) + if(abs(inval).ge.1._real32)then + val=acos(sign(1._real32,inval)) else val=acos(inval) end if @@ -326,52 +283,12 @@ end function cross_correl !!!##################################################### !!! smooths a function using a running average !!!##################################################### - function rrunning_avg(in_array,window,lperiodic) result(out_array) + function running_avg(in_array,window,lperiodic) result(out_array) implicit none integer :: i,lw,up,nstep integer, intent(in) :: window - real, dimension(:), intent(in) :: in_array - real, dimension(size(in_array,dim=1)) :: out_array - logical, optional :: lperiodic - - nstep=size(in_array) - if(mod(real(window),2.0).eq.0.0)then - lw = nint(real(window)/2.0)-1 - up = nint(real(window)/2.0) - else - lw = (floor(real(window)/2.0)) - up = (floor(real(window)/2.0)) - end if - - out_array=0.0 - if(present(lperiodic))then - if(lperiodic)then - do i=1,lw - out_array(i)=sum(in_array(nstep-lw+i:nstep))+& - sum(in_array(1:i+up)) - end do - do i=lw+1,nstep-up - out_array(i)=sum(in_array(i-lw:i+up)) - end do - do i=nstep-up+1,nstep - out_array(i)=sum(in_array(i-lw:nstep))+& - sum(in_array(1:up-(nstep-i))) - end do - out_array=out_array/window - return - end if - end if - out_array=in_array - - end function rrunning_avg -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function drunning_avg(in_array,window,lperiodic) result(out_array) - implicit none - integer :: i,lw,up,nstep - integer, intent(in) :: window - double precision, dimension(:), intent(in) :: in_array - double precision, dimension(size(in_array,dim=1)) :: out_array + real(real32), dimension(:), intent(in) :: in_array + real(real32), dimension(size(in_array,dim=1)) :: out_array logical, optional :: lperiodic nstep=size(in_array) @@ -403,7 +320,7 @@ function drunning_avg(in_array,window,lperiodic) result(out_array) end if out_array=in_array - end function drunning_avg + end function running_avg !!!##################################################### @@ -478,60 +395,34 @@ end function mode !!!##################################################### !!! returns the range of a set of points !!!##################################################### - function rrange(in_array) result(range) - implicit none - real :: range - real, dimension(:), intent(in) :: in_array - - range=maxval(in_array)-minval(in_array) - - end function rrange -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function drange(in_array) result(range) + function range(in_array) result(output) implicit none - double precision :: range - double precision, dimension(:), intent(in) :: in_array + real(real32) :: output + real(real32), dimension(:), intent(in) :: in_array - range=maxval(in_array)-minval(in_array) + output=maxval(in_array)-minval(in_array) - end function drange + end function range !!!##################################################### !!!##################################################### !!! returns an array normalised to one !!!##################################################### - function rnormalise(in_array) result(normal) - implicit none - real :: sumval - real, dimension(:), intent(in) :: in_array - real, dimension(size(in_array)) :: normal - - sumval=sum(in_array) - if(sumval.lt.1.D-8)then - normal=in_array - else - normal=in_array/sum(in_array) - end if - - end function rnormalise -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function dnormalise(in_array) result(normal) + function normalise(in_array) result(output) implicit none - double precision :: sumval - double precision, dimension(:), intent(in) :: in_array - double precision, dimension(size(in_array)) :: normal + real(real32) :: sumval + real(real32), dimension(:), intent(in) :: in_array + real(real32), dimension(size(in_array)) :: output sumval=sum(in_array) if(sumval.lt.1.D-8)then - normal=in_array + output=in_array else - normal=in_array/sum(in_array) + output=in_array/sum(in_array) end if - end function dnormalise + end function normalise !!!##################################################### @@ -544,8 +435,8 @@ end function dnormalise function get_turn_points(invec,lperiodic,window) result(resvec) implicit none integer :: i,j,nturn,itmp1,itmp2 - double precision :: l_grad,r_grad - double precision, dimension(:), intent(in) :: invec + real(real32) :: l_grad,r_grad + real(real32), dimension(:), intent(in) :: invec integer, allocatable, dimension(:) :: tvec1,resvec integer, optional :: window logical, optional :: lperiodic @@ -554,13 +445,13 @@ function get_turn_points(invec,lperiodic,window) result(resvec) nturn=0 if(allocated(resvec)) deallocate(resvec) allocate(tvec1(size(invec))) - l_grad=0.D0 + l_grad=0._real32 r_grad=invec(2)-invec(1) if(present(lperiodic))then if(lperiodic)then l_grad=invec(1)-invec(size(invec)) - if(sign(1.D0,l_grad).ne.sign(1.D0,r_grad).or.& - (r_grad.eq.0.D0.and.l_grad.ne.r_grad))then + if(sign(1._real32,l_grad).ne.sign(1._real32,r_grad).or.& + (r_grad.eq.0._real32.and.l_grad.ne.r_grad))then nturn=nturn+1 tvec1(nturn)=1 end if @@ -571,8 +462,8 @@ function get_turn_points(invec,lperiodic,window) result(resvec) do i=2,size(invec)-1 l_grad=r_grad r_grad=invec(i+1)-invec(i) - if(sign(1.D0,l_grad).ne.sign(1.D0,r_grad).or.& - (r_grad.eq.0.D0.and.abs(l_grad-r_grad).gt.1.D-5))then + if(sign(1._real32,l_grad).ne.sign(1._real32,r_grad).or.& + (r_grad.eq.0._real32.and.abs(l_grad-r_grad).gt.1.D-5))then nturn=nturn+1 tvec1(nturn)=i end if @@ -582,8 +473,8 @@ function get_turn_points(invec,lperiodic,window) result(resvec) if(present(lperiodic))then if(lperiodic)then r_grad=invec(1)-invec(size(invec)) - if(sign(1.D0,l_grad).ne.sign(1.D0,r_grad).or.& - (r_grad.eq.0.D0.and.l_grad.ne.r_grad))then + if(sign(1._real32,l_grad).ne.sign(1._real32,r_grad).or.& + (r_grad.eq.0._real32.and.l_grad.ne.r_grad))then nturn=nturn+1 tvec1(nturn)=size(invec) end if @@ -626,11 +517,11 @@ end function get_turn_points function get_nth_plane(invec,nth,window,is_periodic) result(startend) implicit none integer :: i,nstep,nplane,udef_window - double precision :: tol + real(real32) :: tol logical :: is_in_plane integer, dimension(2) :: startend integer, allocatable, dimension(:,:) :: plane_loc - double precision, dimension(:), intent(in) :: invec + real(real32), dimension(:), intent(in) :: invec integer, intent(in) :: nth integer, optional, intent(in) :: window logical, optional, intent(in) :: is_periodic @@ -639,7 +530,7 @@ function get_nth_plane(invec,nth,window,is_periodic) result(startend) !!!----------------------------------------------------------------------------- !!! Defines tolerance of plane height variation and initialises variables !!!----------------------------------------------------------------------------- - tol = 0.01D0*(maxval(invec)-minval(invec)) + tol = 0.01_real32*(maxval(invec)-minval(invec)) if(present(window))then udef_window=window else @@ -744,16 +635,16 @@ end function get_nth_plane !!!##################################################### !!! Ned's custom table function !!!##################################################### -!!! BREAKS ON a = 1.D0 +!!! BREAKS ON a = 1._real32 !!! ABOVE THIS, res WILL ALWAYS EQUAL 1 !!! a should be between -1 and 1? function table_func(x,a) result(res) implicit none - double precision, intent(in) :: x,a - double precision :: res + real(real32), intent(in) :: x,a + real(real32) :: res - res=( ( cos(x) + a ) + abs( cos(x) - a ) - 2.D0 )/& - ( 2.D0*a - 2.D0 ) + res=( ( cos(x) + a ) + abs( cos(x) - a ) - 2._real32 )/& + ( 2._real32*a - 2._real32 ) end function table_func @@ -763,41 +654,41 @@ end function table_func !!!##################################################### !!! apply gaussians to a set of points in an array !!!##################################################### - function rgauss_array(distance,in_array,sigma,tol,norm,mask) & + function gauss_array(distance,in_array,sigma,tol,norm,mask) & result(gauss_func) implicit none integer :: i,n,init_step - real :: x,sigma,udef_tol,mult - real, optional :: tol + real(real32) :: x,sigma,udef_tol,mult + real(real32), optional :: tol logical, optional :: norm - real, dimension(:), intent(in) :: in_array,distance - real, dimension(size(distance)) :: gauss_func - real :: pi = 4.0*atan(1.0) + real(real32), dimension(:), intent(in) :: in_array,distance + real(real32), dimension(size(distance)) :: gauss_func + real(real32) :: pi = 4._real32*atan(1._real32) logical, dimension(size(distance)), optional, intent(in) :: mask - udef_tol=16.0 + udef_tol=38._real32 if(present(tol)) udef_tol=tol - mult=(1.0/(sqrt(pi*2.0)*sigma)) + mult=(1._real32/(sqrt(pi*2._real32)*sigma)) if(present(norm))then - if(.not.norm) mult=1.0 + if(.not.norm) mult=1._real32 end if - gauss_func=0.0 + gauss_func=0._real32 do n=1,size(in_array) if(present(mask))then if(.not.mask(n)) cycle end if init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) forward: do i=init_step,size(distance),1 - x=0.5*(( distance(i) - in_array(n) )/sigma)**2.0 + x=0.5_real32*(( distance(i) - in_array(n) )/sigma)**2._real32 if(x.gt.udef_tol) exit forward gauss_func(i) = gauss_func(i) + exp(-x) * mult end do forward backward: do i=init_step-1,1,-1 - x=0.5*(( distance(i) - in_array(n) )/sigma)**2.0 + x=0.5_real32*(( distance(i) - in_array(n) )/sigma)**2._real32 if(x.gt.udef_tol) exit backward gauss_func(i) = gauss_func(i) + exp(-x) * mult end do backward @@ -805,197 +696,75 @@ function rgauss_array(distance,in_array,sigma,tol,norm,mask) & - end function rgauss_array -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function dgauss_array(distance,in_array,sigma,tol,norm,mask) & - result(gauss_func) - implicit none - integer :: i,n,init_step - double precision :: x,sigma,udef_tol,mult - double precision, optional :: tol - logical, optional :: norm - double precision, dimension(:), intent(in) :: in_array,distance - double precision, dimension(size(distance)) :: gauss_func - double precision :: pi = 4.D0*atan(1.D0) - - logical, dimension(size(distance)), optional, intent(in) :: mask - - - udef_tol=38.D0 - if(present(tol)) udef_tol=tol - mult=(1.D0/(sqrt(pi*2.D0)*sigma)) - if(present(norm))then - if(.not.norm) mult=1.D0 - end if - - gauss_func=0.D0 - do n=1,size(in_array) - if(present(mask))then - if(.not.mask(n)) cycle - end if - init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) - forward: do i=init_step,size(distance),1 - x=0.5D0*(( distance(i) - in_array(n) )/sigma)**2.D0 - if(x.gt.udef_tol) exit forward - gauss_func(i) = gauss_func(i) + exp(-x) * mult - end do forward - - backward: do i=init_step-1,1,-1 - x=0.5D0*(( distance(i) - in_array(n) )/sigma)**2.D0 - if(x.gt.udef_tol) exit backward - gauss_func(i) = gauss_func(i) + exp(-x) * mult - end do backward - end do - - - - end function dgauss_array + end function gauss_array !!!##################################################### !!!##################################################### !!! apply cauchy distribution to a set of points in an array !!!##################################################### - function rcauchy_array(distance,in_array,gamma,tol,norm) result(c_func) - implicit none - integer :: i,n,init_step - real :: x,gamma,udef_tol,mult - real, optional :: tol - logical, optional :: norm - real, dimension(:), intent(in) :: in_array,distance - real, dimension(size(distance)) :: c_func - real :: pi = 4.0*atan(1.0) - - - udef_tol=1.E16 - if(present(tol)) udef_tol=tol - mult=(1.0/(pi*gamma)) - if(present(norm))then - if(.not.norm) mult=1.0 - end if - - c_func=0.0 - do n=1,size(in_array) - init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) - forward: do i=init_step,size(distance),1 - x = 1.0 + (( distance(i) - in_array(n) )/gamma)**2.0 - if(x.gt.udef_tol) exit forward - c_func(i) = c_func(i) + 1.0/(x) * mult - end do forward - - backward: do i=init_step-1,1,-1 - x = 1.0 + (( distance(i) - in_array(n) )/gamma)**2.0 - if(x.gt.udef_tol) exit backward - c_func(i) = c_func(i) + 1.0/x * mult - end do backward - end do - - - - end function rcauchy_array -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function dcauchy_array(distance,in_array,gamma,tol,norm) result(c_func) + function cauchy_array(distance,in_array,gamma,tol,norm) result(c_func) implicit none integer :: i,n,init_step - double precision :: x,gamma,udef_tol,mult - double precision, optional :: tol + real(real32) :: x,gamma,udef_tol,mult + real(real32), optional :: tol logical, optional :: norm - double precision, dimension(:), intent(in) :: in_array,distance - double precision, dimension(size(distance)) :: c_func - double precision :: pi = 4.D0*atan(1.D0) + real(real32), dimension(:), intent(in) :: in_array,distance + real(real32), dimension(size(distance)) :: c_func + real(real32) :: pi = 4._real32*atan(1._real32) udef_tol=1.D16 if(present(tol)) udef_tol=tol - mult=(1.D0/(pi*gamma)) + mult=(1._real32/(pi*gamma)) if(present(norm))then - if(.not.norm) mult=1.D0 + if(.not.norm) mult=1._real32 end if - c_func=0.D0 + c_func=0._real32 do n=1,size(in_array) init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) forward: do i=init_step,size(distance),1 - x = 1.D0 + (( distance(i) - in_array(n) )/gamma)**2.D0 + x = 1._real32 + (( distance(i) - in_array(n) )/gamma)**2._real32 if(x.gt.udef_tol) exit forward - c_func(i) = c_func(i) + 1.D0/(x) * mult + c_func(i) = c_func(i) + 1._real32/(x) * mult end do forward backward: do i=init_step-1,1,-1 - x = 1.D0 + (( distance(i) - in_array(n) )/gamma)**2.D0 + x = 1._real32 + (( distance(i) - in_array(n) )/gamma)**2._real32 if(x.gt.udef_tol) exit backward - c_func(i) = c_func(i) + 1.D0/x * mult + c_func(i) = c_func(i) + 1._real32/x * mult end do backward end do - end function dcauchy_array + end function cauchy_array !!!##################################################### !!!##################################################### !!! apply slater distribution to a set of points in an array !!!##################################################### - function rslater_array(distance,in_array,zeta,tol,norm) result(s_func) - implicit none - integer :: i,n,init_step - real :: x,zeta,udef_tol,mult - real, optional :: tol - logical, optional :: norm - real, dimension(:), intent(in) :: in_array,distance - real, dimension(size(distance)) :: s_func - real :: pi = 4.0*atan(1.0) - - - udef_tol=38.0 - if(present(tol)) udef_tol=tol - mult=((zeta**3.0)/pi)**(0.5) - if(present(norm))then - if(.not.norm) mult=1.0 - end if - - s_func=0.0 - do n=1,size(in_array) - init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) - forward: do i=init_step,size(distance),1 - x = zeta*abs( distance(i) - in_array(n) ) - if(x.gt.udef_tol) exit forward - s_func(i) = s_func(i) + exp(-x) * mult - end do forward - - backward: do i=init_step-1,1,-1 - x = zeta*abs( distance(i) - in_array(n) ) - if(x.gt.udef_tol) exit backward - s_func(i) = s_func(i) + exp(-x) * mult - end do backward - end do - - - end function rslater_array -!!!----------------------------------------------------- -!!!----------------------------------------------------- - function dslater_array(distance,in_array,zeta,tol,norm) result(s_func) + function slater_array(distance,in_array,zeta,tol,norm) result(s_func) implicit none integer :: i,n,init_step - double precision :: x,zeta,udef_tol,mult - double precision, optional :: tol + real(real32) :: x,zeta,udef_tol,mult + real(real32), optional :: tol logical, optional :: norm - double precision, dimension(:), intent(in) :: in_array,distance - double precision, dimension(size(distance)) :: s_func - double precision :: pi = 4.D0*atan(1.D0) + real(real32), dimension(:), intent(in) :: in_array,distance + real(real32), dimension(size(distance)) :: s_func + real(real32) :: pi = 4._real32*atan(1._real32) - udef_tol=38.D0 + udef_tol=38._real32 if(present(tol)) udef_tol=tol - mult=((zeta**3.D0)/pi)**(0.5D0) + mult=((zeta**3._real32)/pi)**(0.5_real32) if(present(norm))then - if(.not.norm) mult=1.D0 + if(.not.norm) mult=1._real32 end if - s_func=0.D0 + s_func=0._real32 do n=1,size(in_array) init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) forward: do i=init_step,size(distance),1 @@ -1012,7 +781,7 @@ function dslater_array(distance,in_array,zeta,tol,norm) result(s_func) end do - end function dslater_array + end function slater_array !!!##################################################### end module misc_maths diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 new file mode 100644 index 0000000..fab5f04 --- /dev/null +++ b/src/fortran/lib/mod_misc_types.f90 @@ -0,0 +1,33 @@ +module artemis__misc_types + !! Module containing custom derived types for ARTEMIS + use artemis__constants, only: real32 + implicit none + + + private + + public :: latmatch_type + public :: tol_type + + + type latmatch_type + integer :: nfit + logical :: lreduced + character(1) :: abc(3)=(/'a','b','c'/) + + integer, dimension(2) :: axes + integer, allocatable, dimension(:,:,:) :: tf1,tf2 + real(real32), allocatable, dimension(:,:) :: tol + real(real32), dimension(3,3) :: lat1,lat2 + end type latmatch_type + + type tol_type + integer :: maxsize,maxfit,nstore + real(real32) :: maxlen=20._real32 + real(real32) :: maxarea=400._real32 + real(real32) :: vec,ang,area + real(real32) :: ang_weight = 10._real32 + real(real32) :: area_weight = 100._real32 + end type tol_type + +end module artemis__misc_types \ No newline at end of file diff --git a/src/fortran/lib/mod_rw_geom.f90 b/src/fortran/lib/mod_rw_geom.f90 index a2bd871..cb9ee04 100644 --- a/src/fortran/lib/mod_rw_geom.f90 +++ b/src/fortran/lib/mod_rw_geom.f90 @@ -10,963 +10,2156 @@ !!! -CASTEP !!! -xyz (read only) !!!############################################################################# -module rw_geom - use misc, only: to_upper,jump,Icount - use misc_linalg, only: LUinv,modu +module artemis__geom_rw + use artemis__constants, only: real32, pi + use artemis__misc, only: to_upper, to_lower, jump, icount, strip_null + use artemis__io_utils, only: print_warning, stop_program + use misc_linalg, only: modu, inverse_3x3 implicit none private - integer :: igeom_input=1,igeom_output=1 - double precision, dimension(3,3) :: lattice - - type spec_type - double precision, allocatable ,dimension(:,:) :: atom - double precision :: mass - character(len=5) :: name + public :: igeom_input, igeom_output + public :: basis_type, species_type + public :: geom_read, geom_write + public :: get_element_properties + + + integer :: igeom_input = 1 + !! geometry input file format + !! 1 = VASP + !! 2 = CASTEP + !! 3 = Quantum Espresso + !! 4 = CRYSTAL + !! 5 = XYZ + !! 6 = extended XYZ + integer :: igeom_output = 1 + !! geometry output file format + + type :: species_type + !! Derived type to store information about a species/element. + real(real32), allocatable ,dimension(:,:) :: atom + !! The atomic positions of the species. + real(real32) :: mass + !! The mass of the species. + real(real32) :: charge + !! The charge of the species. + real(real32) :: radius + !! The radius of the species. + character(len=3) :: name + !! The name of the species. integer :: num - end type spec_type - type bas_type - type(spec_type), allocatable, dimension(:) :: spec - integer :: nspec - integer :: natom - logical :: lcart=.false. - character(len=1024) :: sysname - end type bas_type - type(bas_type) :: basis - - - public :: igeom_input,igeom_output - public :: bas_type - public :: clone_bas - public :: convert_bas - public :: geom_read,geom_write - + !! The number of atoms of this species. + end type species_type + type :: basis_type + !! Derived type to store information about a basis. + type(species_type), allocatable, dimension(:) :: spec + !! Information about each species in the basis. + integer :: nspec = 0 + !! The number of species in the basis. + integer :: natom = 0 + !! The number of atoms in the basis. + real(real32) :: energy = 0._real32 + !! The energy of the basis. + real(real32) :: lat(3,3) = 0._real32 + !! The lattice vectors of the basis. + logical :: lcart = .false. + !! Boolean whether the basis is in cartesian coordinates. + logical, dimension(3) :: pbc = .true. + !! Boolean whether the basis has periodic boundary conditions. + character(len=128) :: sysname = "default" + !! The name of the system. + contains + procedure, pass(this) :: allocate_species + !! Procedure to allocate the species in the basis. + procedure, pass(this) :: convert + !! Procedure to convert the basis to cartesian coordinates. + procedure, pass(this) :: change_lattice + !! Procedure to change the lattice of the basis. + procedure, pass(this) :: normalise + !! Procedure to normalise the basis. + procedure, pass(this) :: copy + !! Procedure to copy the basis. + procedure, pass(this) :: get_lattice_constants + !! Procedure to get the lattice constants of the basis. + procedure, pass(this) :: remove_atom + !! Procedure to remove an atom from the basis. + procedure, pass(this) :: remove_atoms + !! Procedure to remove atoms from the basis. + end type basis_type + + + interface basis_type + module function init_basis_type(basis) result(output) + !! Initialise the basis type. + type(basis_type), intent(in), optional :: basis + !! Optional. Basis to copy. + type(basis_type) :: output + !! The basis to initialise. + end function init_basis_type + end interface basis_type -!!!updated 2020/02/06 contains -!!!############################################################################# -!!! sets up the name of output files and subroutines to read files -!!!############################################################################# - subroutine geom_read(UNIT,lat,bas,length) + +!############################################################################### + module function init_basis_type(basis) result(output) + !! Initialise the basis type. implicit none - integer :: UNIT,dim,i - type(bas_type) :: bas - double precision, dimension(3,3) :: lat + + ! Arguments + type(basis_type), intent(in), optional :: basis + !! Optional. Basis to copy. + type(basis_type) :: output + !! The basis to initialise. + + if(present(basis)) call output%copy(basis) + + end function init_basis_type +!############################################################################### + + +!############################################################################### + subroutine allocate_species( & + this, num_species, & + species_symbols, species_count, atoms ) + !! Allocate the species in the basis. + implicit none + + ! Arguments + class(basis_type), intent(inout) :: this + !! Parent. The basis to allocate the species in. + integer, intent(in), optional :: num_species + !! Optional. The number of species in the basis. + character(3), dimension(:), intent(in), optional :: species_symbols + !! Optional. The symbols of the species. + integer, dimension(:), intent(in), optional :: species_count + !! Optional. The number of atoms of each species. + real(real32), dimension(:,:), intent(in), optional :: atoms + !! Optional. The atomic positions of the species. + + ! Local variables + integer :: i, istart, iend + !! Loop index. + + if(present(num_species)) this%nspec = num_species + + if(allocated(this%spec)) deallocate(this%spec) + allocate(this%spec(this%nspec)) + + species_check: if(present(species_symbols))then + if(size(species_symbols).ne.this%nspec) exit species_check + this%spec(:)%name = species_symbols + end if species_check + + natom_check: if(present(species_count))then + if(size(species_count).ne.this%nspec) exit natom_check + this%spec(:)%num = species_count + istart = 1 + do i = 1, this%nspec + iend = istart + this%spec(i)%num - 1 + allocate(this%spec(i)%atom(this%spec(i)%num,3)) + if(present(atoms))then + this%spec(i)%atom = atoms(istart:iend,:3) + end if + istart = iend + 1 + end do + end if natom_check + + do i = 1, this%nspec + call get_element_properties( & + this%spec(i)%name, & + mass = this%spec(i)%mass, & + charge = this%spec(i)%charge, & + radius = this%spec(i)%radius ) + end do + + end subroutine allocate_species +!############################################################################### + + +!############################################################################### + subroutine geom_read(UNIT, basis, length, iostat) + !! Read geometry from a file. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to read from. + type(basis_type), intent(out) :: basis + !! The basis to read the geometry into. integer, optional, intent(in) :: length + !! Optional. The dimension of the basis atom positions. + integer, optional, intent(out) :: iostat + !! Optional. The I/O status of the read. + + ! Local variables + integer :: i + !! Loop index. + integer :: length_ + !! The dimension of the basis atom positions. + integer :: iostat_ + !! The I/O status of the read. + - lattice=0.D0 - dim=3 - if(present(length)) dim=length + length_ = 3 + iostat_ = 0 + if(present(length)) length_=length select case(igeom_input) case(1) - call VASP_geom_read(UNIT,dim) + call VASP_geom_read(UNIT, basis, length_, iostat_) case(2) - call CASTEP_geom_read(UNIT,dim) + call CASTEP_geom_read(UNIT, basis, length_) case(3) - call QE_geom_read(UNIT,dim) + call QE_geom_read(UNIT, basis, length_) case(4) - !call err_abort('ERROR: ARTEMIS not yet set up for CRYSTAL') - write(0,'("ERROR: ARTEMIS not yet set up for CRYSTAL")') - stop + call stop_program("Not yet set up for CRYSTAL") + return case(5) - call XYZ_geom_read(UNIT,dim) - write(0,'("WARNING: XYZ file format does not contain lattice data")') + call XYZ_geom_read(UNIT, basis, length_, iostat_) + call print_warning("XYZ file format does not contain lattice data") + case(6) + call extXYZ_geom_read(UNIT, basis, length_, iostat_) end select - call clone_bas(basis,bas,lattice,lat) - deallocate(basis%spec) - if(dim.eq.4)then - do i=1,bas%nspec - bas%spec(i)%atom(:,4)=1.D0 + if(iostat_.ne.0) then + if(present(iostat)) iostat = iostat_ + return + else + if(present(iostat)) iostat = 0 + end if + if(length_.eq.4)then + do i = 1, basis%nspec + basis%spec(i)%atom(:,4)=1._real32 end do end if - + do i = 1, basis%nspec + call get_element_properties( & + basis%spec(i)%name, & + mass = basis%spec(i)%mass, & + charge = basis%spec(i)%charge, & + radius = basis%spec(i)%radius ) + end do end subroutine geom_read -!!!############################################################################# +!############################################################################### -!!!############################################################################# -!!! sets up the name of output files and subroutines to read files -!!!############################################################################# - subroutine geom_write(UNIT,lat,bas) +!############################################################################### + subroutine geom_write(UNIT, basis) + !! Write geometry to a file. implicit none - integer :: UNIT - type(bas_type) :: bas - double precision, dimension(3,3) :: lat -!!! MAKE IT CHANGE HERE IF USER SPECIFIES LCART OR NOT -!!! AND GIVE IT THE CASTEP AND QE OPTION OF LABC !!! + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to write to. + class(basis_type), intent(in) :: basis + !! The basis to write the geometry from. + + ! MAKE IT CHANGE HERE IF USER SPECIFIES LCART OR NOT + ! AND GIVE IT THE CASTEP AND QE OPTION OF LABC ! select case(igeom_output) case(1) - call VASP_geom_write(UNIT,lat,bas) + call VASP_geom_write(UNIT,basis) case(2) - call CASTEP_geom_write(UNIT,lat,bas) + call CASTEP_geom_write(UNIT,basis) case(3) - call QE_geom_write(UNIT,lat,bas) + call QE_geom_write(UNIT,basis) case(4) - write(0,'("ERROR: ARTEMIS not yet set up for CRYSTAL")') - stop - case(5) - write(0,'("ERROR: XYZ format doesn''t need lattice")') - call XYZ_geom_write(UNIT,bas) + call stop_program("ERROR: Not yet set up for CRYSTAL") + return + case(5) + call XYZ_geom_write(UNIT,basis) + case(6) + call extXYZ_geom_write(UNIT,basis) end select - end subroutine geom_write -!!!############################################################################# +!############################################################################### -!!!############################################################################# -!!! read the POSCAR or CONTCAR file -!!!############################################################################# - subroutine VASP_geom_read(UNIT,length) - implicit none - integer :: UNIT,pos,count,Reason - double precision :: scal - character(len=100) :: lspec - character(len=1024) :: buffer - double precision, dimension(3,3) :: reclat - integer, intent(in), optional :: length - integer :: i,j,k,dim - - -!!!----------------------------------------------------------------------------- -!!! determines dimension of basis (include translation dimension for symmetry?) -!!!----------------------------------------------------------------------------- - if(present(length))then - dim = length - else - dim = 3 - end if - -!!!----------------------------------------------------------------------------- -!!! read system name -!!!----------------------------------------------------------------------------- - read(UNIT,'(A)',iostat=Reason) basis%sysname - if(Reason.ne.0)then - write(0,'(" The file is not in POSCAR format.")') - write(0,'(" Exiting code ...")') - call exit() - end if - read(UNIT,*) scal - - -!!!----------------------------------------------------------------------------- -!!! read lattice -!!!----------------------------------------------------------------------------- - do i=1,3 - read(UNIT,*) (lattice(i,j),j=1,3) - end do - lattice=scal*lattice - +!############################################################################### + subroutine VASP_geom_read(UNIT, basis, length, iostat) + !! Read the structure in vasp poscar style format. + implicit none -!!!----------------------------------------------------------------------------- -!!! read species names and number of each atomic species -!!!----------------------------------------------------------------------------- - read(UNIT,'(A)') lspec - basis%nspec=Icount(lspec) - allocate(basis%spec(basis%nspec)) - if(verify(lspec,' 0123456789').ne.0) then - count=0;pos=1 - speccount: do - i=verify(lspec(pos:), ' ') - if (i.eq.0) exit speccount - count=count+1 - pos=i+pos-1 - i=scan(lspec(pos:), ' ') - if (i.eq.0) exit speccount - basis%spec(count)%name=lspec(pos:pos+i-1) - pos=i+pos-1 - end do speccount - - read(UNIT,*) (basis%spec(j)%num,j=1,basis%nspec) - else !only numbers - do count=1,basis%nspec - write(basis%spec(count)%name,'(I0)') count - end do - read(lspec,*) (basis%spec(j)%num,j=1,basis%nspec) - end if - - -!!!----------------------------------------------------------------------------- -!!! determines whether input basis is in direct or cartesian coordinates -!!!----------------------------------------------------------------------------- - basis%lcart=.false. - read(UNIT,'(A)') buffer - if(verify(trim(buffer),'Direct').eq.0) basis%lcart=.false. - if(verify(trim(buffer),'Cartesian').eq.0) then - write(0,*) "NOT SURE IF CARTESIAN COORDINATES ARE SUPPORTED YET!" - write(0,*) "PLEASE CHECK COORDINATES" - basis%lcart=.true. - end if - - -!!!----------------------------------------------------------------------------- -!!! read basis -!!!----------------------------------------------------------------------------- - do i=1,basis%nspec - allocate(basis%spec(i)%atom(basis%spec(i)%num,dim)) - basis%spec(i)%atom(:,:)=0.D0 - do j=1,basis%spec(i)%num - read(UNIT,*) (basis%spec(i)%atom(j,k),k=1,3) - end do - end do + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to read from. + type(basis_type), intent(out) :: basis + !! The basis to read the geometry into. + integer, intent(in), optional :: length + !! Optional. The dimension of the basis atom positions. + integer, intent(out), optional :: iostat + !! Optional. The I/O status of the read. + + integer :: Reason + !! The I/O status of the read. + integer :: pos, count + !! Temporary integer variables. + real(real32) :: scal + !! The scaling factor of the lattice. + character(len=100) :: lspec + !! The species names and number of each atomic species. + character(len=1024) :: buffer + !! Temporary character variable. + integer :: i, j, k + !! Loop index. + integer :: length_ + !! The dimension of the basis atom positions. + integer :: iostat_ + !! The I/O status of the read. + + + length_ = 3 + iostat_ = 0 + !--------------------------------------------------------------------------- + ! determine dimension of basis (include translation dimension for symmetry?) + !--------------------------------------------------------------------------- + if(present(length)) length_ = length + + + !--------------------------------------------------------------------------- + ! read system name + !--------------------------------------------------------------------------- + read(UNIT,'(A)',iostat=Reason) basis%sysname + if(Reason.ne.0)then + write(0,'("ERROR: The file is not in POSCAR format.")') + write(0,*) "Expected system name, got: ",trim(basis%sysname) + iostat_ = 1 + if(present(iostat)) iostat = iostat_ + return + end if + read(UNIT,*) scal + + + !--------------------------------------------------------------------------- + ! read lattice + !--------------------------------------------------------------------------- + do i = 1, 3 + read(UNIT,*) (basis%lat(i,j),j=1,3) + end do + basis%lat=scal*basis%lat + + + !--------------------------------------------------------------------------- + ! read species names and number of each atomic species + !--------------------------------------------------------------------------- + read(UNIT,'(A)') lspec + basis%nspec = icount(lspec) + allocate(basis%spec(basis%nspec)) + if(verify(lspec,' 0123456789').ne.0) then + count=0;pos=1 + speccount: do + i=verify(lspec(pos:), ' ') + if (i.eq.0) exit speccount + count=count+1 + pos=i+pos-1 + i=scan(lspec(pos:), ' ') + if (i.eq.0) exit speccount + basis%spec(count)%name=lspec(pos:pos+i-1) + pos=i+pos-1 + end do speccount + + read(UNIT,*) (basis%spec(j)%num,j=1,basis%nspec) + else !only numbers + do count = 1, basis%nspec + write(basis%spec(count)%name,'(I0)') count + end do + read(lspec,*) (basis%spec(j)%num,j=1,basis%nspec) + end if -!!!----------------------------------------------------------------------------- -!!! convert basis if in cartesian coordinates -!!!----------------------------------------------------------------------------- - if(basis%lcart)then - reclat=transpose(LUinv(lattice)) - basis=convert_bas(basis,reclat) - end if - - -!!!----------------------------------------------------------------------------- -!!! normalise basis to between 0 and 1 in direct coordinates -!!!----------------------------------------------------------------------------- - do i=1,basis%nspec - do j=1,basis%spec(i)%num - do k=1,3 - basis%spec(i)%atom(j,k)=& - basis%spec(i)%atom(j,k)-floor(basis%spec(i)%atom(j,k)) - end do - end do - end do - basis%natom=sum(basis%spec(:)%num) + !--------------------------------------------------------------------------- + ! determines whether input basis is in direct or cartesian coordinates + !--------------------------------------------------------------------------- + basis%lcart=.false. + read(UNIT,'(A)') buffer + buffer = to_lower(buffer) + if(verify(trim(buffer),'direct').eq.0) basis%lcart=.false. + if(verify(trim(buffer),'cartesian').eq.0) basis%lcart=.true. + + + !--------------------------------------------------------------------------- + ! read basis + !--------------------------------------------------------------------------- + do i = 1, basis%nspec + allocate(basis%spec(i)%atom(basis%spec(i)%num,length_)) + 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 + end do - end subroutine VASP_geom_read -!!!############################################################################# + !--------------------------------------------------------------------------- + ! convert basis if in cartesian coordinates + !--------------------------------------------------------------------------- + if(basis%lcart) call basis%convert() -!!!############################################################################# -!!! writes out the structure in vasp poscar style format -!!!############################################################################# - subroutine VASP_geom_write(UNIT,lat_write,bas_write,lcart) - implicit none - integer :: i,j,UNIT - double precision, dimension(3,3) :: lat_write - type(bas_type) :: bas_write - character(100) :: fmt,string - logical, intent(in), optional :: lcart - - string="Direct" - if(present(lcart))then - if(lcart) string="Cartesian" - end if - - write(UNIT,'(A)') trim(adjustl(bas_write%sysname)) - write(UNIT,'(F15.9)') 1.D0 - do i=1,3 - write(UNIT,'(3(F15.9))') lat_write(i,:) - end do - write(fmt,'("(",I0,"(A,1X))")') bas_write%nspec - write(UNIT,trim(adjustl(fmt))) (adjustl(bas_write%spec(j)%name),j=1,bas_write%nspec) - write(fmt,'("(",I0,"(I0,5X))")') bas_write%nspec - write(UNIT,trim(adjustl(fmt))) (bas_write%spec(j)%num,j=1,bas_write%nspec) - write(UNIT,'(A)') trim(adjustl(string)) - do i=1,bas_write%nspec - do j=1,bas_write%spec(i)%num - write(UNIT,'(3(F15.9))') bas_write%spec(i)%atom(j,1:3) - end do - end do - + !--------------------------------------------------------------------------- + ! normalise basis to between 0 and 1 in direct coordinates + !--------------------------------------------------------------------------- + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + do k = 1, 3 + basis%spec(i)%atom(j,k)=& + basis%spec(i)%atom(j,k)-floor(basis%spec(i)%atom(j,k)) + end do + end do + end do + basis%natom=sum(basis%spec(:)%num) + + if(present(iostat)) iostat = iostat_ + + end subroutine VASP_geom_read +!############################################################################### + + +!############################################################################### + subroutine VASP_geom_write(UNIT, basis, cartesian) + !! Write the structure in vasp poscar style format. + implicit none - end subroutine VASP_geom_write -!!!############################################################################# + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to write to. + class(basis_type), intent(in) :: basis + !! The basis to write the geometry from. + logical, intent(in), optional :: cartesian + !! Optional. Whether to write the basis in cartesian coordinates. + + ! Local variables + integer :: i,j + !! Loop index. + character(100) :: fmt + !! Format string. + character(10) :: string + !! String to determine whether to write in direct or cartesian coordinates. + + + string="Direct" + if(present(cartesian))then + if(cartesian) string="Cartesian" + end if + write(UNIT,'(A)') trim(adjustl(basis%sysname)) + write(UNIT,'(F15.9)') 1._real32 + do i = 1, 3 + write(UNIT,'(3(F15.9))') basis%lat(i,:) + end do + write(fmt,'("(",I0,"(A,1X))")') basis%nspec + write(UNIT,trim(adjustl(fmt))) (adjustl(basis%spec(j)%name),j=1,basis%nspec) + write(fmt,'("(",I0,"(I0,5X))")') basis%nspec + write(UNIT,trim(adjustl(fmt))) (basis%spec(j)%num,j=1,basis%nspec) + write(UNIT,'(A)') trim(adjustl(string)) + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + write(UNIT,'(3(F15.9))') basis%spec(i)%atom(j,1:3) + end do + end do -!!!############################################################################# -!!! read the QE geom file -!!!############################################################################# - subroutine QE_geom_read(UNIT,length) - implicit none - integer UNIT,Reason,i,j,k,dim,iline - integer, dimension(1000) :: tmp_natom - integer, intent(in), optional :: length - double precision, dimension(3) :: tmpvec - double precision, dimension(3,3) :: reclat - character(len=5) :: ctmp - character(len=5), dimension(1000) :: tmp_spec - character(len=1024) :: buffer,buffer2 - - -!!!----------------------------------------------------------------------------- -!!! determines dimension of basis (include translation dimension for symmetry?) -!!!----------------------------------------------------------------------------- - if(present(length))then - dim = length - else - dim = 3 - end if - - basis%lcart=.false. - basis%sysname="Converted_from_geom_file" - - -!!!----------------------------------------------------------------------------- -!!! read lattice -!!!----------------------------------------------------------------------------- - rewind UNIT - cellparam: do - read(UNIT,'(A)',iostat=Reason) buffer - if(Reason.ne.0)then - write(0,'(" An issue with the QE input file format has been encountered.")') - write(0,'(" Exiting code ...")') - stop - end if - if(index(trim(buffer),"ibrav").ne.0)then - write(0,'("ERROR: Internal error in QE_geom_read")') - write(0,'(2X,"Subroutine not yet set up to read IBRAV lattices")') - stop - end if - if(verify("CELL_PARAMETERS",buffer).eq.0) then - exit cellparam - end if - end do cellparam - do i=1,3 - read(UNIT,*) (lattice(i,j),j=1,3) - end do + end subroutine VASP_geom_write +!############################################################################### -!!!----------------------------------------------------------------------------- -!!! determines whether input basis is in direct or cartesian coordinates -!!!----------------------------------------------------------------------------- - iline=0 - rewind UNIT - basfind: do - read(UNIT,'(A)',iostat=Reason) buffer - iline=iline+1 - if(verify("ATOMIC_POSITIONS",buffer).eq.0)then - backspace(UNIT) - read(UNIT,*) buffer,buffer2 - if(verify("crystal",buffer2).eq.0) basis%lcart=.false. - if(verify("angstrom",buffer2).eq.0) basis%lcart=.true. - exit basfind - end if - end do basfind - - -!!!----------------------------------------------------------------------------- -!!! read basis -!!!----------------------------------------------------------------------------- - basis%natom=0 - basis%nspec=0 - tmp_natom=1 - basread: do - read(UNIT,'(A)',iostat=Reason) buffer - read(buffer,*) ctmp - if(Reason.ne.0) exit - if(trim(ctmp).eq.'') exit - if(verify(buffer,' 0123456789').eq.0) exit - basis%natom=basis%natom+1 - if(.not.any(tmp_spec(1:basis%nspec).eq.ctmp))then - basis%nspec=basis%nspec+1 - tmp_spec(basis%nspec)=ctmp - else - where(tmp_spec(1:basis%nspec).eq.ctmp) - tmp_natom(1:basis%nspec)=tmp_natom(1:basis%nspec)+1 - end where - end if - end do basread - - allocate(basis%spec(basis%nspec)) - basis%spec(1:basis%nspec)%name=tmp_spec(1:basis%nspec) - do i=1,basis%nspec - basis%spec(i)%num=0 - allocate(basis%spec(i)%atom(tmp_natom(i),dim)) - end do +!############################################################################### + subroutine QE_geom_read(UNIT,basis,length) + !! Read the structure in Quantum Espresso style format. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to read from. + type(basis_type), intent(out) :: basis + !! The basis to read the geometry into. + integer, intent(in), optional :: length + !! Optional. The dimension of the basis atom positions. + + ! Local variables + integer :: Reason + !! The I/O status of the read. + integer :: i, j, k, iline + !! Loop index. + integer :: length_ = 3 + !! The dimension of the basis atom positions. + integer, dimension(1000) :: tmp_natom + !! Temporary array to store the number of atoms of each species. + real(real32), dimension(3) :: tmpvec + !! Temporary array to store the atomic positions. + character(len=3) :: ctmp + !! Temporary character variable. + character(256) :: stop_msg + !! Error message. + character(len=3), dimension(1000) :: tmp_spec + !! Temporary array to store the species names. + character(len=1024) :: buffer, buffer2 + !! Temporary character variables. + + + !--------------------------------------------------------------------------- + ! determine dimension of basis (include translation dimension for symmetry?) + !--------------------------------------------------------------------------- + if(present(length)) length_ = length + basis%lcart = .false. + basis%sysname = "Converted_from_geom_file" + + + !--------------------------------------------------------------------------- + ! read lattice + !--------------------------------------------------------------------------- + rewind UNIT + cellparam: do + read(UNIT,'(A)',iostat=Reason) buffer + if(Reason.ne.0)then + call stop_program( & + "An issue with the QE input file format has been encountered." & + ) + return + end if + if(index(trim(buffer),"ibrav").ne.0)then + write(stop_msg,*) & + "Internal error in QE_geom_read" // & + achar(13) // achar(10) // & + " Subroutine not yet set up to read IBRAV lattices" + call stop_program(stop_msg) + return + end if + if(verify("CELL_PARAMETERS",buffer).eq.0) then + exit cellparam + end if + end do cellparam + do i = 1, 3 + read(UNIT,*) (basis%lat(i,j),j=1,3) + end do + + + !--------------------------------------------------------------------------- + ! determines whether input basis is in direct or cartesian coordinates + !--------------------------------------------------------------------------- + iline=0 + rewind UNIT + basfind: do + read(UNIT,'(A)',iostat=Reason) buffer + iline=iline+1 + if(verify("ATOMIC_POSITIONS",buffer).eq.0)then + backspace(UNIT) + read(UNIT,*) buffer,buffer2 + if(verify("crystal",buffer2).eq.0) basis%lcart = .false. + if(verify("angstrom",buffer2).eq.0) basis%lcart = .true. + exit basfind + end if + end do basfind + + + !--------------------------------------------------------------------------- + ! read basis + !--------------------------------------------------------------------------- + basis%natom = 0 + basis%nspec = 0 + tmp_natom = 1 + basread: do + read(UNIT,'(A)',iostat=Reason) buffer + read(buffer,*) ctmp + if(Reason.ne.0) exit + if(trim(ctmp).eq.'') exit + if(verify(buffer,' 0123456789').eq.0) exit + basis%natom = basis%natom + 1 + if(.not.any(tmp_spec(1:basis%nspec).eq.ctmp))then + basis%nspec = basis%nspec + 1 + tmp_spec(basis%nspec) = ctmp + else + where(tmp_spec(1:basis%nspec).eq.ctmp) + tmp_natom(1:basis%nspec) = tmp_natom(1:basis%nspec) + 1 + end where + end if + end do basread + + allocate(basis%spec(basis%nspec)) + basis%spec(1:basis%nspec)%name = tmp_spec(1:basis%nspec) + do i = 1, basis%nspec + basis%spec(i)%num = 0 + allocate(basis%spec(i)%atom(tmp_natom(i),length_)) + end do + + call jump(UNIT,iline) + basread2: do i = 1, basis%natom + read(UNIT,*,iostat=Reason) ctmp,tmpvec(1:3) + do j = 1, basis%nspec + if(basis%spec(j)%name.eq.ctmp)then + basis%spec(j)%num = basis%spec(j)%num + 1 + basis%spec(j)%atom(basis%spec(j)%num,1:3) = tmpvec(1:3) + exit + end if + end do + end do basread2 + + + !--------------------------------------------------------------------------- + ! convert basis if in cartesian coordinates + !--------------------------------------------------------------------------- + if(basis%lcart) call basis%convert() + + + !--------------------------------------------------------------------------- + ! normalise basis to between 0 and 1 in direct coordinates + !--------------------------------------------------------------------------- + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + do k = 1, 3 + basis%spec(i)%atom(j,k) = & + basis%spec(i)%atom(j,k) - floor( basis%spec(i)%atom(j,k) ) + end do + end do + end do + basis%natom=sum(basis%spec(:)%num) + + end subroutine QE_geom_read +!############################################################################### + + +!############################################################################### + subroutine QE_geom_write(UNIT, basis, cartesian) + !! Write the structure in Quantum Espresso style format. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to write to. + class(basis_type), intent(in) :: basis + !! The basis to write the geometry from. + logical, intent(in), optional :: cartesian + !! Optional. Whether to write the basis in cartesian coordinates. + + ! Local variables + integer :: i,j + !! Loop index. + character(10) :: string + !! String to determine whether to write in crystal or angstrom coordinates. + + + string="crystal" + if(present(cartesian))then + if(cartesian) string="angstrom" + end if + + + write(UNIT,'("CELL_PARAMETERS angstrom")') + do i = 1, 3 + write(UNIT,'(3(F15.9))') basis%lat(i,:) + end do + write(UNIT,'("ATOMIC_SPECIES")') + do i = 1, basis%nspec + write(UNIT,'(A)') trim(adjustl(basis%spec(i)%name)) + end do + write(UNIT,'("ATOMIC_POSITIONS",1X,A)') trim(adjustl(string)) + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + write(UNIT,'(A5,1X,3(F15.9))') & + basis%spec(i)%name,basis%spec(i)%atom(j,1:3) + end do + end do + + end subroutine QE_geom_write +!############################################################################### + + +!############################################################################### + subroutine CASTEP_geom_read(UNIT, basis, length) + !! Read the structure in CASTEP style format. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to read from. + type(basis_type), intent(out) :: basis + !! The basis to read the geometry into. + integer, intent(in), optional :: length + !! Optional. The dimension of the basis atom positions. + + ! Local variables + integer :: Reason + !! The I/O status of the read. + integer :: i, j, k, iline + !! Loop index. + integer :: length_ = 3 + !! The dimension of the basis atom positions. + integer :: itmp1 + !! Temporary integer variable. + character(len=3) :: ctmp + !! Temporary character variable. + character(len=20) :: units + !! Units of the lattice vectors. + character(len=200) :: buffer, store + !! Temporary character variables. + logical :: labc + !! Logical variable to determine whether the lattice is in abc or + !! cartesian coordinates. + integer, dimension(1000) :: tmp_natom + !! Temporary array to store the number of atoms of each species. + 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. + - call jump(UNIT,iline) - basread2: do i=1,basis%natom - read(UNIT,*,iostat=Reason) ctmp,tmpvec(1:3) - do j=1,basis%nspec - if(basis%spec(j)%name.eq.ctmp)then - basis%spec(j)%num=basis%spec(j)%num+1 - basis%spec(j)%atom(basis%spec(j)%num,1:3)=tmpvec(1:3) - exit - end if - end do - end do basread2 - - -!!!----------------------------------------------------------------------------- -!!! convert basis if in cartesian coordinates -!!!----------------------------------------------------------------------------- - if(basis%lcart)then - reclat=transpose(LUinv(lattice)) - basis=convert_bas(basis,reclat) - end if - - -!!!----------------------------------------------------------------------------- -!!! normalise basis to between 0 and 1 in direct coordinates -!!!----------------------------------------------------------------------------- - do i=1,basis%nspec - do j=1,basis%spec(i)%num - do k=1,3 - basis%spec(i)%atom(j,k)=& - basis%spec(i)%atom(j,k)-floor(basis%spec(i)%atom(j,k)) - end do - end do - end do - basis%natom=sum(basis%spec(:)%num) + !--------------------------------------------------------------------------- + ! determine dimension of basis (include translation dimension for symmetry?) + !--------------------------------------------------------------------------- + if(present(length)) length_ = length + + + !--------------------------------------------------------------------------- + ! reading loop of file + !--------------------------------------------------------------------------- + tmp_spec = "" + tmp_natom = 0 + iline = 0 + labc = .true. + basis%sysname = "from CASTEP" + rewind(UNIT) + readloop: do + iline=iline+1 + read(UNIT,'(A)',iostat=Reason) buffer + if(Reason.ne.0) exit + buffer=to_upper(buffer) + if(scan(trim(adjustl(buffer)),'%').ne.1) cycle readloop + if(index(trim(adjustl(buffer)),'%END').eq.1) cycle readloop + read(buffer,*) store, buffer + if(trim(buffer).eq.'') cycle readloop + !------------------------------------------------------------------------ + ! read lattice + !------------------------------------------------------------------------ + lattice_if: if(index(trim(buffer),"LATTICE").eq.1)then + if(index(trim(buffer),"ABC").ne.0) labc = .true. + if(index(trim(buffer),"CART").ne.0) labc = .false. + store = "" + itmp1 = 0 + lattice_loop: do + itmp1 = itmp1 + 1 + read(UNIT,'(A)',iostat=Reason) buffer + if(Reason.ne.0) exit lattice_loop + if(scan(trim(adjustl(buffer)),'%').eq.1) exit lattice_loop + if(itmp1.eq.5)then + call stop_program( & + "Too many lines in LATTICE block of structure file" & + ) + return + end if + store=trim(store)//" "//trim(buffer) + end do lattice_loop + iline=iline+itmp1 + + if(labc)then + read(store,*) units,(abc(i),i=1,3), (angle(j),j=1,3) + basis%lat = convert_abc_to_lat(abc,angle,.false.) + else + read(store,*) units,(basis%lat(i,:),i=1,3) + end if + cycle readloop + end if lattice_if + + !------------------------------------------------------------------------ + ! read basis + !------------------------------------------------------------------------ + basis_if: if(index(trim(buffer),"POSITIONS").eq.1) then + if(index(trim(buffer),"ABS").ne.0) basis%lcart=.true. + if(index(trim(buffer),"FRAC").ne.0) basis%lcart=.false. + itmp1 = 0 + basis_loop1: do + read(UNIT,'(A)',iostat=Reason) buffer + if(Reason.ne.0) exit basis_loop1 + if(scan(trim(adjustl(buffer)),'%').eq.1) exit basis_loop1 + read(buffer,*) ctmp + if(trim(ctmp).eq.'') exit + if(verify(buffer,' 0123456789').eq.0) exit + basis%natom = basis%natom + 1 + if(.not.any(tmp_spec(1:basis%nspec).eq.ctmp))then + basis%nspec = basis%nspec+1 + tmp_natom(basis%nspec) = 1 + tmp_spec(basis%nspec) = ctmp + else + where(tmp_spec(1:basis%nspec).eq.ctmp) + tmp_natom(1:basis%nspec) = tmp_natom(1:basis%nspec) + 1 + end where + end if + end do basis_loop1 + + allocate(basis%spec(basis%nspec)) + basis%spec(1:basis%nspec)%name = tmp_spec(1:basis%nspec) + do i = 1, basis%nspec + basis%spec(i)%num = 0 + allocate(basis%spec(i)%atom(tmp_natom(i),length_)) + end do + + call jump(UNIT,iline) + basis_loop2: do i = 1, basis%natom + read(UNIT,'(A)',iostat=Reason) buffer + if(Reason.ne.0)then + call stop_program("Internal error in assigning the basis") + return + end if + read(buffer,*) ctmp,dvtmp1(1:3) + species_loop: do j = 1, basis%nspec + if(basis%spec(j)%name.eq.ctmp)then + basis%spec(j)%num = basis%spec(j)%num + 1 + basis%spec(j)%atom(basis%spec(j)%num,1:3) = dvtmp1(1:3) + exit species_loop + end if + end do species_loop + end do basis_loop2 + + end if basis_if + end do readloop + + + !--------------------------------------------------------------------------- + ! convert basis if in cartesian coordinates + !--------------------------------------------------------------------------- + if(basis%lcart) call basis%convert() + + + !--------------------------------------------------------------------------- + ! normalise basis to between 0 and 1 in direct coordinates + !--------------------------------------------------------------------------- + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + do k = 1, 3 + basis%spec(i)%atom(j,k) = & + basis%spec(i)%atom(j,k) - floor( basis%spec(i)%atom(j,k) ) + end do + end do + end do + basis%natom=sum(basis%spec(:)%num) + end subroutine CASTEP_geom_read +!############################################################################### - end subroutine QE_geom_read -!!!############################################################################# +!############################################################################### + subroutine CASTEP_geom_write(UNIT, basis, labc, cartesian) + !! Write the structure in CASTEP style format. + implicit none -!!!############################################################################# -!!! writes out the structure in QE geom style format -!!!############################################################################# - subroutine QE_geom_write(UNIT,lat_write,bas_write,lcart) - implicit none - integer :: i,j,UNIT - double precision, dimension(3,3) :: lat_write - type(bas_type) :: bas_write - character(10) :: string - logical, intent(in), optional :: lcart - - string="crystal" - if(present(lcart))then - if(lcart) string="angstrom" - end if - - - write(UNIT,'("CELL_PARAMETERS angstrom")') - do i=1,3 - write(UNIT,'(3(F15.9))') lat_write(i,:) - end do - write(UNIT,'("ATOMIC_SPECIES")') - do i=1,bas_write%nspec - write(UNIT,'(A)') trim(adjustl(bas_write%spec(i)%name)) - end do - write(UNIT,'("ATOMIC_POSITIONS",1X,A)') trim(adjustl(string)) - do i=1,bas_write%nspec - do j=1,bas_write%spec(i)%num - write(UNIT,'(A5,1X,3(F15.9))') bas_write%spec(i)%name,bas_write%spec(i)%atom(j,1:3) - end do - end do + ! Arguments + integer :: UNIT + !! The unit number of the file to write to. + class(basis_type), intent(in) :: basis + !! The basis to write the geometry from. + logical, intent(in), optional :: labc + !! Optional. Boolean whether to write the lattice in abc format. + logical, intent(in), optional :: cartesian + !! Optional. Boolean whether to write basis in cartesian coordinates. + + ! Local variables + integer :: i, j + !! Loop index. + 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 + character(len=256) :: stop_msg + !! Error message. + + + string_lat="CART" + if(present(labc))then + if(labc) string_lat="ABC" + end if + string_bas="FRAC" + if(present(cartesian))then + if(cartesian)then + string_bas="ABS" + write(stop_msg,*) & + "Internal error in CASTEP_geom_write" // & + achar(13) // achar(10) // & + " Subroutine not yet set up to output cartesian coordinates" + call stop_program(stop_msg) + return + end if + end if - end subroutine QE_geom_write -!!!############################################################################# + write(UNIT,'("%block LATTICE_",A)') trim(string_lat) + write(UNIT,'("ang")') + if(present(labc))then + if(labc)then + abc_angle = convert_lat_to_abc(basis%lat) + write(UNIT,'(3(F15.9))') abc_angle(1,:) + write(UNIT,'(3(F15.9))') abc_angle(2,:) + goto 10 + end if + end if + do i = 1, 3 + write(UNIT,'(3(F15.9))') basis%lat(i,:) + end do + +10 write(UNIT,'("%endblock LATTICE_",A)') trim(string_lat) + + write(UNIT,*) + write(UNIT,'("%block POSITIONS_",A)') trim(string_bas) + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + write(UNIT,'(A5,1X,3(F15.9))') & + basis%spec(i)%name,basis%spec(i)%atom(j,1:3) + end do + end do + write(UNIT,'("%endblock POSITIONS_",A)') trim(string_bas) + end subroutine CASTEP_geom_write +!############################################################################### -!!!############################################################################# -!!! reads atoms from an CASTEP file -!!!############################################################################# - subroutine CASTEP_geom_read(UNIT,length) - implicit none - integer :: UNIT,Reason,itmp1 - integer :: i,j,k,dim,iline - character(len=5) :: ctmp - character(len=20) :: units - character(len=200) :: buffer,store - logical :: labc - integer, dimension(1000) :: tmp_natom - double precision, dimension(3) :: abc,angle,dvtmp1 - double precision, dimension(3,3) :: reclat - character(len=5), dimension(1000) :: tmp_spec - integer, intent(in), optional :: length +!############################################################################### + subroutine XYZ_geom_read(UNIT, basis, length, iostat) + !! Read the structure in xyz style format. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to read from. + type(basis_type), intent(out) :: basis + !! The basis to read the geometry into. + integer, intent(in), optional :: length + !! Optional. The dimension of the basis atom positions. + integer, intent(out), optional :: iostat + !! Optional. The I/O status of the read. + + ! Local variables + integer :: Reason + !! The I/O status of the read. + integer :: i, j + !! Loop index. + integer, allocatable, dimension(:) :: tmp_num + !! Temporary array to store the number of atoms of each species. + real(real32), dimension(3) :: vec + !! Temporary array to store the atomic positions. + real(real32), allocatable, dimension(:,:,:) :: tmp_bas + !! Temporary array to store the atomic positions. + character(len=3) :: ctmp + !! Temporary character variable. + character(len=3), allocatable, dimension(:) :: tmp_spec + !! Temporary array to store the species names. + integer :: length_ + !! The dimension of the basis atom positions. + integer :: iostat_ + !! The I/O status of the read. + + + length_ = 3 + iostat_ = 0 + if(present(length)) length_ = length + + + read(UNIT,*,iostat=Reason) basis%natom + if(Reason.ne.0)then + write(0,'("ERROR: The file is not in xyz format.")') + iostat_ = 1 + if(present(iostat)) iostat = iostat_ + return + end if + read(UNIT,'(A)',iostat=Reason) basis%sysname + + + !--------------------------------------------------------------------------- + ! read basis + !--------------------------------------------------------------------------- + allocate(tmp_spec(basis%natom)) + allocate(tmp_num(basis%natom)) + allocate(tmp_bas(basis%natom,basis%natom,length_)) + tmp_num(:) = 0 + tmp_spec = "" + tmp_bas = 0 + basis%nspec = 0 + do i = 1, basis%natom + read(UNIT,*,iostat=Reason) ctmp,vec(1:3) + if(.not.any(tmp_spec(1:basis%nspec).eq.ctmp))then + basis%nspec = basis%nspec + 1 + tmp_spec(basis%nspec) = ctmp + tmp_bas(basis%nspec,1,1:3) = vec(1:3) + tmp_num(basis%nspec) = 1 + else + checkspec: do j = 1, basis%nspec + if(tmp_spec(j).eq.ctmp)then + tmp_num(j) = tmp_num(j)+1 + tmp_bas(j,tmp_num(j),1:3) = vec(1:3) + exit checkspec + end if + end do checkspec + end if + end do + + + !--------------------------------------------------------------------------- + ! move basis from temporary basis to main basis. + ! done to allow for correct allocation of number of and per species + !--------------------------------------------------------------------------- + allocate(basis%spec(basis%nspec)) + do i = 1, basis%nspec + basis%spec(i)%name = tmp_spec(i) + basis%spec(i)%num = tmp_num(i) + allocate(basis%spec(i)%atom(tmp_num(i),length_)) + basis%spec(i)%atom(:,:) = 0 + basis%spec(i)%atom(1:tmp_num(i),1:3) = tmp_bas(i,1:tmp_num(i),1:3) + end do + + if(present(iostat)) iostat = iostat_ + + end subroutine XYZ_geom_read +!############################################################################### + + +!############################################################################### + subroutine XYZ_geom_write(UNIT,basis) + !! Write the structure in xyz style format. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to write to. + class(basis_type), intent(in) :: basis + !! The basis to write the geometry from. + + ! Local variables + integer :: i, j + !! Loop index. + + + write(UNIT,'("I0")') basis%natom + write(UNIT,'("A")') basis%sysname + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + write(UNIT,'(A5,1X,3(F15.9))') & + basis%spec(i)%name,basis%spec(i)%atom(j,1:3) + end do + end do + + end subroutine XYZ_geom_write +!############################################################################### + + +!############################################################################### + subroutine extXYZ_geom_read(UNIT, basis, length, iostat) + !! Read the structure in extended xyz style format. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to read from. + type(basis_type), intent(out) :: basis + !! The basis to read the geometry into. + integer, intent(in), optional :: length + !! Optional. The dimension of the basis atom positions. + integer, intent(out), optional :: iostat + !! Optional. The I/O status of the read. + + ! Local variables + integer :: Reason + !! The I/O status of the read. + integer :: i, j + !! Loop index. + integer :: index1, index2 + !! Index variables. + integer, allocatable, dimension(:) :: tmp_num + !! Temporary array to store the number of atoms of each species. + real(real32), dimension(3) :: vec + !! Temporary array to store the atomic positions. + real(real32), allocatable, dimension(:,:,:) :: tmp_bas + !! Temporary array to store the atomic positions. + character(len=3) :: ctmp + !! Temporary character variable. + character(len=3), allocatable, dimension(:) :: tmp_spec + !! Temporary array to store the species names. + character(len=1024) :: buffer + !! Temporary character variable. + integer :: length_ = 3 + !! The dimension of the basis atom positions. + integer :: iostat_ = 0 + !! The I/O status of the read. + + + basis%lcart=.true. + if(present(length)) length_ = length + + + !--------------------------------------------------------------------------- + ! read system information + !--------------------------------------------------------------------------- + read(UNIT,*,iostat=Reason) basis%natom + if(Reason.ne.0)then + write(0,'("ERROR: The file is not in xyz format.")') + iostat_ = 1 + if(present(iostat)) iostat = iostat_ + return + end if + read(UNIT,'(A)',iostat=Reason) buffer + if(Reason.ne.0)then + write(0,'("ERROR: The file is not in xyz format.")') + iostat_ = 1 + if(present(iostat)) iostat = iostat_ + return + end if + index1 = index(buffer,'Lattice="') + 9 + index2 = index(buffer(index1:),'"') + index1 - 2 + read(buffer(index1:index2),*) ( ( basis%lat(i,j), j = 1, 3), i = 1, 3) + + index1 = index(buffer,'free_energy=') + 12 + read(buffer(index1:),*) basis%energy + + + !--------------------------------------------------------------------------- + ! read basis + !--------------------------------------------------------------------------- + allocate(tmp_spec(basis%natom)) + allocate(tmp_num(basis%natom)) + allocate(tmp_bas(basis%natom,basis%natom,length_)) + tmp_num(:) = 0 + tmp_spec = "" + tmp_bas = 0 + basis%nspec = 0 + do i = 1, basis%natom + read(UNIT,*,iostat=Reason) ctmp, vec(1:3) + if(.not.any(tmp_spec(1:basis%nspec).eq.ctmp))then + basis%nspec=basis%nspec+1 + tmp_spec(basis%nspec) = trim(adjustl(ctmp)) + tmp_bas(basis%nspec,1,1:3) = vec(1:3) + tmp_num(basis%nspec) = 1 + else + checkspec: do j = 1, basis%nspec + if(tmp_spec(j).eq.ctmp)then + tmp_num(j) = tmp_num(j) + 1 + tmp_bas(j,tmp_num(j),1:3) = vec(1:3) + exit checkspec + end if + end do checkspec + end if + end do + + + !--------------------------------------------------------------------------- + ! move basis from temporary basis to main basis. + ! done to allow for correct allocation of number of and per species + !--------------------------------------------------------------------------- + allocate(basis%spec(basis%nspec)) + basis%sysname = "" + do i = 1, basis%nspec + basis%spec(i)%name = tmp_spec(i) + basis%spec(i)%num = tmp_num(i) + allocate(basis%spec(i)%atom(tmp_num(i),length_)) + basis%spec(i)%atom(:,:) = 0 + basis%spec(i)%atom(1:tmp_num(i),1:3) = tmp_bas(i,1:tmp_num(i),1:3) + write(buffer,'(I0,A)') basis%spec(i)%num,trim(basis%spec(i)%name) + basis%sysname = basis%sysname//trim(buffer) + if(i.lt.basis%nspec) basis%sysname = trim(adjustl(basis%sysname))//"_" + end do + + if(present(iostat)) iostat = iostat_ + + end subroutine extXYZ_geom_read +!############################################################################### + + +!############################################################################### + subroutine extXYZ_geom_write(UNIT, basis) + !! Write the structure in extended xyz style format. + implicit none + + ! Arguments + integer, intent(in) :: UNIT + !! The unit number of the file to write to. + class(basis_type), intent(in) :: basis + !! The basis to write the geometry from. + + ! Local variables + integer :: i, j + !! Loop index. + + + write(UNIT,'(I0)') basis%natom + write(UNIT,'(A,8(F0.8,1X),F0.8,A)', advance="no") & + 'Lattice="',((basis%lat(i,j),j=1,3),i=1,3),'"' + write(UNIT,'(A,F0.8)', advance="no") ' free_energy=',basis%energy + write(UNIT,'(A)', advance="no") ' pbc="T T T"' + if(basis%lcart)then + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + write(UNIT,'(A8,3(1X, F16.8))') & + basis%spec(i)%name,basis%spec(i)%atom(j,1:3) + end do + end do + else + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + write(UNIT,'(A8,3(1X, F16.8))') basis%spec(i)%name, & + matmul(basis%spec(i)%atom(j,1:3),basis%lat) + end do + end do + end if + + end subroutine extXYZ_geom_write +!############################################################################### + + +!############################################################################### + subroutine convert(this) + !! Convert the basis between direct and cartesian coordinates. + implicit none -!!!----------------------------------------------------------------------------- -!!! determines dimension of basis (include translation dimension for symmetry?) -!!!----------------------------------------------------------------------------- - if(present(length))then - dim = length - else - dim = 3 - end if - - -!!!----------------------------------------------------------------------------- -!!! reading loop of file -!!!----------------------------------------------------------------------------- - tmp_spec="" - tmp_natom=0 - iline=0 - basis%sysname="from CASTEP" - rewind(UNIT) - readloop: do - iline=iline+1 - read(UNIT,'(A)',iostat=Reason) buffer - if(Reason.ne.0) exit - buffer=to_upper(buffer) - if(scan(trim(adjustl(buffer)),'%').ne.1) cycle readloop - if(index(trim(adjustl(buffer)),'%END').eq.1) cycle readloop - read(buffer,*) store, buffer - if(trim(buffer).eq.'') cycle readloop - !!------------------------------------------------------------------------ - !! read lattice - !!------------------------------------------------------------------------ - lattice_if: if(index(trim(buffer),"LATTICE").eq.1)then - if(index(trim(buffer),"ABC").ne.0) labc=.true. - if(index(trim(buffer),"CART").ne.0) labc=.false. - store="" - itmp1=0 - lattice_loop: do - itmp1=itmp1+1 - read(UNIT,'(A)',iostat=Reason) buffer - if(Reason.ne.0) exit lattice_loop - if(scan(trim(adjustl(buffer)),'%').eq.1) exit lattice_loop - if(itmp1.eq.5)then - write(0,'("ERROR: Too many lines in LATTICE block of structure file")') - stop - end if - store=trim(store)//" "//trim(buffer) - end do lattice_loop - iline=iline+itmp1 - - if(labc)then - read(store,*) units,(abc(i),i=1,3), (angle(j),j=1,3) - lattice=convert_abc_to_lat(abc,angle,.false.) - else - read(store,*) units,(lattice(i,:),i=1,3) - end if - cycle readloop - end if lattice_if - - !!------------------------------------------------------------------------ - !! read basis - !!------------------------------------------------------------------------ - basis_if: if(index(trim(buffer),"POSITIONS").eq.1) then - if(index(trim(buffer),"ABS").ne.0) basis%lcart=.true. - if(index(trim(buffer),"FRAC").ne.0) basis%lcart=.false. - itmp1=0 - basis_loop1: do - read(UNIT,'(A)',iostat=Reason) buffer - if(Reason.ne.0) exit basis_loop1 - if(scan(trim(adjustl(buffer)),'%').eq.1) exit basis_loop1 - read(buffer,*) ctmp - if(trim(ctmp).eq.'') exit - if(verify(buffer,' 0123456789').eq.0) exit - basis%natom=basis%natom+1 - if(.not.any(tmp_spec(1:basis%nspec).eq.ctmp))then - basis%nspec=basis%nspec+1 - tmp_natom(basis%nspec)=1 - tmp_spec(basis%nspec)=ctmp - else - where(tmp_spec(1:basis%nspec).eq.ctmp) - tmp_natom(1:basis%nspec)=tmp_natom(1:basis%nspec)+1 - end where - end if - end do basis_loop1 - - allocate(basis%spec(basis%nspec)) - basis%spec(1:basis%nspec)%name=tmp_spec(1:basis%nspec) - do i=1,basis%nspec - basis%spec(i)%num=0 - allocate(basis%spec(i)%atom(tmp_natom(i),dim)) - end do - - call jump(UNIT,iline) - basis_loop2: do i=1,basis%natom - read(UNIT,'(A)',iostat=Reason) buffer - if(Reason.ne.0)then - write(0,'("ERROR: Internal error in assigning the basis")') - stop - end if - read(buffer,*) ctmp,dvtmp1(1:3) - species_loop: do j=1,basis%nspec - if(basis%spec(j)%name.eq.ctmp)then - basis%spec(j)%num=basis%spec(j)%num+1 - basis%spec(j)%atom(basis%spec(j)%num,1:3)=dvtmp1(1:3) - exit species_loop - end if - end do species_loop - end do basis_loop2 - - end if basis_if + ! Arguments + class(basis_type), intent(inout) :: this + !! Parent. The basis to convert. + + ! Local variables + integer :: is, ia + !! Loop index. + real(real32), dimension(3,3) :: lattice + !! The reciprocal lattice vectors. + + + if(this%lcart)then + lattice = inverse_3x3( this%lat ) + else + lattice = this%lat + end if + + this%lcart = .not.this%lcart + do is = 1, this%nspec + do ia = 1, this%spec(is)%num + this%spec(is)%atom(ia,1:3) = & + matmul( this%spec(is)%atom(ia,1:3), lattice ) + end do + end do - end do readloop - - -!!!----------------------------------------------------------------------------- -!!! convert basis if in cartesian coordinates -!!!----------------------------------------------------------------------------- - if(basis%lcart)then - reclat=transpose(LUinv(lattice)) - basis=convert_bas(basis,reclat) - end if - - -!!!----------------------------------------------------------------------------- -!!! normalise basis to between 0 and 1 in direct coordinates -!!!----------------------------------------------------------------------------- - do i=1,basis%nspec - do j=1,basis%spec(i)%num - do k=1,3 - basis%spec(i)%atom(j,k)=& - basis%spec(i)%atom(j,k)-floor(basis%spec(i)%atom(j,k)) - end do + end subroutine convert +!############################################################################### + + +!############################################################################### + subroutine change_lattice(this, lattice) + !! Change the lattice of the basis. + !! + !! This transforms the basis to a new lattice. + implicit none + + ! Arguments + class(basis_type), intent(inout) :: this + !! Parent. The basis to transform. + real(real32), dimension(3,3), intent(in) :: lattice + !! The new lattice. + + ! Local variables + integer :: is, ia + !! Loop index. + real(real32), dimension(3,3) :: transform + !! The transformation matrix. + + + transform = matmul(inverse_3x3(lattice),this%lat) + if(.not.this%lcart) call this%convert() + do is = 1, this%nspec + do ia = 1, this%spec(is)%num + this%spec(is)%atom(ia,1:3) = & + matmul(transform, this%spec(is)%atom(ia,1:3)) end do end do - basis%natom=sum(basis%spec(:)%num) + end subroutine change_lattice +!############################################################################### - return - end subroutine CASTEP_geom_read -!!!############################################################################# +!############################################################################### + subroutine normalise( & + this, & + ceil_val, & + floor_coords, round_coords, & + zero_round & + ) + !! Normalise the basis to between 0 and 1. + implicit none -!!!############################################################################# -!!! writes lattice and basis in a CASTEP file format -!!!############################################################################# - subroutine CASTEP_geom_write(UNIT,lat_write,bas_write,labc,lcart) - implicit none - integer :: i,j,UNIT - double precision, dimension(3) :: abc,angle - double precision, dimension(3,3) :: lat_write - type(bas_type) :: bas_write - character(4) :: string_lat,string_bas - logical, intent(in), optional :: labc,lcart - - - string_lat="CART" - if(present(labc))then - if(labc) string_lat="ABC" - end if - - string_bas="FRAC" - if(present(lcart))then - if(lcart)then - string_bas="ABS" - write(0,'("ERROR: Internal error in CASTEP_geom_write")') - write(0,'(2X,"Subroutine not yet set up to output cartesian & - &coordinates")') - stop - end if - end if - - write(UNIT,'("%block LATTICE_",A)') trim(string_lat) - write(UNIT,'("ang")') - if(present(labc))then - if(labc)then - do i=1,3 - abc(i)=modu(lat_write(i,:)) - end do - angle(1) = dot_product(lat_write(2,:),lat_write(3,:))/(abc(2)*abc(3)) - angle(2) = dot_product(lat_write(1,:),lat_write(3,:))/(abc(1)*abc(3)) - angle(3) = dot_product(lat_write(1,:),lat_write(2,:))/(abc(1)*abc(2)) - write(UNIT,'(3(F15.9))') abc - write(UNIT,'(3(F15.9))') angle - goto 10 - end if - end if - do i=1,3 - write(UNIT,'(3(F15.9))') lat_write(i,:) - end do + ! Arguments + class(basis_type), intent(inout) :: this + !! Parent. The basis to normalise. + real(real32), intent(in), optional :: ceil_val + !! Optional. The ceiling value for normalisation. + logical, intent(in), optional :: floor_coords + !! Optional. Whether to floor the coordinates. + logical, intent(in), optional :: round_coords + !! Optional. Whether to round the coordinates. + real(real32), intent(in), optional :: zero_round + !! Optional. The value to set coordinates to if they are less than tol. + + ! Local variables + integer :: is, ia, j + !! Loop index. + real(real32) :: ceil_val_, floor_val, tol + !! The ceiling value, floor value, and tolerance. + logical :: floor_coords_, round_coords_ + !! Boolean whether to floor and round the coordinates. + + + ceil_val_ = 1._real32 + floor_coords_ = .false. + if(present(ceil_val)) ceil_val_ = ceil_val + if(present(floor_coords)) floor_coords_ = floor_coords + floor_val = ceil_val_ - 1._real32 + tol = 1.E-8_real32 + round_coords_ = .false. + if(present(round_coords)) round_coords_ = round_coords + + do is=1,this%nspec + do ia=1,this%spec(is)%num + do j=1,3 + if(floor_coords_)then + this%spec(is)%atom(ia,j) = this%spec(is)%atom(ia,j) - & + floor(this%spec(is)%atom(ia,j) - floor_val) + else + this%spec(is)%atom(ia,j) = this%spec(is)%atom(ia,j) - & + ceiling(this%spec(is)%atom(ia,j)-ceil_val_) + end if + if(round_coords_)then + if(abs(this%spec(is)%atom(ia,j)-ceil_val_).lt.tol.or.& + abs(this%spec(is)%atom(ia,j)).lt.tol) & + this%spec(is)%atom(ia,j) = floor_val + end if + if(present(zero_round))then + if(abs(this%spec(is)%atom(ia,j)).lt.tol) & + this%spec(is)%atom(ia,j) = zero_round + end if + end do + end do + end do -10 write(UNIT,'("%endblock LATTICE_",A)') trim(string_lat) + end subroutine normalise +!############################################################################### - write(UNIT,*) - write(UNIT,'("%block POSITIONS_",A)') trim(string_bas) - do i=1,bas_write%nspec - do j=1,bas_write%spec(i)%num - write(UNIT,'(A5,1X,3(F15.9))') bas_write%spec(i)%name,bas_write%spec(i)%atom(j,1:3) - end do - end do - write(UNIT,'("%endblock POSITIONS_",A)') trim(string_bas) +!############################################################################### + function convert_abc_to_lat(abc,angle,radians) result(lattice) + !! Convert the lattice from abc and αβγ to lattice matrix. + implicit none - end subroutine CASTEP_geom_write -!!!############################################################################# + ! Arguments + real(real32), dimension(3), intent(in) :: abc, angle + !! lattice constants + logical, intent(in), optional :: radians + !! Optional. Boolean whether angles are in radians. + real(real32), dimension(3,3) :: lattice + !! The lattice matrix. + ! Local variables + real(real32), dimension(3) :: in_angle + !! The lattice angles in radians. -!!!############################################################################# -!!! reads atoms from an xyz file -!!!############################################################################# - subroutine XYZ_geom_read(UNIT,length) - implicit none - integer :: UNIT,Reason - integer, intent(in), optional :: length - integer, allocatable, dimension(:) :: tmp_num - double precision, dimension(3) :: vec - double precision, allocatable, dimension(:,:,:) :: tmp_bas - character(len=5) :: ctmp - character(len=5), allocatable, dimension(:) :: tmp_spec - integer :: i,j,dim - - dim=3 - if(present(length)) dim=length - - - read(UNIT,*,iostat=Reason) basis%natom - if(Reason.ne.0)then - write(0,'(" The file is not in xyz format.")') - write(0,'(" Exiting code ...")') - call exit() - end if - read(UNIT,'(A)',iostat=Reason) basis%sysname - - -!!!----------------------------------------------------------------------------- -!!! read basis -!!!----------------------------------------------------------------------------- - allocate(tmp_spec(basis%natom)) - allocate(tmp_num(basis%natom)) - allocate(tmp_bas(basis%natom,basis%natom,dim)) - tmp_num(:)=0 - tmp_spec="" - tmp_bas=0 - basis%nspec=0 - do i=1,basis%natom - read(UNIT,*,iostat=Reason) ctmp,vec(1:3) - if(.not.any(tmp_spec(1:basis%nspec).eq.ctmp))then - basis%nspec=basis%nspec+1 - tmp_spec(basis%nspec)=ctmp - tmp_bas(basis%nspec,1,1:3)=vec(1:3) - tmp_num(basis%nspec)=1 - else - checkspec: do j=1,basis%nspec - if(tmp_spec(j).eq.ctmp)then - tmp_num(j)=tmp_num(j)+1 - tmp_bas(j,tmp_num(j),1:3)=vec(1:3) - exit checkspec - end if - end do checkspec - end if - end do -!!!----------------------------------------------------------------------------- -!!! move basis from temporary basis to main basis. -!!! done to allow for correct allocation of number of and per species -!!!----------------------------------------------------------------------------- - allocate(basis%spec(basis%nspec)) - basis%spec(1:basis%nspec)%name=tmp_spec(1:basis%nspec) - do i=1,basis%nspec - basis%spec(i)%name=tmp_spec(i) - basis%spec(i)%num=tmp_num(i) - allocate(basis%spec(i)%atom(tmp_num(i),dim)) - basis%spec(i)%atom(:,:)=0 - basis%spec(i)%atom(1:tmp_num(i),1:3)=tmp_bas(i,1:tmp_num(i),1:3) - end do + in_angle = angle + if(present(radians))then + if(.not.radians) in_angle = angle*pi/180._real32 + end if + lattice=0._real32 - end subroutine XYZ_geom_read -!!!############################################################################# + lattice(1,1)=abc(1) + lattice(2,:2)=(/abc(2)*cos(in_angle(3)),abc(2)*sin(in_angle(3))/) + 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._real32 - & + lattice(3,1)**2._real32 - & + lattice(3,2)**2._real32) -!!!############################################################################# -!!! generates cartesian basis -!!!############################################################################# - subroutine XYZ_geom_write(UNIT,bas_write) - implicit none - integer :: i,j,UNIT - type(bas_type) :: bas_write - - - write(UNIT,'("I0")') bas_write%natom - write(UNIT,'("A")') bas_write%sysname - do i=1,bas_write%nspec - do j=1,bas_write%spec(i)%num - write(UNIT,'(A5,1X,3(F15.9))') & - bas_write%spec(i)%name,bas_write%spec(i)%atom(j,1:3) - end do - end do + end function convert_abc_to_lat +!############################################################################### - end subroutine XYZ_geom_write -!!!############################################################################# +!############################################################################### + function convert_lat_to_abc(lattice, radians) result(abc_angle) + !! Convert the lattice from lattice matrix to abc and αβγ. + implicit none + ! Arguments + 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(real32), dimension(2,3) :: abc_angle + !! The lattice constants and angles. + + ! Local variables + integer :: i + !! Loop index. + + + do i = 1, 3 + abc_angle(1,i)=modu(lattice(i,:)) + end do + do i = 1, 3 + end do + abc_angle(2,1)=acos(dot_product(lattice(2,:),lattice(3,:))/& + (abc_angle(1,2)*abc_angle(1,3))) + abc_angle(2,3)=acos(dot_product(lattice(1,:),lattice(3,:))/& + (abc_angle(1,1)*abc_angle(1,3))) + abc_angle(2,3)=acos(dot_product(lattice(1,:),lattice(2,:))/& + (abc_angle(1,1)*abc_angle(1,2))) + + if(present(radians))then + if(.not.radians) abc_angle(2,:)=abc_angle(2,:)*180._real32/pi + end if -!!!############################################################################# -!!! convert basis using latconv transformation matrix -!!!############################################################################# - function convert_bas(inbas,latconv) result(outbas) - implicit none - integer :: is,ia,dim - type(bas_type) :: outbas - - type(bas_type), intent(in) :: inbas - double precision, dimension(3,3), intent(in) :: latconv - - - dim=size(inbas%spec(1)%atom(1,:)) - allocate(outbas%spec(inbas%nspec)) - outbas%natom=inbas%natom - outbas%nspec=inbas%nspec - outbas%sysname=inbas%sysname - outbas%lcart=.not.inbas%lcart - do is=1,inbas%nspec - allocate(outbas%spec(is)%atom(inbas%spec(is)%num,dim)) - outbas%spec(is)=inbas%spec(is) - do ia=1,inbas%spec(is)%num - outbas%spec(is)%atom(ia,1:3)=& - matmul(latconv,outbas%spec(is)%atom(ia,1:3)) - end do - end do - - end function convert_bas -!!!############################################################################# + end function convert_lat_to_abc +!############################################################################### -!!!############################################################################# -!!! converts lattice from abc and αβγ to lattice matrix -!!!############################################################################# - function convert_abc_to_lat(abc,angle,radians) result(out_lat) - use constants, only: pi - implicit none - double precision, dimension(3) :: in_angle - double precision, dimension(3,3) :: out_lat +!############################################################################### + function get_lattice_constants(this, radians) result(output) + !! Convert the lattice from lattice matrix to abc and αβγ. + implicit none - double precision, dimension(3), intent(in) :: abc,angle + ! Arguments + class(basis_type), intent(in) :: this + !! Parent. The basis. + logical, intent(in), optional :: radians + !! Optional. Boolean whether to return angles in radians. + real(real32), dimension(2,3) :: output + !! The lattice constants and angles. - logical, optional, intent(in) :: radians + ! Local variables + logical :: radians_ + !! Boolean whether to return angles in radians. - if(present(radians))then - if(.not.radians) in_angle=angle*pi/180.D0 - end if -! in_angle=angle*pi/180.D0 ! this looks wrong, check it + radians_ = .true. + if(present(radians)) radians_ = radians - out_lat=0.D0 + output = convert_lat_to_abc(this%lat, radians_) - out_lat(1,1)=abc(1) - out_lat(2,:2)=(/abc(2)*cos(in_angle(3)),abc(2)*sin(in_angle(3))/) + end function get_lattice_constants +!############################################################################### - out_lat(3,1) = abc(3)*cos(in_angle(2)) - out_lat(3,2) = abc(3)*(cos(in_angle(1)) - cos(in_angle(2))*& - cos(in_angle(3)))/sin(in_angle(3)) - out_lat(3,3) = sqrt(abc(3)**2.D0 - out_lat(3,1)**2.D0 - out_lat(3,2)**2.D0) +!############################################################################### + subroutine copy(this, basis, length) + !! Copy the basis. + implicit none - end function convert_abc_to_lat -!!!############################################################################# + ! Arguments + class(basis_type), intent(inout) :: this + !! Parent. The basis to copy into. + class(basis_type), intent(in) :: basis + !! The basis to copy from. + integer, intent(in), optional :: length + !! The dimension of the basis atom positions. + + + ! Local variables + integer :: i + !! Loop index. + integer :: length_, length_input + !! The dimension of the basis atom positions. + + + !--------------------------------------------------------------------------- + ! determines whether user wants output basis extra translational dimension + !--------------------------------------------------------------------------- + length_input = size(basis%spec(1)%atom(1,:),dim=1) + if(present(length))then + length_ = length + else + length_ = length_input + end if -!!!############################################################################# -!!! converts lattice from matrix to abc and αβγ -!!!############################################################################# - function convert_lat_to_abc(in_lat,radians) result(abc_angle) - use constants, only: pi - implicit none - integer :: i - double precision, dimension(2,3) :: abc_angle + !--------------------------------------------------------------------------- + ! if already allocated, deallocates output basis + !--------------------------------------------------------------------------- + if(allocated(this%spec))then + do i = 1, this%nspec + if(allocated(this%spec(i)%atom)) deallocate(this%spec(i)%atom) + end do + deallocate(this%spec) + end if - double precision, dimension(3,3), intent(in) :: in_lat - logical, optional, intent(in) :: radians + !--------------------------------------------------------------------------- + ! allocates output basis and clones data from input basis to output basis + !--------------------------------------------------------------------------- + allocate(this%spec(basis%nspec)) + do i = 1, basis%nspec + allocate(this%spec(i)%atom(& + basis%spec(i)%num,length_)) + + this%spec(i)%atom(:,:3) = basis%spec(i)%atom(:,:3) + if(length_input.eq.length_)then + this%spec(i)%atom(:,:length_) = basis%spec(i)%atom(:,:length_) + elseif(length_input.gt.length_)then + 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._real32 + end if + this%spec(i)%num = basis%spec(i)%num + this%spec(i)%name = strip_null(basis%spec(i)%name) + + this%spec(i)%mass = basis%spec(i)%mass + this%spec(i)%charge = basis%spec(i)%charge + this%spec(i)%radius = basis%spec(i)%radius + end do + this%nspec = basis%nspec + this%natom = basis%natom + this%lcart = basis%lcart + this%sysname = basis%sysname + this%energy = basis%energy + this%lat = basis%lat + this%pbc = basis%pbc + + end subroutine copy +!############################################################################### + + +!############################################################################### + subroutine remove_atom(this, ispec, iatom) + !! Remove an atom from the basis. + implicit none + ! Arguments + class(basis_type), intent(inout) :: this + !! Parent. The basis. + integer, intent(in) :: ispec, iatom + !! The species and atom to remove. + + ! Local variables + integer :: i + !! Loop index. + real(real32), dimension(:,:), allocatable :: atom + !! Temporary array to store the atomic positions. + + + !--------------------------------------------------------------------------- + ! remove atom from basis + !--------------------------------------------------------------------------- + do i = 1, this%nspec + if(i.eq.ispec)then + if(iatom.gt.this%spec(i)%num)then + call stop_program("Atom to remove does not exist") + return + end if + allocate(atom(this%spec(i)%num-1,size(this%spec(i)%atom,2))) + atom(1:iatom-1:1,:) = this%spec(i)%atom(1:iatom-1:1,:) + atom(iatom:this%spec(i)%num-1:1,:) = & + this%spec(i)%atom(iatom+1:this%spec(i)%num:1,:) + this%spec(i)%atom = atom + deallocate(atom) + this%spec(i)%num = this%spec(i)%num - 1 + this%natom = this%natom - 1 + if(this%spec(i)%num.eq.0)then + deallocate(this%spec(i)%atom) + if(this%nspec.eq.0)then + deallocate(this%spec) + this%lcart = .true. + this%sysname = "" + this%energy = 0._real32 + this%lat = 0._real32 + this%pbc = .true. + end if + end if + end if + end do + + end subroutine remove_atom +!############################################################################### + + +!############################################################################### + subroutine remove_atoms(this, atoms) + !! Remove atoms from the basis. + use artemis__misc, only: swap + implicit none - do i=1,3 - abc_angle(1,i)=modu(in_lat(i,:)) - end do - do i=1,3 - end do - abc_angle(2,1)=acos(dot_product(in_lat(2,:),in_lat(3,:))/& - (abc_angle(1,2)*abc_angle(1,3))) - abc_angle(2,3)=acos(dot_product(in_lat(1,:),in_lat(3,:))/& - (abc_angle(1,1)*abc_angle(1,3))) - abc_angle(2,3)=acos(dot_product(in_lat(1,:),in_lat(2,:))/& - (abc_angle(1,1)*abc_angle(1,2))) - - if(present(radians))then - if(.not.radians) abc_angle(2,:)=abc_angle(2,:)*180.D0/pi - end if - - end function convert_lat_to_abc -!!!############################################################################# + ! Arguments + class(basis_type), intent(inout) :: this + !! Parent. The basis. + integer, dimension(:,:), intent(in) :: atoms + !! The atoms to remove (2, number of atoms to remove) + !! 1st value of 1st dimension is the species number + !! 2nd value of 1st dimension is the atom number + !! 2nd dimension is the number of atoms to remove + + ! Local variables + integer :: is, ia, i + !! Loop index. + integer :: n, m, start_idx, end_idx, loc + !! Index variables. + integer :: num_species + !! The number of species. + integer, dimension(:,:), allocatable :: atoms_ordered + !! The atoms to remove ordered by species and atom + real(real32), dimension(:,:), allocatable :: atom + !! Temporary array to store the atomic positions. + + + !--------------------------------------------------------------------------- + ! reorder atoms to remove + !--------------------------------------------------------------------------- + allocate(atoms_ordered, source=atoms) + n = size(atoms_ordered, 1) + m = size(atoms_ordered, 2) + + do i = 1, m + loc = maxloc(atoms_ordered(1, i:n), dim=1) + i - 1 + if (loc .ne. i) then + call swap(atoms_ordered(1, i), atoms_ordered(1, loc)) + call swap(atoms_ordered(2, i), atoms_ordered(2, loc)) + end if + end do + num_species = this%nspec + do is = 1, num_species + start_idx = findloc(atoms_ordered(1, :), is, dim=1) + end_idx = findloc(atoms_ordered(1, :), is, dim=1, back=.true.) + if (start_idx .eq. 0) cycle + do ia = start_idx, end_idx, 1 + loc = maxloc( & + atoms_ordered(2, ia:end_idx), & + dim=1 & + ) + ia - 1 + if (loc .ne. ia) then + call swap(atoms_ordered(1, ia), atoms_ordered(1, loc)) + call swap(atoms_ordered(2, ia), atoms_ordered(2, loc)) + end if + end do + end do -!!!############################################################################# -!!! clones basis 1 onto basis 2 -!!!############################################################################# - subroutine clone_bas(inbas,outbas,inlat,outlat,trans_dim) - implicit none - integer :: i - integer :: indim,outdim - double precision :: val - logical :: udef_trans_dim - - type(bas_type) :: inbas,outbas - double precision, dimension(3,3), optional :: inlat,outlat - - logical, optional, intent(in) :: trans_dim - - -!!!----------------------------------------------------------------------------- -!!! determines whether user wants output basis extra translational dimension -!!!----------------------------------------------------------------------------- - indim = size(inbas%spec(1)%atom(1,:),dim=1) - if(present(trans_dim))then - udef_trans_dim = trans_dim - elseif(indim.eq.4)then - udef_trans_dim = .true. - elseif(indim.eq.3)then - udef_trans_dim = .false. - end if - - -!!!----------------------------------------------------------------------------- -!!! sets up output basis atomic coordinates dimension -!!!----------------------------------------------------------------------------- - if(udef_trans_dim)then - outdim = 4 - val = 1.D0 - else - outdim = 3 - val = 0.D0 - end if - - -!!!----------------------------------------------------------------------------- -!!! if already allocated, deallocates output basis -!!!----------------------------------------------------------------------------- - if(allocated(outbas%spec))then - do i=1,outbas%nspec - if(allocated(outbas%spec(i)%atom)) deallocate(outbas%spec(i)%atom) - end do - deallocate(outbas%spec) - end if - - -!!!----------------------------------------------------------------------------- -!!! allocates output basis and clones data from input basis to output basis -!!!----------------------------------------------------------------------------- - allocate(outbas%spec(inbas%nspec)) - do i=1,inbas%nspec - allocate(outbas%spec(i)%atom(& - inbas%spec(i)%num,outdim)) - if(indim.eq.outdim)then - outbas%spec(i)%atom(:,:indim) = inbas%spec(i)%atom(:,:indim) - elseif(outdim.gt.indim)then - outbas%spec(i)%atom(:,:indim) = inbas%spec(i)%atom(:,:indim) - outbas%spec(i)%atom(:,outdim) = val - else - outbas%spec(i)%atom(:,:outdim) = inbas%spec(i)%atom(:,:outdim) - end if - outbas%spec(i)%mass = inbas%spec(i)%mass - outbas%spec(i)%num = inbas%spec(i)%num - outbas%spec(i)%name = inbas%spec(i)%name - end do -! outbas = inbas !using this will reallocate outbas to inbas - outbas%nspec = inbas%nspec - outbas%natom = inbas%natom - outbas%lcart = inbas%lcart - outbas%sysname = inbas%sysname + !--------------------------------------------------------------------------- + ! remove atoms from basis + !--------------------------------------------------------------------------- + do i = 1, size(atoms_ordered, 2) + call this%remove_atom(atoms_ordered(1, i), atoms_ordered(2, i)) + end do + do is = 1, this%nspec + if (this%spec(is)%num .eq. 0) then + this%spec = [ this%spec(1:is-1), this%spec(is+1:) ] + this%nspec = this%nspec - 1 + end if + end do -!!!----------------------------------------------------------------------------- -!!! clones input lattice to output lattice, if requested -!!!----------------------------------------------------------------------------- - if(present(inlat).and.present(outlat))then - outlat=inlat - end if + end subroutine remove_atoms +!############################################################################### - return - end subroutine clone_bas -!!!############################################################################# +!############################################################################### + subroutine get_element_properties(element, charge, mass, radius) + !! Set the mass and charge of the element + implicit none + + ! Arguments + character(len=3), intent(in) :: element + !! Element name. + real(real32), intent(out), optional :: charge + !! Charge of the element. + real(real32), intent(out), optional :: mass + !! Mass of the element. + real(real32), intent(out), optional :: radius + !! Radius of the element. + + ! Local variables + real(real32) :: mass_, charge_, radius_ + !! Mass, charge and radius of the element. + + select case(element) + case('H') + mass_ = 1.00784_real32 + charge_ = 1.0_real32 + radius_ = 0.31_real32 + case('He') + mass_ = 4.0026_real32 + charge_ = 2.0_real32 + radius_ = 0.28_real32 + case('Li') + mass_ = 6.94_real32 + charge_ = 3.0_real32 + radius_ = 1.28_real32 + case('Be') + mass_ = 9.0122_real32 + charge_ = 4.0_real32 + radius_ = 0.96_real32 + case('B') + mass_ = 10.81_real32 + charge_ = 5.0_real32 + radius_ = 0.84_real32 + case('C') + mass_ = 12.011_real32 + charge_ = 6.0_real32 + radius_ = 0.76_real32 + case('N') + mass_ = 14.007_real32 + charge_ = 7.0_real32 + radius_ = 0.71_real32 + case('O') + mass_ = 15.999_real32 + charge_ = 8.0_real32 + radius_ = 0.66_real32 + case('F') + mass_ = 18.998_real32 + charge_ = 9.0_real32 + radius_ = 0.57_real32 + case('Ne') + mass_ = 20.180_real32 + charge_ = 10.0_real32 + radius_ = 0.58_real32 + case('Na') + mass_ = 22.989_real32 + charge_ = 11.0_real32 + radius_ = 1.66_real32 + case('Mg') + mass_ = 24.305_real32 + charge_ = 12.0_real32 + radius_ = 1.41_real32 + case('Al') + mass_ = 26.982_real32 + charge_ = 13.0_real32 + radius_ = 1.21_real32 + case('Si') + mass_ = 28.085_real32 + charge_ = 14.0_real32 + radius_ = 1.11_real32 + case('P') + mass_ = 30.974_real32 + charge_ = 15.0_real32 + radius_ = 1.07_real32 + case('S') + mass_ = 32.06_real32 + charge_ = 16.0_real32 + radius_ = 1.05_real32 + case('Cl') + mass_ = 35.453_real32 + charge_ = 17.0_real32 + radius_ = 1.02_real32 + case('Ar') + mass_ = 39.948_real32 + charge_ = 18.0_real32 + radius_ = 1.06_real32 + case('K') + mass_ = 39.098_real32 + charge_ = 19.0_real32 + radius_ = 2.03_real32 + case('Ca') + mass_ = 40.078_real32 + charge_ = 20.0_real32 + radius_ = 1.74_real32 + case('Sc') + mass_ = 44.956_real32 + charge_ = 21.0_real32 + radius_ = 1.44_real32 + case('Ti') + mass_ = 47.867_real32 + charge_ = 22.0_real32 + radius_ = 1.32_real32 + case('V') + mass_ = 50.942_real32 + charge_ = 23.0_real32 + radius_ = 1.22_real32 + case('Cr') + mass_ = 51.996_real32 + charge_ = 24.0_real32 + radius_ = 1.18_real32 + case('Mn') + mass_ = 54.938_real32 + charge_ = 25.0_real32 + radius_ = 1.17_real32 + case('Fe') + mass_ = 55.845_real32 + charge_ = 26.0_real32 + radius_ = 1.17_real32 + case('Co') + mass_ = 58.933_real32 + charge_ = 27.0_real32 + radius_ = 1.16_real32 + case('Ni') + mass_ = 58.693_real32 + charge_ = 28.0_real32 + radius_ = 1.15_real32 + case('Cu') + mass_ = 63.546_real32 + charge_ = 29.0_real32 + radius_ = 1.17_real32 + case('Zn') + mass_ = 65.38_real32 + charge_ = 30.0_real32 + radius_ = 1.25_real32 + case('Ga') + mass_ = 69.723_real32 + charge_ = 31.0_real32 + radius_ = 1.26_real32 + case('Ge') + mass_ = 72.63_real32 + charge_ = 32.0_real32 + radius_ = 1.22_real32 + case('As') + mass_ = 74.922_real32 + charge_ = 33.0_real32 + radius_ = 1.19_real32 + case('Se') + mass_ = 78.971_real32 + charge_ = 34.0_real32 + radius_ = 1.16_real32 + case('Br') + mass_ = 79.904_real32 + charge_ = 35.0_real32 + radius_ = 1.14_real32 + case('Kr') + mass_ = 83.798_real32 + charge_ = 36.0_real32 + radius_ = 1.12_real32 + case('Rb') + mass_ = 85.468_real32 + charge_ = 37.0_real32 + radius_ = 2.16_real32 + case('Sr') + mass_ = 87.62_real32 + charge_ = 38.0_real32 + radius_ = 1.91_real32 + case('Y') + mass_ = 88.906_real32 + charge_ = 39.0_real32 + radius_ = 1.62_real32 + case('Zr') + mass_ = 91.224_real32 + charge_ = 40.0_real32 + radius_ = 1.45_real32 + case('Nb') + mass_ = 92.906_real32 + charge_ = 41.0_real32 + radius_ = 1.34_real32 + case('Mo') + mass_ = 95.95_real32 + charge_ = 42.0_real32 + radius_ = 1.3_real32 + case('Tc') + mass_ = 98.0_real32 + charge_ = 43.0_real32 + radius_ = 1.27_real32 + case('Ru') + mass_ = 101.07_real32 + charge_ = 44.0_real32 + radius_ = 1.25_real32 + case('Rh') + mass_ = 102.91_real32 + charge_ = 45.0_real32 + radius_ = 1.25_real32 + case('Pd') + mass_ = 106.42_real32 + charge_ = 46.0_real32 + radius_ = 1.28_real32 + case('Ag') + mass_ = 107.87_real32 + charge_ = 47.0_real32 + radius_ = 1.34_real32 + case('Cd') + mass_ = 112.41_real32 + charge_ = 48.0_real32 + radius_ = 1.48_real32 + case('In') + mass_ = 114.82_real32 + charge_ = 49.0_real32 + radius_ = 1.44_real32 + case('Sn') + mass_ = 118.71_real32 + charge_ = 50.0_real32 + radius_ = 1.41_real32 + case('Sb') + mass_ = 121.76_real32 + charge_ = 51.0_real32 + radius_ = 1.38_real32 + case('Te') + mass_ = 127.6_real32 + charge_ = 52.0_real32 + radius_ = 1.35_real32 + case('I') + mass_ = 126.9_real32 + charge_ = 53.0_real32 + radius_ = 1.33_real32 + case('Xe') + mass_ = 131.29_real32 + charge_ = 54.0_real32 + radius_ = 1.31_real32 + case('Cs') + mass_ = 132.91_real32 + charge_ = 55.0_real32 + radius_ = 2.35_real32 + case('Ba') + mass_ = 137.33_real32 + charge_ = 56.0_real32 + radius_ = 1.98_real32 + case('La') + mass_ = 138.91_real32 + charge_ = 57.0_real32 + radius_ = 1.69_real32 + case('Ce') + mass_ = 140.12_real32 + charge_ = 58.0_real32 + radius_ = 1.65_real32 + case('Pr') + mass_ = 140.91_real32 + charge_ = 59.0_real32 + radius_ = 1.65_real32 + case('Nd') + mass_ = 144.24_real32 + charge_ = 60.0_real32 + radius_ = 1.64_real32 + case('Pm') + mass_ = 145.0_real32 + charge_ = 61.0_real32 + radius_ = 1.63_real32 + case('Sm') + mass_ = 150.36_real32 + charge_ = 62.0_real32 + radius_ = 1.62_real32 + case('Eu') + mass_ = 152.0_real32 + charge_ = 63.0_real32 + radius_ = 1.85_real32 + case('Gd') + mass_ = 157.25_real32 + charge_ = 64.0_real32 + radius_ = 1.61_real32 + case('Tb') + mass_ = 158.93_real32 + charge_ = 65.0_real32 + radius_ = 1.59_real32 + case('Dy') + mass_ = 162.5_real32 + charge_ = 66.0_real32 + radius_ = 1.59_real32 + case('Ho') + mass_ = 164.93_real32 + charge_ = 67.0_real32 + radius_ = 1.58_real32 + case('Er') + mass_ = 167.26_real32 + charge_ = 68.0_real32 + radius_ = 1.57_real32 + case('Tm') + mass_ = 168.93_real32 + charge_ = 69.0_real32 + radius_ = 1.56_real32 + case('Yb') + mass_ = 173.05_real32 + charge_ = 70.0_real32 + radius_ = 1.74_real32 + case('Lu') + mass_ = 174.97_real32 + charge_ = 71.0_real32 + radius_ = 1.56_real32 + case('Hf') + mass_ = 178.49_real32 + charge_ = 72.0_real32 + radius_ = 1.44_real32 + case('Ta') + mass_ = 180.95_real32 + charge_ = 73.0_real32 + radius_ = 1.34_real32 + case('W') + mass_ = 183.84_real32 + charge_ = 74.0_real32 + radius_ = 1.3_real32 + case('Re') + mass_ = 186.21_real32 + charge_ = 75.0_real32 + radius_ = 1.28_real32 + case('Os') + mass_ = 190.23_real32 + charge_ = 76.0_real32 + radius_ = 1.26_real32 + case('Ir') + mass_ = 192.22_real32 + charge_ = 77.0_real32 + radius_ = 1.27_real32 + case('Pt') + mass_ = 195.08_real32 + charge_ = 78.0_real32 + radius_ = 1.3_real32 + case('Au') + mass_ = 196.97_real32 + charge_ = 79.0_real32 + radius_ = 1.34_real32 + case('Hg') + mass_ = 200.59_real32 + charge_ = 80.0_real32 + radius_ = 1.49_real32 + case('Tl') + mass_ = 204.38_real32 + charge_ = 81.0_real32 + radius_ = 1.48_real32 + case('Pb') + mass_ = 207.2_real32 + charge_ = 82.0_real32 + radius_ = 1.47_real32 + case('Bi') + mass_ = 208.98_real32 + charge_ = 83.0_real32 + radius_ = 1.46_real32 + case('Po') + mass_ = 209.0_real32 + charge_ = 84.0_real32 + radius_ = 1.45_real32 + case('At') + mass_ = 210.0_real32 + charge_ = 85.0_real32 + radius_ = 1.44_real32 + case('Rn') + mass_ = 222.0_real32 + charge_ = 86.0_real32 + radius_ = 1.43_real32 + case('Fr') + mass_ = 223.0_real32 + charge_ = 87.0_real32 + radius_ = 2.6_real32 + case('Ra') + mass_ = 226.0_real32 + charge_ = 88.0_real32 + radius_ = 2.21_real32 + case('Ac') + mass_ = 227.0_real32 + charge_ = 89.0_real32 + radius_ = 1.86_real32 + case('Th') + mass_ = 232.04_real32 + charge_ = 90.0_real32 + radius_ = 1.75_real32 + case('Pa') + mass_ = 231.04_real32 + charge_ = 91.0_real32 + radius_ = 1.61_real32 + case('U') + mass_ = 238.03_real32 + charge_ = 92.0_real32 + radius_ = 1.58_real32 + case('Np') + mass_ = 237.0_real32 + charge_ = 93.0_real32 + radius_ = 1.55_real32 + case('Pu') + mass_ = 244.0_real32 + charge_ = 94.0_real32 + radius_ = 1.53_real32 + case('Am') + mass_ = 243.0_real32 + charge_ = 95.0_real32 + radius_ = 1.51_real32 + case('Cm') + mass_ = 247.0_real32 + charge_ = 96.0_real32 + radius_ = 1.69_real32 + case('Bk') + mass_ = 247.0_real32 + charge_ = 97.0_real32 + radius_ = 1.48_real32 + case('Cf') + mass_ = 251.0_real32 + charge_ = 98.0_real32 + radius_ = 1.47_real32 + case('Es') + mass_ = 252.0_real32 + charge_ = 99.0_real32 + radius_ = 1.46_real32 + case('Fm') + mass_ = 257.0_real32 + charge_ = 100.0_real32 + radius_ = 1.45_real32 + case('Md') + mass_ = 258.0_real32 + charge_ = 101.0_real32 + radius_ = 1.44_real32 + case('No') + mass_ = 259.0_real32 + charge_ = 102.0_real32 + radius_ = 1.43_real32 + case('Lr') + mass_ = 262.0_real32 + charge_ = 103.0_real32 + radius_ = 1.62_real32 + case('Rf') + mass_ = 267.0_real32 + charge_ = 104.0_real32 + radius_ = 1.57_real32 + case('Db') + mass_ = 270.0_real32 + charge_ = 105.0_real32 + radius_ = 1.49_real32 + case('Sg') + mass_ = 271.0_real32 + charge_ = 106.0_real32 + radius_ = 1.43_real32 + case('Bh') + mass_ = 270.0_real32 + charge_ = 107.0_real32 + radius_ = 1.41_real32 + case('Hs') + mass_ = 277.0_real32 + charge_ = 108.0_real32 + radius_ = 1.34_real32 + case('Mt') + mass_ = 276.0_real32 + charge_ = 109.0_real32 + radius_ = 1.29_real32 + case('Ds') + mass_ = 281.0_real32 + charge_ = 110.0_real32 + radius_ = 1.28_real32 + case('Rg') + mass_ = 280.0_real32 + charge_ = 111.0_real32 + radius_ = 1.21_real32 + case('Cn') + mass_ = 285.0_real32 + charge_ = 112.0_real32 + radius_ = 1.22_real32 + case('Nh') + mass_ = 284.0_real32 + charge_ = 113.0_real32 + radius_ = 1.21_real32 + case('Fl') + mass_ = 289.0_real32 + charge_ = 114.0_real32 + radius_ = 1.21_real32 + case('Mc') + mass_ = 288.0_real32 + charge_ = 115.0_real32 + radius_ = 1.21_real32 + case('Lv') + mass_ = 293.0_real32 + charge_ = 116.0_real32 + radius_ = 1.21_real32 + case('Ts') + mass_ = 294.0_real32 + charge_ = 117.0_real32 + radius_ = 1.21_real32 + case('Og') + mass_ = 294.0_real32 + charge_ = 118.0_real32 + radius_ = 1.21_real32 + case default + ! handle unknown element + mass_ = 0.0_real32 + charge_ = 0.0_real32 + radius_ = 0.0_real32 + end select + + !--------------------------------------------------------------------------- + ! Return the values + !--------------------------------------------------------------------------- + if(present(mass)) mass = mass_ + if(present(charge)) charge = charge_ + if(present(radius)) radius = radius_ + + end subroutine get_element_properties +!############################################################################### + -end module rw_geom +end module artemis__geom_rw diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 6e6d682..8e77862 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -20,20 +20,20 @@ !!! print_terminations (prints the terminations to individual files) !!!############################################################################# module mod_sym - use constants, only: pi - use misc, only: sort1D,sort2D,sort_col,set + use artemis__constants, only: real32, pi + use artemis__misc, only: sort1D,sort2D,sort_col,set + use artemis__io_utils, only: err_abort use misc_linalg, only: modu,inverse_3x3,det,gcd,gen_group,cross,uvec - use rw_geom, only: bas_type,geom_write - use edit_geom, only: transformer,vacuumer,set_vacuum,shifter,& - clone_bas,get_closest_atom,ortho_axis,reducer,primitive_lat,get_min_dist - use io, only: err_abort + use artemis__geom_rw, only: basis_type,geom_write + use edit_geom, only: vacuumer,set_vacuum,shifter,& + get_closest_atom,ortho_axis,reducer,primitive_lat,get_min_dist implicit none integer :: ierror_sym=0 integer :: s_start=1,s_end=0 - double precision :: tol_sym=5.D-5 + real(real32) :: tol_sym=5.D-5 character(1) :: verb_sym="n" integer, allocatable, dimension(:) :: symops_compare - double precision, allocatable, dimension(:,:,:) :: savsym + real(real32), allocatable, dimension(:,:,:) :: savsym interface get_wyckoff_atoms procedure get_wyckoff_atoms_any,get_wyckoff_atoms_loc @@ -62,17 +62,17 @@ module mod_sym end type basmap_type type term_type - !double precision :: add - double precision :: hmin - double precision :: hmax + !real(real32) :: add + real(real32) :: hmin + real(real32) :: hmax integer :: natom integer :: nstep - double precision, allocatable, dimension(:) :: ladder + real(real32), allocatable, dimension(:) :: ladder end type term_type type term_arr_type integer :: nterm = 0, axis, nstep - double precision :: tol + real(real32) :: tol logical :: lmirror=.false. type(term_type), allocatable, dimension(:) :: arr end type term_arr_type @@ -95,7 +95,7 @@ module mod_sym logical :: lspace=.true. logical :: lmolec=.false. integer, allocatable, dimension(:) :: op - double precision, allocatable, dimension(:,:,:) :: sym + real(real32), allocatable, dimension(:,:,:) :: sym type(confine_type) :: confine end type sym_type @@ -128,7 +128,7 @@ module mod_sym !!!############################################################################# subroutine set_symmetry_tolerance(tolerance) implicit none - double precision, optional, intent(in) :: tolerance + real(real32), optional, intent(in) :: tolerance if(present(tolerance))then tol_sym = tolerance @@ -149,8 +149,8 @@ subroutine sym_setup(grp,lat,predefined,new_start,tolerance) type(sym_type) :: grp - double precision, dimension(3,3), intent(in) :: lat - double precision, optional, intent(in) :: tolerance + real(real32), dimension(3,3), intent(in) :: lat + real(real32), optional, intent(in) :: tolerance logical, optional, intent(in) :: predefined,new_start @@ -199,22 +199,22 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) integer :: is,isym,jsym,count,ntrans integer :: samecount,oldnpntop logical :: lpresent,lsaving,lwyckoff,ltransformed - type(bas_type) :: bas2,tfbas - double precision, dimension(3) :: diff - double precision, dimension(3,3) :: ident + type(basis_type) :: bas2,tfbas + real(real32), dimension(3) :: diff + real(real32), dimension(3,3) :: ident type(wyck_type), allocatable, dimension(:) :: wyck_check - double precision, allocatable, dimension(:,:) :: trans - double precision, allocatable, dimension(:,:,:) :: tmpsav + real(real32), allocatable, dimension(:,:) :: trans + real(real32), allocatable, dimension(:,:,:) :: tmpsav - type(bas_type), intent(in) :: bas1 + type(basis_type), intent(in) :: bas1 type(sym_type), intent(inout) :: grp integer, optional, intent(in) :: iperm logical, optional, intent(in) :: lsave,lcheck_all - type(bas_type), optional, intent(in) :: tmpbas2 + type(basis_type), optional, intent(in) :: tmpbas2 type(wyck_type), optional, intent(inout) :: wyckoff - double precision, dimension(3), optional, intent(in) :: loc - double precision, dimension(3,3), optional, intent(in) :: lat + real(real32), dimension(3), optional, intent(in) :: loc + real(real32), dimension(3,3), optional, intent(in) :: lat 204 format(4(F11.6),/,4(F11.6),/,4(F11.6),/,4(F11.6)) @@ -254,7 +254,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) !!!----------------------------------------------------------------------------- !!! initialises variables !!!----------------------------------------------------------------------------- - allocate(trans(minval(bas1%spec(:)%num+2),3)); trans = 0.D0 + allocate(trans(minval(bas1%spec(:)%num+2),3)); trans = 0._real32 allocate(tfbas%spec(bas1%nspec)) itmp1 = size(bas1%spec(1)%atom(1,:),dim=1) do is=1,bas1%nspec @@ -297,9 +297,9 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) !!! set up identity matrix as reference !!!----------------------------------------------------------------------------- ltransformed = .false. - ident = 0.D0 + ident = 0._real32 do i=1,3 - ident(i,i) = 1.D0 + ident(i,i) = 1._real32 end do @@ -322,7 +322,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) do j=1,3 tfbas%spec(ispec)%atom(iatom,j) = & tfbas%spec(ispec)%atom(iatom,j) - & - ceiling(tfbas%spec(ispec)%atom(iatom,j)-0.5D0) + ceiling(tfbas%spec(ispec)%atom(iatom,j)-0.5_real32) end do end do end do @@ -331,7 +331,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) !------------------------------------------------------------------------ count=0 spcheck: do ispec=1,bas1%nspec - diff = 0.D0 + diff = 0._real32 samecount = 0 wyck_check(itmp1)%spec(ispec)%atom = 0 atmcheck: do iatom=1,bas1%spec(ispec)%num @@ -340,8 +340,8 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) diff = tfbas%spec(ispec)%atom(iatom,1:3) - & bas2%spec(ispec)%atom(jatom,1:3) diff(:) = diff(:) - floor(diff(:)) - where((abs(diff(:)-1.D0)).lt.(tol_sym)) - diff(:)=0.D0 + where((abs(diff(:)-1._real32)).lt.(tol_sym)) + diff(:)=0._real32 end where if(sqrt(dot_product(diff,diff)).lt.tol_sym)then samecount = samecount + 1 @@ -362,7 +362,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) tmpsav(grp%nsymop,:,:) = grp%sym(isym,:,:) grp%op(grp%nsymop) = isym if(grp%nsymop.ne.0.and.lpresent) exit symloop -10 trans = 0.D0 +10 trans = 0._real32 ntrans = 0 !------------------------------------------------------------------------ ! checks if translations are valid with the current symmetry operation @@ -395,7 +395,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) diff = trans(i,1:3) - tmpsav(jsym,4,1:3) do j=1,3 diff(j) = diff(j) - floor(diff(j)) - if(diff(j).gt.0.5) diff(j) = diff(j) - 1.D0 + if(diff(j).gt.0.5) diff(j) = diff(j) - 1._real32 end do do k=1,i if(all(abs(diff-trans(k,1:3)).lt.tol_sym)) & @@ -423,9 +423,9 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) if(lsaving)then if(allocated(savsym)) deallocate(savsym) allocate(savsym(grp%nsymop,4,4)) - savsym=0.D0 + savsym=0._real32 savsym(:grp%nsymop,:,:)=tmpsav(:grp%nsymop,:,:) - savsym(:,4,4)=1.D0 + savsym(:,4,4)=1._real32 deallocate(tmpsav) end if @@ -482,13 +482,13 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) integer :: i,j,ispec,iatom,jatom,katom,itmp1 integer :: minspecloc,samecount logical :: lwyckoff - double precision, dimension(3) :: ttrans,tmpbas,diff - double precision, allocatable, dimension(:,:) :: sav_trans + real(real32), dimension(3) :: ttrans,tmpbas,diff + real(real32), allocatable, dimension(:,:) :: sav_trans integer, intent(out) :: ntrans - type(bas_type), intent(in) :: bas,tfbas + type(basis_type), intent(in) :: bas,tfbas type(confine_type), intent(in) :: confine - double precision, dimension(:,:), intent(out) :: trans + real(real32), dimension(:,:), intent(out) :: trans logical, optional, intent(in) :: transformed @@ -498,8 +498,8 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) !!!----------------------------------------------------------------------------- !!! Allocate arrays and initialise variables !!!----------------------------------------------------------------------------- - ttrans=0.D0 - trans=0.D0 + ttrans=0._real32 + trans=0._real32 samecount=0 ntrans=0 minspecloc=minloc(bas%spec(:)%num,mask=bas%spec(:)%num.ne.0,dim=1) @@ -532,7 +532,7 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) !!! ... as a translation vector for the symmetry. !!!----------------------------------------------------------------------------- trloop: do iatom=1,bas%spec(minspecloc)%num - ttrans(:)=0.D0 + ttrans(:)=0._real32 ttrans(1:3)=bas%spec(minspecloc)%atom(1,1:3)-& tfbas%spec(minspecloc)%atom(iatom,1:3) if(all(abs(ttrans(1:3)-anint(ttrans(1:3))).lt.tol_sym)) cycle trloop @@ -542,7 +542,7 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) .gt.tol_sym) cycle trloop end if itmp1 = 0 - sav_trans = 0.D0 + sav_trans = 0._real32 if(lwyckoff.and.ntrans+1.gt.size(wyck_check))then write(0,'("ERROR: error encountered in gldfnd")') write(0,'(2X,"Internal error in subroutine gldfnd in mod_sym.f90")') @@ -556,15 +556,15 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) atmcyc2: do jatom=1,bas%spec(ispec)%num itmp1 = itmp1 + 1 tmpbas(1:3) = tfbas%spec(ispec)%atom(jatom,1:3) + ttrans(1:3) - tmpbas(:) = tmpbas(:) - ceiling(tmpbas(:)-0.5D0) + tmpbas(:) = tmpbas(:) - ceiling(tmpbas(:)-0.5_real32) atmcyc3: do katom=1,bas%spec(ispec)%num !if(lwyckoff.and.& ! wyck_check(ntrans+1)%spec(ispec)%atom(katom).ne.0) & ! cycle atmcyc3 diff = tmpbas(1:3) - bas%spec(ispec)%atom(katom,1:3) do j=1,3 - diff(j) = mod((diff(j)+100.D0),1.0) - if((abs(diff(j)-1.D0)).lt.(tol_sym)) diff(j) = 0.D0 + diff(j) = mod((diff(j)+100._real32),1.0) + if((abs(diff(j)-1._real32)).lt.(tol_sym)) diff(j) = 0._real32 end do if(sqrt(dot_product(diff,diff)).lt.tol_sym)then samecount = samecount + 1 @@ -573,7 +573,7 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) sav_trans(itmp1,:) = bas%spec(ispec)%atom(katom,1:3) - & tfbas%spec(ispec)%atom(jatom,1:3) sav_trans(itmp1,:) = sav_trans(itmp1,:) - & - ceiling(sav_trans(itmp1,:)-0.5D0) + ceiling(sav_trans(itmp1,:)-0.5_real32) if(lwyckoff) & wyck_check(ntrans+1)%spec(ispec)%atom(jatom) = katom cycle atmcyc2 @@ -589,7 +589,7 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) do j=1,3 itmp1 = maxloc(abs(sav_trans(:,j)),dim=1) ttrans(j) = sav_trans(itmp1,j) - ttrans(j) = ttrans(j) - ceiling(ttrans(j)-0.5D0) + ttrans(j) = ttrans(j) - ceiling(ttrans(j)-0.5_real32) end do !!!----------------------------------------------------------------------------- !!! If axis is confined, removes all symmetries not confined to the axis plane @@ -631,148 +631,148 @@ subroutine gen_fundam_sym_matrices(grp,lat) implicit none integer :: i type(sym_type) :: grp - double precision :: cosPi3,sinPi3,mcosPi3,msinPi3 - double precision, dimension(3,3) :: inversion,invlat,tmat1 - double precision, dimension(64,3,3) :: fundam_mat - double precision, dimension(3,3), intent(in) :: lat + real(real32) :: cosPi3,sinPi3,mcosPi3,msinPi3 + real(real32), dimension(3,3) :: inversion,invlat,tmat1 + real(real32), dimension(64,3,3) :: fundam_mat + real(real32), dimension(3,3), intent(in) :: lat - cosPi3 = 0.5D0 - sinPi3 = sin(pi/3.D0) + cosPi3 = 0.5_real32 + sinPi3 = sin(pi/3._real32) mcosPi3 = -cosPi3 msinPi3 = -sinPi3 fundam_mat(1,1:3,1:3)=transpose(reshape((/& - 1.D0, 0.D0, 0.D0, 0.D0, 1.D0, 0.D0, 0.D0, 0.D0, 1.D0 /),& + 1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(2,1:3,1:3)=transpose(reshape((/& - -1.D0, 0.D0, 0.D0, 0.D0, -1.D0, 0.D0, 0.D0, 0.D0, 1.D0 /),& + -1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(3,1:3,1:3)=transpose(reshape((/& - -1.D0, 0.D0, 0.D0, 0.D0, 1.D0, 0.D0, 0.D0, 0.D0, -1.D0 /),& + -1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) fundam_mat(4,1:3,1:3)=transpose(reshape((/& - 1.D0, 0.D0, 0.D0, 0.D0, -1.D0, 0.D0, 0.D0, 0.D0, -1.D0 /),& + 1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) fundam_mat(5,1:3,1:3)=transpose(reshape((/& - 0.D0, 1.D0, 0.D0, 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, -1.D0 /),& + 0._real32, 1._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) fundam_mat(6,1:3,1:3)=transpose(reshape((/& - 0.D0, -1.D0, 0.D0, -1.D0, 0.D0, 0.D0, 0.D0, 0.D0, -1.D0 /),& + 0._real32, -1._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) fundam_mat(7,1:3,1:3)=transpose(reshape((/& - 0.D0, -1.D0, 0.D0, 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0 /),& + 0._real32, -1._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(8,1:3,1:3)=transpose(reshape((/& - 0.D0, 1.D0, 0.D0, -1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0 /),& + 0._real32, 1._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(9,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, 1.D0, 0.D0, -1.D0, 0.D0, 1.D0, 0.D0, 0.D0 /),& + 0._real32, 0._real32, 1._real32, 0._real32, -1._real32, 0._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(10,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, -1.D0, 0.D0, -1.D0, 0.D0, -1.D0, 0.D0, 0.D0 /),& + 0._real32, 0._real32, -1._real32, 0._real32, -1._real32, 0._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(11,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, -1.D0, 0.D0, 1.D0, 0.D0, 1.D0, 0.D0, 0.D0 /),& + 0._real32, 0._real32, -1._real32, 0._real32, 1._real32, 0._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(12,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, 1.D0, 0.D0, 1.D0, 0.D0, -1.D0, 0.D0, 0.D0 /),& + 0._real32, 0._real32, 1._real32, 0._real32, 1._real32, 0._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(13,1:3,1:3)=transpose(reshape((/& - -1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0, 0.D0, 1.D0, 0.D0 /),& + -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) fundam_mat(14,1:3,1:3)=transpose(reshape((/& - -1.D0, 0.D0, 0.D0, 0.D0, 0.D0, -1.D0, 0.D0, -1.D0, 0.D0 /),& + -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, -1._real32, 0._real32 /),& shape(inversion))) fundam_mat(15,1:3,1:3)=transpose(reshape((/& - 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, -1.D0, 0.D0, 1.D0, 0.D0 /),& + 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) fundam_mat(16,1:3,1:3)=transpose(reshape((/& - 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0, 0.D0, -1.D0, 0.D0/),& + 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, -1._real32, 0._real32/),& shape(inversion))) fundam_mat(17,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, 1.D0, 1.D0, 0.D0, 0.D0, 0.D0, 1.D0, 0.D0 /),& + 0._real32, 0._real32, 1._real32, 1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) fundam_mat(18,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, -1.D0, -1.D0, 0.D0, 0.D0, 0.D0, 1.D0, 0.D0 /),& + 0._real32, 0._real32, -1._real32, -1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) fundam_mat(19,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, -1.D0, 1.D0, 0.D0, 0.D0, 0.D0, -1.D0, 0.D0 /),& + 0._real32, 0._real32, -1._real32, 1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32 /),& shape(inversion))) fundam_mat(20,1:3,1:3)=transpose(reshape((/& - 0.D0, 0.D0, 1.D0, -1.D0, 0.D0, 0.D0, 0.D0, -1.D0, 0.D0 /),& + 0._real32, 0._real32, 1._real32, -1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32 /),& shape(inversion))) fundam_mat(21,1:3,1:3)=transpose(reshape((/& - 0.D0, 1.D0, 0.D0, 0.D0, 0.D0, 1.D0, 1.D0, 0.D0, 0.D0 /),& + 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(22,1:3,1:3)=transpose(reshape((/& - 0.D0, -1.D0, 0.D0, 0.D0, 0.D0, -1.D0, 1.D0, 0.D0, 0.D0 /),& + 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(23,1:3,1:3)=transpose(reshape((/& - 0.D0, -1.D0, 0.D0, 0.D0, 0.D0, 1.D0, -1.D0, 0.D0, 0.D0 /),& + 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 1._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(24,1:3,1:3)=transpose(reshape((/& - 0.D0, 1.D0, 0.D0, 0.D0, 0.D0, -1.D0, -1.D0, 0.D0, 0.D0 /),& + 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, -1._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) fundam_mat(25,1:3,1:3)=transpose(reshape((/& - cosPi3, sinPi3, 0.D0, msinPi3, cosPi3, 0.D0, 0.D0, 0.D0, 1.D0 /),& + cosPi3, sinPi3, 0._real32, msinPi3, cosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(26,1:3,1:3)=transpose(reshape((/& - cosPi3, msinPi3, 0.D0, sinPi3, cosPi3, 0.D0, 0.D0, 0.D0, 1.D0 /),& + cosPi3, msinPi3, 0._real32, sinPi3, cosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(27,1:3,1:3)=transpose(reshape((/& - mcosPi3, sinPi3, 0.D0, msinPi3, mcosPi3, 0.D0, 0.D0, 0.D0, 1.D0 /),& + mcosPi3, sinPi3, 0._real32, msinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(28,1:3,1:3)=transpose(reshape((/& - mcosPi3, msinPi3, 0.D0, sinPi3, mcosPi3, 0.D0, 0.D0, 0.D0, 1.D0 /),& + mcosPi3, msinPi3, 0._real32, sinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) fundam_mat(29,1:3,1:3)=transpose(reshape((/& - cosPi3, msinPi3, 0.D0, msinPi3, mcosPi3, 0.D0, 0.D0, 0.D0, -1.D0 /),& + cosPi3, msinPi3, 0._real32, msinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) fundam_mat(30,1:3,1:3)=transpose(reshape((/& - cosPi3, sinPi3, 0.D0, sinPi3, mcosPi3, 0.D0, 0.D0, 0.D0, -1.D0 /),& + cosPi3, sinPi3, 0._real32, sinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) fundam_mat(31,1:3,1:3)=transpose(reshape((/& - mcosPi3, msinPi3, 0.D0, msinPi3, cosPi3, 0.D0, 0.D0, 0.D0, -1.D0 /),& + mcosPi3, msinPi3, 0._real32, msinPi3, cosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) fundam_mat(32,1:3,1:3)=transpose(reshape((/& - mcosPi3, sinPi3, 0.D0, sinPi3, cosPi3, 0.D0, 0.D0, 0.D0, -1.D0 /),& + mcosPi3, sinPi3, 0._real32, sinPi3, cosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) inversion(:3,:3)=transpose(reshape((/& - -1.D0, 0.D0, 0.D0, 0.D0, -1.D0, 0.D0, 0.D0, 0.D0, -1.D0 /),& + -1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) @@ -788,7 +788,7 @@ subroutine gen_fundam_sym_matrices(grp,lat) tmat1=matmul(tmat1,(invlat)) !! ensure that the matrix preserves size of 1 !! this is likely redundant - if(abs(abs(det(tmat1))-1.D0).gt.tol_sym) cycle + if(abs(abs(det(tmat1))-1._real32).gt.tol_sym) cycle if(all(abs(tmat1-nint(tmat1)).le.tol_sym))then grp%nsym=grp%nsym+1 fundam_mat(grp%nsym,:,:)=fundam_mat(i,:,:) @@ -797,8 +797,8 @@ subroutine gen_fundam_sym_matrices(grp,lat) allocate(grp%sym(grp%nsym,4,4)) - grp%sym(:,:,:)=0.D0 - grp%sym(:,4,4)=1.D0 + grp%sym(:,:,:)=0._real32 + grp%sym(:,4,4)=1._real32 grp%sym(:grp%nsym,:3,:3)=fundam_mat(:grp%nsym,:3,:3) grp%nlatsym=grp%nsym @@ -819,10 +819,10 @@ subroutine mksym(grp,inlat) implicit none integer :: amin,bmin,cmin integer :: i,j,ia,ib,ic,n,count,irot,nrot,isym,jsym - double precision :: tht,a,b,c + real(real32) :: tht,a,b,c type(sym_type) :: grp - double precision, dimension(3,3) :: rotmat,refmat,inlat,lat,invlat,tmat1 - double precision, allocatable, dimension(:,:,:) :: tsym1,tsym2 + real(real32), dimension(3,3) :: rotmat,refmat,inlat,lat,invlat,tmat1 + real(real32), allocatable, dimension(:,:,:) :: tsym1,tsym2 logical, dimension(3) :: laxis @@ -838,8 +838,8 @@ subroutine mksym(grp,inlat) !!!----------------------------------------------------------------------------- lat=inlat if(grp%lmolec)then - invlat=0.D0 - lat=0.D0 + invlat=0._real32 + lat=0._real32 else invlat=inverse_3x3(lat) end if @@ -849,8 +849,8 @@ subroutine mksym(grp,inlat) !!! initialise values and symmetry matrix !!!----------------------------------------------------------------------------- allocate(tsym1(50000,4,4)) - tsym1=0.D0 - tsym1(:,4,4)=1.D0 + tsym1=0._real32 + tsym1(:,4,4)=1._real32 count=0 @@ -861,17 +861,17 @@ subroutine mksym(grp,inlat) mksyml: do n=1,10 count=count+1 if(n.gt.6)then - tht = -2.D0*pi/real(n-4) !=2*pi/(n-4) + tht = -2._real32*pi/real(n-4) !=2*pi/(n-4) else - tht = 2.D0*pi/real(n) !=2*pi/n + tht = 2._real32*pi/real(n) !=2*pi/n end if tsym1(count,1:3,1:3)=transpose(reshape((/& - cos(tht) , sin(tht), 0.D0,& - -sin(tht), cos(tht), 0.D0,& - 0.D0 , 0.D0, 1.D0/), shape(rotmat))) + cos(tht) , sin(tht), 0._real32,& + -sin(tht), cos(tht), 0._real32,& + 0._real32 , 0._real32, 1._real32/), shape(rotmat))) do i=1,3 do j=1,3 - if(abs(tsym1(count,i,j)).lt.tol_sym) tsym1(count,i,j)=0.D0 + if(abs(tsym1(count,i,j)).lt.tol_sym) tsym1(count,i,j)=0._real32 end do end do end do mksyml @@ -885,14 +885,14 @@ subroutine mksym(grp,inlat) if(laxis(1))then philoop: do n=1,10 if(n.gt.6)then - tht = -2.D0*pi/real(n-4) !=2*pi/n + tht = -2._real32*pi/real(n-4) !=2*pi/n else - tht = 2.D0*pi/real(n) !=2*pi/n + tht = 2._real32*pi/real(n) !=2*pi/n end if rotmat=transpose(reshape((/& - 1.D0, 0.D0, 0.D0, & - 0.D0, cos(tht), sin(tht),& - 0.D0, -sin(tht), cos(tht)/), shape(rotmat))) + 1._real32, 0._real32, 0._real32, & + 0._real32, cos(tht), sin(tht),& + 0._real32, -sin(tht), cos(tht)/), shape(rotmat))) rot2: do irot=1,nrot count=count+1 tsym1(count,1:3,1:3)=matmul(rotmat(1:3,1:3),tsym1(irot,1:3,1:3)) @@ -908,20 +908,20 @@ subroutine mksym(grp,inlat) if(laxis(2))then psiloop: do n=1,10 if(n.gt.6)then - tht = -2.D0*pi/real(n-4) !=2*pi/n + tht = -2._real32*pi/real(n-4) !=2*pi/n else - tht = 2.D0*pi/real(n) !=2*pi/n + tht = 2._real32*pi/real(n) !=2*pi/n end if rotmat=transpose(reshape((/& - cos(tht) , 0.D0, sin(tht),& - 0.D0 , 1.D0, 0.D0, & - -sin(tht), 0.D0, cos(tht)/), shape(rotmat))) + cos(tht) , 0._real32, sin(tht),& + 0._real32 , 1._real32, 0._real32, & + -sin(tht), 0._real32, cos(tht)/), shape(rotmat))) rot3: do irot=1,nrot count=count+1 tsym1(count,1:3,1:3)=matmul(rotmat(1:3,1:3),tsym1(irot,1:3,1:3)) do i=1,3 do j=1,3 - if(abs(tsym1(count,i,j)).lt.tol_sym) tsym1(count,i,j)=0.D0 + if(abs(tsym1(count,i,j)).lt.tol_sym) tsym1(count,i,j)=0._real32 end do end do end do rot3 @@ -940,16 +940,16 @@ subroutine mksym(grp,inlat) if(laxis(3)) cmin=2 end if aloop: do ia=amin,2 - a=(-1.D0)**ia + a=(-1._real32)**ia bloop: do ib=bmin,2 - b=(-1.D0)**ib + b=(-1._real32)**ib cloop: do ic=cmin,2 - c=(-1.D0)**ic - ! if((a*b*c).ne.(-1.D0)) cycle cloop + c=(-1._real32)**ic + ! if((a*b*c).ne.(-1._real32)) cycle cloop refmat(1:3,1:3)=transpose(reshape((/& - a, 0.D0, 0.D0,& - 0.D0, b , 0.D0,& - 0.D0, 0.D0, c/), shape(rotmat))) + a, 0._real32, 0._real32,& + 0._real32, b , 0._real32,& + 0._real32, 0._real32, c/), shape(rotmat))) refloop: do irot=1,nrot count=count+1 tsym1(count,1:3,1:3)=matmul(refmat(1:3,1:3),tsym1(irot,1:3,1:3)) @@ -973,23 +973,23 @@ subroutine mksym(grp,inlat) !!! checks all made symmetries to see if they apply to the supplied lattice !!!----------------------------------------------------------------------------- allocate(tsym2(grp%nsym,4,4)) - tsym2=0.D0 - tsym2(:,4,4)=1.D0 + tsym2=0._real32 + tsym2(:,4,4)=1._real32 count=0 samecheck: do isym=1,grp%nsym tmat1=matmul((invlat),tsym1(isym,:3,:3)) tmat1=matmul(tmat1,(lat)) do i=1,3 do j=1,3 - if(abs(tmat1(i,j)).lt.tol_sym) tmat1(i,j)=0.D0 - if(abs(1.D0-abs(tmat1(i,j))).lt.tol_sym) & - tmat1(i,j)=sign(1.D0,tmat1(i,j)) + if(abs(tmat1(i,j)).lt.tol_sym) tmat1(i,j)=0._real32 + if(abs(1._real32-abs(tmat1(i,j))).lt.tol_sym) & + tmat1(i,j)=sign(1._real32,tmat1(i,j)) end do end do !!----------------------------------------------------------------------- !! Precautionary measure if(all(abs(tmat1).lt.tol_sym)) cycle samecheck - if(abs(abs(det(tmat1))-1.D0).gt.tol_sym) cycle samecheck + if(abs(abs(det(tmat1))-1._real32).gt.tol_sym) cycle samecheck !!----------------------------------------------------------------------- if(.not.all(abs(tmat1-nint(tmat1)).lt.tol_sym)) cycle samecheck do jsym=1,count @@ -1037,22 +1037,22 @@ subroutine get_primitive_cell(lat,bas) implicit none integer :: is,ia,ja,i,j,k,itmp1 integer :: ntrans,len - double precision :: scale,proj,dtmp1 + real(real32) :: scale,proj,dtmp1 type(confine_type) :: confine - double precision, dimension(3,3) :: dmat1,invlat - double precision, allocatable, dimension(:,:) :: trans,atom_store + real(real32), dimension(3,3) :: dmat1,invlat + real(real32), allocatable, dimension(:,:) :: trans,atom_store type(sym_type) :: grp - type(bas_type) :: bas,pbas - double precision, dimension(3,3) :: lat + type(basis_type) :: bas,pbas + real(real32), dimension(3,3) :: lat !!----------------------------------------------------------------------- !! Allocate and initialise !!----------------------------------------------------------------------- ntrans = 0 - dmat1=0.D0 - allocate(trans(minval(bas%spec(:)%num+2),3)); trans=0.D0 + dmat1=0._real32 + allocate(trans(minval(bas%spec(:)%num+2),3)); trans=0._real32 !!----------------------------------------------------------------------- @@ -1067,8 +1067,8 @@ subroutine get_primitive_cell(lat,bas) !!----------------------------------------------------------------------- if(ntrans.ge.1)then do i=ntrans+1,ntrans+3 - trans(i,:)=0.D0 - trans(i,i-ntrans)=1.D0 + trans(i,:)=0._real32 + trans(i,i-ntrans)=1._real32 end do ! trans=matmul(trans(1:ntrans,1:3),lat) call sort2D(trans(1:ntrans+3,:),ntrans+3) @@ -1088,7 +1088,7 @@ subroutine get_primitive_cell(lat,bas) if(dtmp1.lt.proj)then proj=dtmp1 dmat1(i,:) = trans(j,:) - trans(j,:) = 0.D0 + trans(j,:) = 0._real32 end if end do trans_loop end do @@ -1110,8 +1110,8 @@ subroutine get_primitive_cell(lat,bas) do j=1,3 bas%spec(is)%atom(ia,j)=& bas%spec(is)%atom(ia,j)-floor(bas%spec(is)%atom(ia,j)) - if(bas%spec(is)%atom(ia,j).gt.1.D0-tol_sym) & - bas%spec(is)%atom(ia,j)=0.D0 + if(bas%spec(is)%atom(ia,j).gt.1._real32-tol_sym) & + bas%spec(is)%atom(ia,j)=0._real32 end do !!----------------------------------------------------------------- !! Check for duplicates in the cell @@ -1165,7 +1165,7 @@ end subroutine get_primitive_cell subroutine symwrite (sym,symchar) implicit none integer :: i,j,nt,nr,div - double precision, dimension(4,4) :: sym + real(real32), dimension(4,4) :: sym character(1024) :: symchar character(2) :: rm,c character(1), dimension(3) :: xyz @@ -1290,17 +1290,17 @@ function get_wyckoff_atoms_loc(wyckoff,lat,bas,loc) result(wyckoff_atoms) implicit none integer :: i,is,ia,isym,imin,itmp1 integer :: nsym - double precision :: dist + real(real32) :: dist logical :: lfound_closer type(wyck_type) :: wyckoff_atoms - double precision, dimension(3) :: diff - double precision, allocatable, dimension(:) :: dists + real(real32), dimension(3) :: diff + real(real32), allocatable, dimension(:) :: dists integer, allocatable, dimension(:) :: ivtmp1 - type(bas_type), intent(in) :: bas - double precision, dimension(3), intent(in) :: loc + type(basis_type), intent(in) :: bas + real(real32), dimension(3), intent(in) :: loc type(wyck_type), dimension(:), intent(in) :: wyckoff - double precision, dimension(3,3), intent(in) :: lat + real(real32), dimension(3,3), intent(in) :: lat nsym = size(wyckoff) @@ -1313,13 +1313,13 @@ function get_wyckoff_atoms_loc(wyckoff,lat,bas,loc) result(wyckoff_atoms) allocate(dists(bas%spec(is)%num)) do ia=1,bas%spec(is)%num diff = loc - bas%spec(is)%atom(ia,:3) - diff = diff - ceiling(diff - 0.5D0) + diff = diff - ceiling(diff - 0.5_real32) dists(ia) = modu(matmul(diff,lat)) end do wyckoff_loop1: do ia=1,size(wyckoff(1)%spec(is)%atom) - dist = huge(0.D0) + dist = huge(0._real32) imin = wyckoff(1)%spec(is)%atom(ia) sym_loop1: do isym=1,nsym if(wyckoff(isym)%spec(is)%atom(ia).eq.0) cycle sym_loop1 @@ -1388,11 +1388,11 @@ function basis_map(sym,bas1,tmpbas2) result(bas_map) implicit none integer :: j,ispec,iatom,jatom,dim type(basmap_type) :: bas_map - type(bas_type) :: bas2,tfbas - double precision, dimension(3) :: diff - type(bas_type), intent(in) :: bas1 - double precision, dimension(4,4), intent(in) :: sym - type(bas_type), optional, intent(in) :: tmpbas2 + type(basis_type) :: bas2,tfbas + real(real32), dimension(3) :: diff + type(basis_type), intent(in) :: bas1 + real(real32), dimension(4,4), intent(in) :: sym + type(basis_type), optional, intent(in) :: tmpbas2 !!!----------------------------------------------------------------------------- @@ -1434,10 +1434,10 @@ function basis_map(sym,bas1,tmpbas2) result(bas_map) do j=1,3 tfbas%spec(ispec)%atom(iatom,j) = & tfbas%spec(ispec)%atom(iatom,j) - & - ceiling(tfbas%spec(ispec)%atom(iatom,j) - 0.5D0) + ceiling(tfbas%spec(ispec)%atom(iatom,j) - 0.5_real32) bas2%spec(ispec)%atom(iatom,j) = & bas2%spec(ispec)%atom(iatom,j) - & - ceiling(bas2%spec(ispec)%atom(iatom,j) - 0.5D0) + ceiling(bas2%spec(ispec)%atom(iatom,j) - 0.5_real32) end do end do end do @@ -1447,13 +1447,13 @@ function basis_map(sym,bas1,tmpbas2) result(bas_map) !!! check whether transformed basis matches original basis !!!----------------------------------------------------------------------------- spcheck2: do ispec=1,bas1%nspec - diff=0.D0 + diff=0._real32 atmcheck2: do iatom=1,bas1%spec(ispec)%num atmcyc2: do jatom=1,bas1%spec(ispec)%num if(any(bas_map%spec(ispec)%atom(:).eq.jatom)) cycle atmcyc2 diff = tfbas%spec(ispec)%atom(iatom,1:3) - & bas2%spec(ispec)%atom(jatom,1:3) - diff = diff - ceiling(diff - 0.5D0) + diff = diff - ceiling(diff - 0.5_real32) if(sqrt(dot_product(diff,diff)).lt.tol_sym)then bas_map%spec(ispec)%atom(iatom) = jatom end if @@ -1475,25 +1475,25 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te integer :: i,j,k,is,nterm,mterm,dim,ireject integer :: itmp1,itmp2,init,min_loc logical :: ludef_print,lunique,ltmp1,lmirror, break_on_fail_ - double precision :: dtmp1,tol,height,max_sep,c_along,centre + real(real32) :: dtmp1,tol,height,max_sep,c_along,centre type(sym_type) :: grp1,grp_store, grp_store_inv type(term_arr_type) :: term integer, dimension(3) :: abc=(/1,2,3/) - double precision, dimension(3) :: vec_compare,vtmp1 - double precision, dimension(3,3) :: inv_mat,ident - type(bas_type),allocatable, dimension(:) :: bas_arr,bas_arr_reject + real(real32), dimension(3) :: vec_compare,vtmp1 + real(real32), dimension(3,3) :: inv_mat,ident + type(basis_type),allocatable, dimension(:) :: bas_arr,bas_arr_reject type(term_type), allocatable, dimension(:) :: term_arr,term_arr_uniq integer, allocatable, dimension(:) :: success,tmpop integer, allocatable, dimension(:,:) :: reject_match - double precision, allocatable, dimension(:,:) :: bas_list - double precision, allocatable, dimension(:,:,:) :: tmpsym + real(real32), allocatable, dimension(:,:) :: bas_list + real(real32), allocatable, dimension(:,:,:) :: tmpsym integer, intent(in) :: axis - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in) :: lat character(len=256) :: err_msg - double precision, optional, intent(in) :: layer_sep + real(real32), optional, intent(in) :: layer_sep logical, optional, intent(in) :: lprint, break_on_fail integer, dimension(:), allocatable :: comparison_list @@ -1526,7 +1526,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te if(present(layer_sep))then tol = layer_sep else - tol = 1.D0 !!!tolerance of 1 Å for defining a layer + tol = 1._real32 !!!tolerance of 1 Å for defining a layer end if abc=cshift(abc,3-axis) @@ -1551,13 +1551,13 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te !!!----------------------------------------------------------------------------- !!! Find largest separation between atoms !!!----------------------------------------------------------------------------- - max_sep = bas_list(1,axis) - (bas_list(bas%natom,axis)-1.D0) - height = ( bas_list(1,axis) + (bas_list(bas%natom,axis)-1.D0) )/2.D0 + max_sep = bas_list(1,axis) - (bas_list(bas%natom,axis)-1._real32) + height = ( bas_list(1,axis) + (bas_list(bas%natom,axis)-1._real32) )/2._real32 do i=1,bas%natom-1 dtmp1 = bas_list(i+1,axis) - bas_list(i,axis) if(dtmp1.gt.max_sep)then max_sep = dtmp1 - height = ( bas_list(i+1,axis) + bas_list(i,axis) )/2.D0 + height = ( bas_list(i+1,axis) + bas_list(i,axis) )/2._real32 end if end do if(max_sep.lt.tol)then @@ -1570,7 +1570,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te &in the material that is greater than LAYER_SEP")') write(0,'(2X,"Writing material to ''unlayerable.vasp''")') open(13,file="unlayerable.vasp") - call geom_write(13,lat,bas) + call geom_write(13,bas) close(13) write(0,'(2X,"We suggest reducing LAYER_SEP to less than ",F6.4)') & max_sep @@ -1615,7 +1615,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te ! ).lt.tol_sym) itmp1 = minloc(bas_list(:,axis) - term_arr(nterm)%hmax, dim=1, & - mask = bas_list(:,axis) - term_arr(nterm)%hmax.gt.0.D0) + mask = bas_list(:,axis) - term_arr(nterm)%hmax.gt.0._real32) if(itmp1.gt.bas%natom.or.itmp1.le.0)then term_arr(nterm)%natom = bas%natom - min_loc + 1 exit term_loop1 @@ -1676,9 +1676,9 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te grp_store%confine%l = .false. grp_store%confine%laxis(axis) = .false. call check_sym(grp_store,bas1=bas,iperm=-1,lsave=.true.) - inv_mat = 0.D0 + inv_mat = 0._real32 do i=1,3 - inv_mat(i,i) = -1.D0 + inv_mat(i,i) = -1._real32 end do itmp1 = 0 do i=1,grp_store%nsym @@ -1709,7 +1709,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te mterm = mterm + 1 bas_arr(mterm) = bas - centre = term_arr(i)%hmin + (term_arr(i)%hmax - term_arr(i)%hmin)/2.D0 + centre = term_arr(i)%hmin + (term_arr(i)%hmax - term_arr(i)%hmin)/2._real32 call shifter(bas_arr(mterm),axis,1-centre,.true.) !if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & ! i,term_arr(i)%hmin,term_arr(i)%hmax,term_arr(i)%natom @@ -1742,7 +1742,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te term_arr_uniq(mterm) = term_arr(i) term_arr_uniq(mterm)%nstep = 1 allocate(term_arr_uniq(mterm)%ladder(nterm)) - term_arr_uniq(mterm)%ladder(:) = 0.D0 + term_arr_uniq(mterm)%ladder(:) = 0._real32 end do shift_loop1 @@ -1755,12 +1755,12 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te grp_store_inv%confine%l = .true. grp_store_inv%confine%laxis(axis) = .true. call sym_setup(grp_store_inv,lat,predefined=.false.,new_start=.true.) - itmp1 = count(abs(grp_store_inv%sym(:,3,3)+1.D0).lt.tol_sym) + itmp1 = count(abs(grp_store_inv%sym(:,3,3)+1._real32).lt.tol_sym) allocate(tmpsym(itmp1,4,4)) allocate(tmpop(itmp1)) itmp1 = 0 do i=1,grp_store_inv%nsym - if(abs(grp_store_inv%sym(i,3,3)+1.D0).lt.tol_sym)then + if(abs(grp_store_inv%sym(i,3,3)+1._real32).lt.tol_sym)then itmp1=itmp1+1 tmpsym(itmp1,:,:) = grp_store_inv%sym(i,:,:) tmpop(itmp1) = i @@ -1777,12 +1777,12 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te !!-------------------------------------------------------------------------- !! Check rejects for inverse surface termination of saved !!-------------------------------------------------------------------------- - ident = 0.D0 + ident = 0._real32 do i=1,3 - ident(i,i) = 1.D0 + ident(i,i) = 1._real32 end do - vec_compare = 0.D0 - vec_compare(axis) = -1.D0 + vec_compare = 0._real32 + vec_compare(axis) = -1._real32 allocate(success(ireject)) success=0 reject_loop1: do i=1,ireject @@ -1800,7 +1800,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te call check_sym(grp1,bas1=bas_arr_reject(j),& iperm=-1,tmpbas2=bas_arr_reject(i),lsave=.true.) if(grp1%nsymop.ne.0)then - if(abs(savsym(1,axis,axis)+1.D0).gt.tol_sym)then + if(abs(savsym(1,axis,axis)+1._real32).gt.tol_sym)then lunique = .false. itmp2 = reject_match(j,2) exit prior_check @@ -1867,7 +1867,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te reject_match(i,2) = mterm term_arr_uniq(mterm)%nstep = 1 allocate(term_arr_uniq(mterm)%ladder(ireject+1)) - term_arr_uniq(mterm)%ladder(1) = 0.D0 + term_arr_uniq(mterm)%ladder(1) = 0._real32 else term_arr_uniq(itmp2)%nstep = term_arr_uniq(itmp2)%nstep + 1 term_arr_uniq(itmp2)%ladder(term_arr_uniq(itmp2)%nstep) = & @@ -1905,7 +1905,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te mask=term_arr_uniq(:)%hmin.gt.dtmp1+tol,dim=1) if(itmp1.eq.0) then itmp1 = minloc(term_arr_uniq(:)%hmin,& - mask=term_arr_uniq(:)%hmin.gt.dtmp1+tol-1.D0,dim=1) + mask=term_arr_uniq(:)%hmin.gt.dtmp1+tol-1._real32,dim=1) end if dtmp1 = term_arr_uniq(itmp1)%hmin end do diff --git a/src/fortran/lib/mod_tools_infile.f90 b/src/fortran/lib/mod_tools_infile.f90 index ae8661b..4703f44 100644 --- a/src/fortran/lib/mod_tools_infile.f90 +++ b/src/fortran/lib/mod_tools_infile.f90 @@ -8,7 +8,7 @@ !!! val (outputs contents of string occuring after "=") !!! getline (gets the line using grep and goes back to start of line) !!! assignI (assign an integer to variable) -!!! assignD (assign a double precision to variable) +!!! assignD (assign a real(real32) to variable) !!! assignIvec (assign an arbitrary length vector of integers to variable) !!! assignDvec (assign an arbitrary length vector of DP to variable) !!! assignS (assign a string to variable) @@ -19,14 +19,15 @@ !!! cat (cat lines until user-defined end string is encountered) !!!############################################################################# module infile_tools - use misc, only: grep,icount + use artemis__constants, only: real32 + use artemis__misc, only: grep,icount implicit none interface assign - procedure assignI,assignR,assignD,assignS,assignL + procedure assignI,assignR,assignS,assignL end interface assign interface assign_vec - procedure assignIvec,assignRvec,assignDvec + procedure assignIvec,assignRvec end interface assign_vec @@ -97,13 +98,13 @@ end subroutine assignIvec !!!############################################################################# -!!! assigns a real value to variable if the line contains the right keyword +!!! assigns a DP value to variable if the line contains the right keyword !!!############################################################################# subroutine assignR(buffer,variable,found) integer :: found character(1024) :: buffer1,buffer2 character(*) :: buffer - real :: variable + real(real32) :: variable buffer1=buffer(:scan(buffer,"=")-1) if(scan("=",buffer).ne.0) buffer2=val(buffer) if(trim(adjustl(buffer2)).ne.'') then @@ -121,7 +122,7 @@ subroutine assignRvec(buffer,variable,found) integer :: found,i character(1024) :: buffer1,buffer2 character(*) :: buffer - real, dimension(:) :: variable + real(real32), dimension(:) :: variable buffer1=buffer(:scan(buffer,"=")-1) if(scan("=",buffer).ne.0) buffer2=val(buffer) if(trim(adjustl(buffer2)).ne.'') then @@ -132,42 +133,6 @@ end subroutine assignRvec !!!############################################################################# -!!!############################################################################# -!!! assigns a DP value to variable if the line contains the right keyword -!!!############################################################################# - subroutine assignD(buffer,variable,found) - integer :: found - character(1024) :: buffer1,buffer2 - character(*) :: buffer - double precision :: variable - buffer1=buffer(:scan(buffer,"=")-1) - if(scan("=",buffer).ne.0) buffer2=val(buffer) - if(trim(adjustl(buffer2)).ne.'') then - found=found+1 - read(buffer2,*) variable - end if - end subroutine assignD -!!!############################################################################# - - -!!!############################################################################# -!!! assigns a DP value to variable -!!!############################################################################# - subroutine assignDvec(buffer,variable,found) - integer :: found,i - character(1024) :: buffer1,buffer2 - character(*) :: buffer - double precision, dimension(:) :: variable - buffer1=buffer(:scan(buffer,"=")-1) - if(scan("=",buffer).ne.0) buffer2=val(buffer) - if(trim(adjustl(buffer2)).ne.'') then - found=found+1 - read(buffer2,*) (variable(i),i=1,size(variable)) - end if - end subroutine assignDvec -!!!############################################################################# - - !!!############################################################################# !!! assigns a string !!!############################################################################# @@ -219,7 +184,7 @@ end subroutine assignL function assign_list(buffer,tag_list,num) result(var) implicit none integer :: nlist,loc2,i - double precision :: var + real(real32) :: var character(len=1024) :: new_buffer integer, allocatable, dimension(:) :: loc_list integer, intent(in) :: num @@ -256,7 +221,7 @@ end function assign_list function assign_listvec(buffer,tag_list,num) result(var) implicit none integer :: nlist,loc2,i - double precision, allocatable, dimension(:) :: var + real(real32), allocatable, dimension(:) :: var character(len=1024) :: new_buffer integer, allocatable, dimension(:) :: loc_list integer, intent(in) :: num diff --git a/src/fortran/interfaces.f90 b/src/fortran/mod_generator.f90 similarity index 77% rename from src/fortran/interfaces.f90 rename to src/fortran/mod_generator.f90 index 57e3648..2794b92 100644 --- a/src/fortran/interfaces.f90 +++ b/src/fortran/mod_generator.f90 @@ -5,192 +5,352 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module artemis__generator - use io + use artemis__constants, only: real32, ierror, pi + use artemis__misc, only: to_lower,to_upper + use artemis__geom_rw, only: basis_type,geom_write + use lat_compare, only: get_best_match,latmatch_type,tol_type + use artemis__io_utils, only: err_abort + use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: uvec,modu,get_area,inverse,cross use inputs use interface_identifier, only: intf_info_type,& get_interface,get_layered_axis,gen_DON use edit_geom, only: planecutter,primitive_lat,ortho_axis,& shift_region,set_vacuum,transformer,shifter,reducer,& - get_min_bulk_bond,get_min_bond,& - clone_bas,bas_lat_merge,get_shortest_bond,bond_type,& - share_strain, normalise_basis, MATNORM + get_min_bulk_bond,get_min_bond,get_shortest_bond,bond_type,& + share_strain, MATNORM, basis_stack use mod_sym, only: term_arr_type,confine_type,gldfnd,& get_terminations,get_primitive_cell use swapping, only: rand_swapper use shifting !!! CHANGE TO SHIFTER? implicit none integer, private :: intf=0 - double precision, private, parameter :: tmp_vac = 14.D0 + real(real32), private, parameter :: tmp_vac = 14._real32 type term_list_type integer :: term - double precision :: loc + real(real32) :: loc end type term_list_type private :: term_list_type type(bulk_DON_type), dimension(2) :: bulk_DON -!!!updated 2023/02/16 + type :: artemis_generator_type + integer :: max_num_structures = 100 + integer :: match_method = 0 + integer :: max_num_matches = 5 + integer :: max_num_term = 5 + integer :: num_miller_planes = 10 + + integer :: num_shifts = 5 + integer :: shift_method = 4 + real(real32) :: bondlength_cutoff = 6._real32 + real(real32), dimension(2) :: layer_separation_cutoff = 1._real32 + + real(real32) :: tol_cart + real(real32), dimension(3) :: tol_crys + + type(tol_type) :: tolerance + + type(basis_type), dimension(:), allocatable :: term_structures_lw + type(basis_type), dimension(:), allocatable :: term_structures_up + type(basis_type), dimension(:), allocatable :: structures + contains + procedure, pass(this) :: set_tolerance + procedure, pass(this) :: gen_terminations + procedure, pass(this) :: write_terminations + end type artemis_generator_type contains -!!!############################################################################# -!!! Generates and prints terminations parallel to the supplied miller plane -!!!############################################################################# - subroutine gen_terminations(lat,bas,miller_plane,axis,directory,& - num_layers,thickness,udef_layer_sep) + +!############################################################################### + subroutine set_tolerance( & + this, & + vector_mismatch, angle_mismatch, area_mismatch, & + max_length, max_area, max_fit, max_extension, & + angle_weight, area_weight & + ) + !! Set tolerance for the best match implicit none - integer :: unit - integer :: itmp1,iterm,term_start,term_end,iterm_step - integer :: old_natom,ncells,num_layers_,ntrans - double precision :: height - character(len=1024) :: dirname,filename,pwd - logical :: ludef_surf,lignore - type(bas_type) :: tmp_bas1,tmp_bas2 - type(confine_type) :: confine - type(term_arr_type) :: term - double precision, dimension(3,3) :: tfmat,tmp_lat1,tmp_lat2 - integer, allocatable, dimension(:,:,:) :: bas_map,t1bas_map - double precision, allocatable, dimension(:,:) :: trans + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type + real(real32), intent(in), optional :: vector_mismatch + !! Tolerance for the vector mismatch + real(real32), intent(in), optional :: angle_mismatch + !! Tolerance for the angle mismatch + real(real32), intent(in), optional :: area_mismatch + !! Tolerance for the area mismatch + real(real32), intent(in), optional :: max_length + !! Maximum allowed length of a lattice vector + real(real32), intent(in), optional :: max_area + !! Maximum allowed area parallel to the surface + integer, intent(in), optional :: max_fit + !! Maximum allowed number of matches for each individial ... ???? area mapped out on a plane + integer, intent(in), optional :: max_extension + !! Maximum allowed integer extension of each lattice vector + real(real32), intent(in), optional :: angle_weight + !! Importance weighting of angle mismatch + real(real32), intent(in), optional :: area_weight + !! Importance weighting of area mismatch + + if(present(vector_mismatch)) then + this%tolerance%vec = vector_mismatch + else + this%tolerance%vec = 5._real32 + end if - integer, intent(in) :: axis - double precision, intent(in) :: thickness - type(bas_type), intent(in) :: bas + if(present(angle_mismatch)) then + this%tolerance%ang = angle_mismatch + else + this%tolerance%ang = 5._real32 + end if + + if(present(area_mismatch)) then + this%tolerance%area = area_mismatch + else + this%tolerance%area = 10._real32 + end if + + if(present(max_length)) then + this%tolerance%maxlen = max_length + else + this%tolerance%maxlen = 20._real32 + end if + + if(present(max_area)) then + this%tolerance%maxarea = max_area + else + this%tolerance%maxarea = 400._real32 + end if + + if(present(max_fit)) then + this%tolerance%maxfit = max_fit + else + this%tolerance%maxfit = 5 + end if + + if(present(max_extension)) then + this%tolerance%maxsize = max_extension + else + this%tolerance%maxsize = 5 + end if + + if(present(angle_weight)) then + this%tolerance%ang_weight = angle_weight + else + this%tolerance%ang_weight = 1._real32 + end if + + if(present(area_weight)) then + this%tolerance%area_weight = area_weight + else + this%tolerance%area_weight = 1._real32 + end if + + end subroutine set_tolerance +!############################################################################### + + +!############################################################################### + subroutine gen_terminations( & + this, basis, miller_plane, axis, num_layers, thickness & + ) + !! Generate and prints terminations parallel to the supplied miller plane + implicit none + + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type + type(basis_type), intent(in) :: basis + !! Atomic structure data integer, dimension(3), intent(in) :: miller_plane - double precision, dimension(3,3), intent(in) :: lat + !! Miller plane + integer, intent(in) :: axis + !! Axis along which to align the slab + integer, intent(in), optional :: num_layers + !! Number of layers in the slab + real(real32), intent(in), optional :: thickness + !! Thickness of the slab (in Å) + + ! Local variables + integer :: itmp1, iterm, term_start, term_end, iterm_step + !! Termination loop variables + integer :: old_natom, ncells, ntrans + !! Number of cells in the slab + integer :: num_layers_ + !! Number of layers in the slab + real(real32) :: height + !! Height of the slab + logical :: ludef_surf, lignore + !! User-defined surface + type(basis_type) :: tmp_bas1,tmp_bas2 + !! Temporary basis structures + type(confine_type) :: confine + !! Confine structure along the specified axis + type(term_arr_type) :: term + !! List of terminations + real(real32), dimension(3,3) :: tfmat + !! Transformation matrix - integer, optional, intent(in) :: num_layers - double precision, optional, intent(in) :: udef_layer_sep - character(len=*), optional, intent(in) :: directory + character(len=256) :: warn_msg + + integer, allocatable, dimension(:,:,:) :: bas_map,t1bas_map + real(real32), allocatable, dimension(:,:) :: trans !! copy lattice and basis for manipulating - call clone_bas(bas,tmp_bas1,lat,tmp_lat1) + call tmp_bas1%copy(basis) allocate(bas_map(tmp_bas1%nspec,maxval(tmp_bas1%spec(:)%num,dim=1),2)) - bas_map=-1 + bas_map = -1 write(6,'(1X,"Using supplied plane...")') - tfmat=planecutter(tmp_lat1,dble(miller_plane)) - call transformer(tmp_lat1,tmp_bas1,tfmat,bas_map) - !call err_abort_print_struc(lat,bas,"check.vasp","stop") - - !!----------------------------------------------------------------------- - !! Finds smallest thickness of the slab and increases to ... - !! ... user-defined thickness - !!----------------------------------------------------------------------- - confine%l=.false. - confine%axis=axis - confine%laxis=.false. - confine%laxis(axis)=.true. - old_natom=tmp_bas1%natom + tfmat = planecutter(tmp_bas1%lat,real(miller_plane,real32)) + call transformer(tmp_bas1,tfmat,bas_map) + !call err_abort_print_struc(bas,"check.vasp","stop") + + !--------------------------------------------------------------------------- + ! Finds smallest thickness of the slab and increases to ... + ! ... user-defined thickness + !--------------------------------------------------------------------------- + confine%l = .false. + confine%axis = axis + confine%laxis = .false. + confine%laxis(axis) = .true. + old_natom = tmp_bas1%natom if(allocated(trans)) deallocate(trans) allocate(trans(minval(tmp_bas1%spec(:)%num+2),3)) - call gldfnd(confine,tmp_bas1,tmp_bas1,trans,ntrans) - tfmat(:,:)=0.D0 - tfmat(1,1)=1.D0 - tfmat(2,2)=1.D0 + call gldfnd(confine, tmp_bas1, tmp_bas1, trans, ntrans) + tfmat(:,:) = 0._real32 + tfmat(1,1) = 1._real32 + tfmat(2,2) = 1._real32 if(ntrans.eq.0)then - tfmat(3,3)=1.D0 + tfmat(3,3)=1._real32 else itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& - mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(tmp_lat1(axis,:))) + mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(tmp_bas1%lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if - if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1.D0 - call transformer(tmp_lat1,tmp_bas1,tfmat,bas_map) - - !! get the terminations - if(present(udef_layer_sep)) then - term = get_terminations( & - tmp_lat1, tmp_bas1, axis, & - lprint = .true., layer_sep = udef_layer_sep, & - break_on_fail = lbreak_on_no_term & - ) - else - term = get_terminations( & - tmp_lat1, tmp_bas1, axis, & - lprint = .true., layer_sep = layer_sep, & - break_on_fail = lbreak_on_no_term & - ) - end if + if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 + call transformer(tmp_bas1,tfmat,bas_map) + + ! get the terminations + term = get_terminations( & + tmp_bas1%lat, tmp_bas1, axis, & + lprint = .true., layer_sep = this%layer_separation_cutoff(1), & + break_on_fail = lbreak_on_no_term & + ) if(term%nterm .eq. 0)then - write(0,'("WARNING: & - &No terminations found for Miller plane (",3(1X,I0)," )")' & - ) miller_plane + write(warn_msg, '(A,I0,1X,I0,1X,I0,A)') & + "No terminations found for Miller plane (",miller_plane,")" + call print_warning(trim(warn_msg)) return end if - !! set thickness if provided by user + ! set thickness if provided by user if(present(num_layers))then num_layers_ = num_layers else num_layers_ = 1 end if - !! make directory and change to that directory - if(present(directory))then - dirname = directory - else - dirname = "DTERMINATIONS" - end if - call system('mkdir -p '//trim(adjustl(dirname))) - call getcwd(pwd) - call chdir(dirname) - - !! determine tolerance for layer separations (termination tolerance) - !! ... this is different from layer_sep + ! determine tolerance for layer separations (termination tolerance) + ! ... this is different from layer_sep call set_layer_tol(term) - !! determine required extension and perform that - call set_slab_height(tmp_lat1,tmp_bas1,bas_map,term,lw_surf,old_natom,& + ! determine required extension and perform that + call set_slab_height(tmp_bas1%lat,tmp_bas1,bas_map,term,lw_surf,old_natom,& height,num_layers_, thickness, ncells,& term_start,term_end,iterm_step,ludef_surf,& - dirname,"lw",lignore) + "lw",lignore) - !!-------------------------------------------------------------------------- - !! Normalise lattice - !!-------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Normalise lattice + !--------------------------------------------------------------------------- if(lnorm_lat)then - call reducer(tmp_lat1,tmp_bas1) - tmp_lat1=MATNORM(tmp_lat1) + call reducer(tmp_bas1%lat,tmp_bas1) + tmp_bas1%lat = MATNORM(tmp_bas1%lat) end if - !!-------------------------------------------------------------------------- - !! loop over terminations and write them - !!-------------------------------------------------------------------------- - do iterm=term_start,term_end,iterm_step - call clone_bas(tmp_bas1,tmp_bas2,tmp_lat1,tmp_lat2) + !--------------------------------------------------------------------------- + ! loop over terminations and write them + !--------------------------------------------------------------------------- + if(.not.allocated(this%term_structures_lw))then + allocate(this%term_structures_lw(0)) + end if + do iterm = term_start, term_end, iterm_step + call tmp_bas2%copy(tmp_bas1) if(allocated(t1bas_map)) deallocate(t1bas_map) allocate(t1bas_map,source=bas_map) - call prepare_slab(tmp_lat2,tmp_bas2,bas_map,term,iterm,& + call prepare_slab(tmp_bas2%lat,tmp_bas2,bas_map,term,iterm,& num_layers_,ncells, thickness, height,ludef_surf,lw_surf(2),& "lw",lignore,lortho,vacuum) + this%term_structures_lw = [ this%term_structures_lw, tmp_bas2 ] + end do + end subroutine gen_terminations +!############################################################################### - !!----------------------------------------------------------------------- - !! Print structure - !!----------------------------------------------------------------------- - unit=100+iterm - write(filename,'("POSCAR_term",I0)') iterm - open(unit,file=trim(filename)) - call geom_write(unit,tmp_lat2,tmp_bas2) - close(unit) - end do - !! return to parent directory - call chdir(pwd) +!############################################################################### + subroutine write_terminations( & + this, directory & + ) + !! Write the generated terminations to file + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + character(len=*), intent(in) :: directory + !! Directory to write the files to + + ! Local variables + integer :: i + !! Loop variable + integer :: unit + !! File unit number + character(len=256) :: filename + !! File name for the output files - return - end subroutine gen_terminations -!!!############################################################################# + + if(trim(directory).ne."") then + call system('mkdir -p '//trim(adjustl(directory))) + end if + + if(allocated(this%term_structures_lw))then + do i = 1, size(this%term_structures_lw) + write(filename,'("POSCAR_term_lw",I0)') i + if(trim(directory).ne."") then + filename = trim(directory) // "/" // trim(filename) + end if + open(newunit=unit,file=filename) + call geom_write(unit, this%term_structures_lw(i)) + close(unit) + end do + end if + if(allocated(this%term_structures_up))then + do i = 1, size(this%term_structures_up) + write(filename,'("POSCAR_term_up",I0)') i + if(trim(directory).ne."") then + filename = trim(directory) // "/" // trim(filename) + end if + open(newunit=unit,file=filename) + call geom_write(unit, this%term_structures_up(i)) + close(unit) + end do + end if + + end subroutine write_terminations +!############################################################################### !!!############################################################################# @@ -199,19 +359,19 @@ end subroutine gen_terminations subroutine gen_interfaces_restart(lat,bas) implicit none integer :: is,ia,js,ja - double precision :: dtmp1,min_bond,min_bond1,min_bond2 - type(bas_type) :: bas + real(real32) :: dtmp1,min_bond,min_bond1,min_bond2 + type(basis_type) :: bas type(intf_info_type) :: intf - double precision, dimension(3) :: vtmp1 - double precision, dimension(3,3) :: lat + real(real32), dimension(3) :: vtmp1 + real(real32), dimension(3,3) :: lat call system('mkdir -p '//trim(adjustl(dirname))) call chdir(dirname) - min_bond1=huge(0.D0) - min_bond2=huge(0.D0) - if(any(udef_intf_loc.lt.0.D0))then + min_bond1=huge(0._real32) + min_bond2=huge(0._real32) + if(any(udef_intf_loc.lt.0._real32))then if(ludef_axis)then intf=get_interface(lat,bas,axis) else @@ -261,7 +421,7 @@ subroutine gen_interfaces_restart(lat,bas) end do atomloop1 end do specloop1 - min_bond = ( min_bond1 + min_bond2 )/2.D0 + min_bond = ( min_bond1 + min_bond2 )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond write(6,'(1X,"Trans-interfacial scaling factor:",F0.3)') c_scale call gen_shifts_and_swaps(lat,bas,intf%axis,intf%loc,min_bond,& @@ -284,28 +444,28 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) integer :: lw_layered_axis,up_layered_axis integer :: intf_start,intf_end integer :: lw_term_start,lw_term_end,up_term_start,up_term_end - double precision :: avg_min_bond - double precision :: lw_height,up_height - double precision :: dtmp1,bondlength + real(real32) :: avg_min_bond + real(real32) :: lw_height,up_height + real(real32) :: dtmp1,bondlength character(3) :: abc character(1024) :: pwd,intf_dir,dirpath,msg, filename logical :: ludef_lw_surf,ludef_up_surf,lcycle - type(bas_type) :: sbas - type(bas_type) :: inlw_bas,inup_bas - type(bas_type) :: lw_bas,up_bas,tlw_bas,tup_bas + type(basis_type) :: sbas + type(basis_type) :: inlw_bas,inup_bas + type(basis_type) :: lw_bas,up_bas,tlw_bas,tup_bas type(tol_type) :: tolerance type(confine_type) :: confine type(latmatch_type) :: SAV type(term_arr_type) :: lw_term,up_term integer, dimension(3) :: ivtmp1 - double precision, dimension(2) :: intf_loc - double precision, dimension(3) :: init_offset=[0.D0,0.D0,2.D0] - !double precision, dimension(3,3) :: mtmp1,DONup_lat - double precision, dimension(3,3) :: tfmat,slat,inlw_lat,inup_lat - double precision, dimension(3,3) :: lw_lat,up_lat,tlw_lat,tup_lat + real(real32), dimension(2) :: intf_loc + real(real32), dimension(3) :: init_offset=[0._real32,0._real32,2._real32] + !real(real32), dimension(3,3) :: mtmp1,DONup_lat + real(real32), dimension(3,3) :: tfmat,slat,inlw_lat,inup_lat + real(real32), dimension(3,3) :: lw_lat,up_lat,tlw_lat,tup_lat integer, allocatable, dimension(:,:,:) :: lw_map,t1lw_map,t2lw_map integer, allocatable, dimension(:,:,:) :: up_map,t1up_map,t2up_map - double precision, allocatable, dimension(:,:) :: trans + real(real32), allocatable, dimension(:,:) :: trans character(len=256) :: err_msg @@ -338,7 +498,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!!----------------------------------------------------------------------------- avg_min_bond = & ( get_min_bulk_bond(inlw_lat,inlw_bas) + & - get_min_bulk_bond(inup_lat,inup_bas) )/2.D0 + get_min_bulk_bond(inup_lat,inup_bas) )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond write(6,'(1X,"Trans-interfacial scaling factor: ",F0.3)') c_scale if(ishift.eq.-1) nshift=1 @@ -356,8 +516,8 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) scale_dist=.false.,& norm=.true.) do is = 1, inlw_bas%nspec - if(all(abs(bulk_DON(1)%spec(is)%atom(:,:)).lt.1.D0))then - bondlength = huge(0.D0) + if(all(abs(bulk_DON(1)%spec(is)%atom(:,:)).lt.1._real32))then + bondlength = huge(0._real32) do ia = 1, inlw_bas%spec(is)%num dtmp1 = modu(get_min_bond(inlw_lat, inlw_bas, is, ia)) if(dtmp1.lt.bondlength) bondlength = dtmp1 @@ -387,8 +547,8 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) scale_dist=.false.,& norm=.true.) do is = 1, inup_bas%nspec - if(all(abs(bulk_DON(2)%spec(is)%atom(:,:)).lt.1.D0))then - bondlength = huge(0.D0) + if(all(abs(bulk_DON(2)%spec(is)%atom(:,:)).lt.1._real32))then + bondlength = huge(0._real32) do ia = 1, inup_bas%spec(is)%num dtmp1 = modu(get_min_bond(inup_lat, inup_bas, is, ia)) if(dtmp1.lt.bondlength) bondlength = dtmp1 @@ -492,9 +652,9 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) end if if(any(lw_mplane.ne.0))then if(imatch.ne.0)then - abc="ab " - tfmat=planecutter(inlw_lat,dble(lw_mplane)) - call transformer(inlw_lat,inlw_bas,tfmat,lw_map) + abc="ab" + tfmat=planecutter(inlw_lat,real(lw_mplane,real32)) + call transformer(inlw_bas,tfmat,lw_map) SAV=get_best_match(& tolerance,& inlw_lat,inup_lat,& @@ -568,8 +728,8 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!!----------------------------------------------------------------------------- intf_loop: do ifit=intf_start,intf_end write(6,'("Fit number: ",I0)') ifit - call clone_bas(inlw_bas,lw_bas,inlw_lat,lw_lat) - call clone_bas(inup_bas,up_bas,inup_lat,up_lat) + call lw_bas%copy(inlw_bas) + call up_bas%copy(inup_bas) if(allocated(t1lw_map)) deallocate(t1lw_map) if(allocated(t1up_map)) deallocate(t1up_map) allocate(t1lw_map,source=lw_map) @@ -579,8 +739,8 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!----------------------------------------------------------------------- !! Applies the best match transformations !!----------------------------------------------------------------------- - call transformer(lw_lat,lw_bas,dble(SAV%tf1(ifit,:,:)),t1lw_map) - call transformer(up_lat,up_bas,dble(SAV%tf2(ifit,:,:)),t1up_map) + call transformer(lw_bas,real(SAV%tf1(ifit,:,:),real32),t1lw_map) + call transformer(up_bas,real(SAV%tf2(ifit,:,:),real32),t1up_map) !!----------------------------------------------------------------------- @@ -596,7 +756,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) ! ( modu(lw_lat(i,:)) )*uvec(up_lat(i,:)) !end do !mtmp1(3,:) = up_lat(3,:) - !DONup_lat = matmul(mtmp1,inverse(dble(SAV%tf2(ifit,:,:)))) + !DONup_lat = matmul(mtmp1,inverse(real(SAV%tf2(ifit,:,:),real32))) !if(ierror.eq.1)then ! write(0,*) "#####################################" ! write(0,*) "ifit", ifit @@ -612,7 +772,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) dist_max=max_bondlength,& scale_dist=.false.,& norm=.true.) - !call err_abort_print_struc(DONup_lat,inup_bas,"bulk_up_term.vasp",& + !call err_abort_print_struc(inup_bas,"bulk_up_term.vasp",& ! "",.false.) end if @@ -630,18 +790,18 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) if(allocated(trans)) deallocate(trans) allocate(trans(minval(lw_bas%spec(:)%num+2),3)) call gldfnd(confine,lw_bas,lw_bas,trans,ntrans) - tfmat(:,:)=0.D0 - tfmat(1,1)=1.D0 - tfmat(2,2)=1.D0 + tfmat(:,:)=0._real32 + tfmat(1,1)=1._real32 + tfmat(2,2)=1._real32 if(ntrans.eq.0)then - tfmat(3,3)=1.D0 + tfmat(3,3)=1._real32 else itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(lw_lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if - if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1.D0 - call transformer(lw_lat,lw_bas,tfmat,t1lw_map) + if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 + call transformer(lw_bas,tfmat,t1lw_map) !!----------------------------------------------------------------------- @@ -680,7 +840,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) call set_slab_height(lw_lat,lw_bas,t1lw_map,lw_term,lw_surf, old_natom,& lw_height,lw_num_layers, lw_thickness,lw_ncells,& lw_term_start,lw_term_end,iterm_step,ludef_lw_surf,& - intf_dir,"lw",lcycle) + "lw",lcycle) if(lcycle) cycle intf_loop @@ -693,18 +853,18 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) deallocate(trans) allocate(trans(minval(up_bas%spec(:)%num+2),3)) call gldfnd(confine,up_bas,up_bas,trans,ntrans) - tfmat(:,:)=0.D0 - tfmat(1,1)=1.D0 - tfmat(2,2)=1.D0 + tfmat(:,:)=0._real32 + tfmat(1,1)=1._real32 + tfmat(2,2)=1._real32 if(ntrans.eq.0)then - tfmat(3,3)=1.D0 + tfmat(3,3)=1._real32 else itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(lw_lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if - if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1.D0 - call transformer(up_lat,up_bas,tfmat,t1up_map) + if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 + call transformer(up_bas,tfmat,t1up_map) !!----------------------------------------------------------------------- @@ -743,7 +903,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) call set_slab_height(up_lat,up_bas,t1up_map,up_term,up_surf,old_natom,& up_height,up_num_layers, up_thickness, up_ncells,& up_term_start,up_term_end,jterm_step,ludef_up_surf,& - intf_dir,"up",lcycle) + "up",lcycle) if(lcycle) cycle intf_loop @@ -758,7 +918,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !! ... composed of all of the possible combinations of the two !!----------------------------------------------------------------------- lw_term_loop: do iterm=lw_term_start,lw_term_end,iterm_step - call clone_bas(lw_bas,tlw_bas,lw_lat,tlw_lat) + call tlw_bas%copy(lw_bas) if(allocated(t2lw_map)) deallocate(t2lw_map) allocate(t2lw_map,source=t1lw_map) !!-------------------------------------------------------------------- @@ -774,7 +934,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !! Cycles over terminations of upper material !!-------------------------------------------------------------------- up_term_loop: do jterm=up_term_start,up_term_end,jterm_step - call clone_bas(up_bas,tup_bas,up_lat,tup_lat) + call tup_bas%copy(up_bas) if(allocated(t2up_map)) deallocate(t2up_map) allocate(t2up_map,source=t1up_map) call prepare_slab(tup_lat,tup_bas,t2up_map,up_term,jterm,& @@ -824,27 +984,27 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!----------------------------------------------------------------- !! Merge the two bases and lattices and define the interface loc !!----------------------------------------------------------------- - call bas_lat_merge(& - slat,sbas,& - tlw_lat,tup_lat,& - tlw_bas,tup_bas,axis,init_offset(:),& - t2lw_map,t2up_map) - intf_loc(1) = ( modu(tlw_lat(axis,:)) + 0.5D0*init_offset(axis) - & + sbas = basis_stack(& + basis1 = tlw_bas, basis2 = tup_bas, & + axis = axis, offset = init_offset(:), & + map1 = t2lw_map, map2 = t2up_map & + ) + intf_loc(1) = ( modu(tlw_lat(axis,:)) + 0.5_real32*init_offset(axis) - & tmp_vac)/modu(slat(axis,:)) intf_loc(2) = ( modu(tlw_lat(axis,:)) + modu(tup_lat(axis,:)) + & - 1.5D0*init_offset(axis) - 2.D0*tmp_vac )/modu(slat(axis,:)) + 1.5_real32*init_offset(axis) - 2._real32*tmp_vac )/modu(slat(axis,:)) if(ierror.ge.1)then write(0,*) "interface:",intf_loc if(ierror.eq.1.and.iunique.eq.icheck_intf-1)then call chdir(intf_dir) - call err_abort_print_struc(tlw_lat,tlw_bas,"lw_term.vasp",& + call err_abort_print_struc(tlw_bas,"lw_term.vasp",& "",.false.) - call err_abort_print_struc(tup_lat,tup_bas,"up_term.vasp",& + call err_abort_print_struc(tup_bas,"up_term.vasp",& "As IPRINT = 1 and ICHECK has been set, & &code is now exiting...") elseif(ierror.eq.2.and.iunique.eq.icheck_intf-1)then call chdir(intf_dir) - call err_abort_print_struc(slat,sbas,"test_intf.vasp",& + call err_abort_print_struc(sbas,"test_intf.vasp",& "As IPRINT = 2 and ICHECK has been set, & &code is now exiting...") end if @@ -918,23 +1078,23 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& integer :: shift_unit=10 integer :: ounit,iaxis,k,l integer :: ngen_swaps,nswaps_per_cell - double precision :: dtmp1 - type(bas_type) :: tbas + real(real32) :: dtmp1 + type(basis_type) :: tbas type(bond_type) :: min_bond character(1024) :: filename,dirpath,pwd1,pwd2,msg integer, dimension(3) :: abc - double precision, dimension(2) :: intf_loc - double precision, dimension(3) :: toffset - double precision, dimension(3,3) :: tlat - type(bas_type), allocatable, dimension(:) :: bas_arr - double precision, allocatable, dimension(:,:) :: output_shifts + real(real32), dimension(2) :: intf_loc + real(real32), dimension(3) :: toffset + real(real32), dimension(3,3) :: tlat + type(basis_type), allocatable, dimension(:) :: bas_arr + real(real32), allocatable, dimension(:,:) :: output_shifts integer, intent(in) :: axis integer, intent(in) :: nshift,nswap integer, intent(in) :: ishift,iswap - double precision, intent(in) :: bond,swap_den - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in) :: lat + real(real32), intent(in) :: bond,swap_den + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in) :: lat integer, dimension(:,:,:), optional, intent(in) :: map @@ -966,7 +1126,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& if(ishift.eq.0.or.ishift.eq.1) allocate(output_shifts(nshift,3)) select case(ishift) case(1) - output_shifts(1,:3)=0.D0 + output_shifts(1,:3)=0._real32 do k=2,nshift do iaxis=1,2 call random_number(output_shifts(k,iaxis)) @@ -1045,7 +1205,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& !!! Prints each unique shift structure !!!----------------------------------------------------------------------------- shift_loop: do k=1,nshift - call clone_bas(bas,tbas,lat,tlat) + call tbas%copy(bas) toffset=output_shifts(k,:3) do iaxis=1,2 call shift_region(tbas,axis,& @@ -1054,16 +1214,16 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& end do dtmp1=modu(tlat(axis,:)) call set_vacuum(& - lat=tlat,bas=tbas,& + basis=tbas,& axis=axis,loc=maxval(intf_loc(:)),& vac=toffset(axis)) dtmp1=minval(intf_loc(:))*dtmp1/modu(tlat(axis,:)) call set_vacuum(& - lat=tlat,bas=tbas,& + basis=tbas,& axis=axis,loc=dtmp1,& vac=toffset(axis)) min_bond = get_shortest_bond(tlat,tbas) - if(min_bond%length.le.1.5D0)then + if(min_bond%length.le.1.5_real32)then write(msg,'("Smallest bond in the interface structure is\nless than 1.5 Å.")') call print_warning(trim(msg)) write(6,'(2X,"bond length: ",F9.6)') min_bond%length @@ -1094,7 +1254,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& end if write(6,'(2X,"Writing interface ",I0,"...")') intf open(unit=ounit,file=trim(adjustl(filename))) - call geom_write(ounit,tlat,tbas) + call geom_write(ounit,tbas) close(ounit) if(intf.ge.nintf) return @@ -1128,7 +1288,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& ounit=100+l write(6,'(3X,"Writing swap ",I0,"...")') l open(unit=ounit,file=trim(adjustl(filename))) - call geom_write(ounit,tlat,bas_arr(l)) + call geom_write(ounit,bas_arr(l)) close(ounit) end do deallocate(bas_arr) @@ -1173,7 +1333,7 @@ function get_term_list(term) result(list) itmp1=itmp1+1 list(itmp1)%loc = term%arr(i)%hmin+term%arr(i)%ladder(j) list(itmp1)%loc = list(itmp1)%loc - & - ceiling( list(itmp1)%loc - 1.D0 ) + ceiling( list(itmp1)%loc - 1._real32 ) list(itmp1)%term=i end do end do @@ -1199,35 +1359,34 @@ end function get_term_list subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& height, num_layers, thickness, ncells,& term_start, term_end, term_step, ludef_surf,& - intf_dir, lwup_in, lcycle) + lwup_in, lcycle) implicit none integer :: i,itmp1 - double precision :: dtmp1, slab_thickness, largest_sep + real(real32) :: dtmp1, slab_thickness, largest_sep character(2) :: lwup character(5) :: lowerupper character(1024) :: msg - double precision, dimension(3,3) :: tfmat - double precision, allocatable, dimension(:) :: vtmp1 + real(real32), dimension(3,3) :: tfmat + real(real32), allocatable, dimension(:) :: vtmp1 type(term_list_type), allocatable, dimension(:) :: list integer, intent(in) :: num_layers, old_natom integer, intent(inout) :: term_start, term_end, ncells integer, intent(out) :: term_step - double precision, intent(in) :: thickness - double precision, intent(out) :: height + real(real32), intent(in) :: thickness + real(real32), intent(out) :: height character(2), intent(in) :: lwup_in - character(1024), intent(in) :: intf_dir logical, intent(inout) :: ludef_surf logical, intent(out) :: lcycle - type(bas_type), intent(inout) :: bas + type(basis_type), intent(inout) :: bas type(term_arr_type), intent(inout) :: term integer, dimension(2), intent(in) :: surf - double precision, dimension(3,3), intent(inout) :: lat + real(real32), dimension(3,3), intent(inout) :: lat integer, allocatable, dimension(:,:,:), intent(inout) :: map integer :: icell, istep, iterm - double precision :: layer_thickness + real(real32) :: layer_thickness logical :: success @@ -1239,7 +1398,7 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& if(lwup.eq."up") lowerupper="UPPER" lcycle = .false. - height = 0.D0 + height = 0._real32 !!----------------------------------------------------------------------- @@ -1271,7 +1430,7 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& height = term%arr(term_start)%hmin do i=num_layers,2,-1 vtmp1 = list(:)%loc - height - vtmp1 = vtmp1 - ceiling( vtmp1 - 1.D0 ) + vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) itmp1 = minloc( vtmp1(:), dim=1,& mask=& vtmp1(:).gt.0.and.& @@ -1279,9 +1438,9 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& height = height + vtmp1(itmp1) end do vtmp1 = list(:)%loc - height - !vtmp1 = vtmp1 - ceiling( vtmp1 - 1.D0 ) + !vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) where(vtmp1.lt.-1.D-5) - vtmp1 = vtmp1 - ceiling( vtmp1 + 1.D-5 - 1.D0 ) + vtmp1 = vtmp1 - ceiling( vtmp1 + 1.D-5 - 1._real32 ) end where itmp1 = minloc( vtmp1(:), dim=1,& mask=& @@ -1292,12 +1451,12 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& !if(.not.term%lmirror)then ! get thickness of top/surface layer dtmp1 = term%arr(surf(2))%hmax - term%arr(surf(2))%hmin - if(dtmp1.lt.-1.D-5) dtmp1 = dtmp1 + 1.D0 - height = height + dtmp1 !(1.D0 - dtmp1) + if(dtmp1.lt.-1.D-5) dtmp1 = dtmp1 + 1._real32 + height = height + dtmp1 !(1._real32 - dtmp1) !end if ncells = ceiling(height) - height = height/dble(ncells) + height = height/real(ncells,real32) end if @@ -1316,7 +1475,7 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& !!----------------------------------------------------------------------- if(.not.ludef_surf) ncells = int((num_layers-1)/term%nstep)+1 !! convert thickness, in angstroms to number of cells - if(thickness.gt.0.D0)then + if(thickness.gt.0._real32)then select case(term%axis) case(1) slab_thickness = dot_product(uvec(cross(lat(2,:),lat(3,:))), lat(1,:)) @@ -1331,8 +1490,8 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& height = 0.E0 largest_sep = abs( term%arr(surf(1))%hmin - & term%arr(surf(2))%ladder(term%nstep) - & - term%arr(surf(2))%hmax + 1.D0 ) - if(largest_sep.lt.0.D0) largest_sep = 1.D0 + largest_sep + term%arr(surf(2))%hmax + 1._real32 ) + if(largest_sep.lt.0._real32) largest_sep = 1._real32 + largest_sep ! check for all terminations that a certain step is sufficiently large to reproduce thickness cell_loop1: do icell = 0, ceiling(thickness/slab_thickness), 1 layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol @@ -1375,8 +1534,8 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& else largest_sep = abs( term%arr(1)%hmin - & term%arr(1)%ladder(term%nstep) - & - term%arr(1)%hmax + 1.D0 ) - if(largest_sep.lt.0.D0) largest_sep = 1.D0 + largest_sep + term%arr(1)%hmax + 1._real32 ) + if(largest_sep.lt.0._real32) largest_sep = 1._real32 + largest_sep ! check for all terminations that a certain step is sufficiently large to reproduce thickness cell_loop2: do icell = 0, ceiling(thickness/slab_thickness), 1 term_loop: do iterm = 1, term%nterm, 1 @@ -1396,13 +1555,13 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& end do cell_loop2 end if - height = height/dble(ncells * slab_thickness) + height = height/real(ncells * slab_thickness,real32) end if - tfmat(:,:) = 0.D0 - tfmat(1,1) = 1.D0 - tfmat(2,2) = 1.D0 + tfmat(:,:) = 0._real32 + tfmat(1,1) = 1._real32 + tfmat(2,2) = 1._real32 tfmat(3,3) = ncells - call transformer(lat,bas,tfmat,map) + call transformer(bas,tfmat,map) if(mod(real(old_natom*ncells)/real(bas%natom),1.0).gt.1.D-5)then write(0,'(1X,"ERROR: Internal error in interfaces subroutine")') write(0,'(2X,"gldfnd subroutine did not reproduce a sensible & @@ -1411,8 +1570,7 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& &I0," atoms")') & bas%natom/itmp1,old_natom if(ierror.eq.1)then - call chdir(intf_dir) - call err_abort_print_struc(lat,bas,& + call err_abort_print_struc(bas,& "broken_primitive.vasp",& "As IPRINT = 1, code is now exiting...") end if @@ -1425,9 +1583,9 @@ subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& !! Readjust termination plane locations !! ... i.e. divide all termination values by the number of cells !!----------------------------------------------------------------------- - term%arr(:)%hmin = term%arr(:)%hmin/dble(ncells) - term%arr(:)%hmax = term%arr(:)%hmax/dble(ncells) - term%tol = term%tol/dble(ncells) + term%arr(:)%hmin = term%arr(:)%hmin/real(ncells,real32) + term%arr(:)%hmax = term%arr(:)%hmax/real(ncells,real32) + term%tol = term%tol/real(ncells,real32) end subroutine set_slab_height @@ -1440,7 +1598,7 @@ end subroutine set_slab_height subroutine set_layer_tol(term) implicit none integer :: i - double precision :: dtmp1 + real(real32) :: dtmp1 type(term_arr_type), intent(inout) :: term @@ -1448,10 +1606,10 @@ subroutine set_layer_tol(term) do i=1,term%nterm if(i.eq.1)then dtmp1 = abs(term%arr(i)%hmin - & - (term%arr(term%nterm)%hmax+term%arr(i)%ladder(term%nstep)-1.D0)& - )/4.D0 + (term%arr(term%nterm)%hmax+term%arr(i)%ladder(term%nstep)-1._real32)& + )/4._real32 else - dtmp1 = abs(term%arr(i)%hmin-term%arr(i-1)%hmax)/4.D0 + dtmp1 = abs(term%arr(i)%hmin-term%arr(i-1)%hmax)/4._real32 end if if(dtmp1.lt.term%tol)then term%tol = dtmp1 @@ -1478,31 +1636,31 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes ludef_ortho, udef_vacuum) implicit none integer :: j, j_start, istep, natom_check - double precision :: vacuum, dtmp1, slab_thickness, shift_val + real(real32) :: vacuum, dtmp1, slab_thickness, shift_val character(2) :: lwup character(5) :: lowerupper character(1024) :: msg logical :: lortho integer, dimension(3) :: abc=(/1,2,3/) - double precision, dimension(3) :: surface_normal_vec - double precision, dimension(3,3) :: tfmat + real(real32), dimension(3) :: surface_normal_vec + real(real32), dimension(3,3) :: tfmat integer, allocatable, dimension(:) :: iterm_list integer, intent(in) :: iterm, udef_top_iterm, num_layers, ncells - double precision, intent(in) :: height, thickness + real(real32), intent(in) :: height, thickness character(2), intent(in) :: lwup_in logical, intent(in) :: ludef_surf logical, intent(out) :: lcycle - type(bas_type), intent(inout) :: bas + type(basis_type), intent(inout) :: bas type(term_arr_type), intent(in) :: term - double precision, dimension(3,3), intent(inout) :: lat + real(real32), dimension(3,3), intent(inout) :: lat integer, allocatable, dimension(:,:,:), intent(inout) :: map logical, optional, intent(in) :: ludef_ortho - double precision, optional, intent(in) :: udef_vacuum + real(real32), optional, intent(in) :: udef_vacuum integer :: icell, num_cells, jterm - double precision :: layer_thickness + real(real32) :: layer_thickness, ladder_adjust !!-------------------------------------------------------------------- !! Initialise variables @@ -1511,40 +1669,43 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes if(lwup.eq."lw") lowerupper="LOWER" if(lwup.eq."up") lowerupper="UPPER" lcycle = .false. - dtmp1=0.D0 - tfmat=0.D0 + dtmp1=0._real32 + tfmat=0._real32 + if(ludef_surf)then + jterm = udef_top_iterm + else + jterm = iterm + end if select case(term%axis) case(1) - surface_normal_vec = uvec(cross(lat(2,:),lat(3,:))) - slab_thickness = abs( dot_product(surface_normal_vec, lat(1,:)) ) + surface_normal_vec = uvec(cross( [ lat(2,:) ], [ lat(3,:) ])) + slab_thickness = abs( dot_product(surface_normal_vec, [ lat(1,:) ]) ) case(2) - surface_normal_vec = uvec(cross(lat(1,:),lat(3,:))) - slab_thickness = abs( dot_product(surface_normal_vec, lat(2,:)) ) + surface_normal_vec = uvec(cross( [ lat(1,:) ], [ lat(3,:) ])) + slab_thickness = abs( dot_product(surface_normal_vec, [ lat(2,:) ]) ) case(3) - surface_normal_vec = uvec(cross(lat(1,:),lat(2,:))) - slab_thickness = abs( dot_product(surface_normal_vec, lat(3,:)) ) + surface_normal_vec = uvec(cross( [ lat(1,:) ], [ lat(2,:)] )) + slab_thickness = abs( dot_product(surface_normal_vec, [ lat(3,:) ]) ) end select - if(thickness.gt.0.D0)then + if(thickness.gt.0._real32)then dtmp1 = slab_thickness / ncells * ( ncells - 1 ) istep = term%nstep num_cells = ncells - 1 - if(ludef_surf)then - jterm = udef_top_iterm - else - jterm = iterm - end if cell_loop: do icell = 0, ncells, 1 - layer_thickness = term%arr(udef_top_iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + layer_thickness = term%arr(jterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + ladder_adjust = 0._real32 step_loop: do j = 1, term%nstep - if(udef_top_iterm.lt.iterm)then + if(jterm.lt.iterm)then if(j.eq.term%nstep)then - layer_thickness = term%arr(udef_top_iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + ( 1.E0 + term%arr(udef_top_iterm)%ladder(1) - term%arr(iterm)%ladder(term%nstep) ) + layer_thickness = term%arr(jterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + ladder_adjust = 1.E0 + term%arr(jterm)%ladder(1) - term%arr(iterm)%ladder(term%nstep) else - layer_thickness = term%arr(udef_top_iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + ( term%arr(udef_top_iterm)%ladder(j+1) - term%arr(iterm)%ladder(j) ) + layer_thickness = term%arr(jterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + ladder_adjust = term%arr(jterm)%ladder(j+1) - term%arr(iterm)%ladder(j) end if end if - dtmp1 = ( icell / real(ncells) + layer_thickness ) * slab_thickness + & - term%arr(udef_top_iterm)%ladder(j) * slab_thickness / real(ncells) + dtmp1 = ( icell / real(ncells,real32) + layer_thickness ) * slab_thickness + & + ( ladder_adjust + term%arr(jterm)%ladder(j) - term%arr(iterm)%ladder(1) ) * slab_thickness / real(ncells,real32) if(dtmp1.ge.thickness)then istep = j num_cells = icell @@ -1580,7 +1741,7 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes end do iterm_list=cshift(iterm_list,iterm-1) if(ludef_surf)then - j_start = udef_top_iterm - iterm + 1 + j_start = jterm - iterm + 1 if(j_start.le.0) j_start = j_start + term%nterm j_start = j_start + 1 !+ (istep-1)*term%nterm/term%nstep else @@ -1593,9 +1754,6 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes !! Shift lower material to specified termination !!-------------------------------------------------------------------- call shifter(bas,term%axis,-term%arr(iterm)%hmin,.true.) - !open(20,file="test.vasp") - !call geom_write(20,lat,bas) - !close(20) !!-------------------------------------------------------------------- @@ -1603,7 +1761,7 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes !!-------------------------------------------------------------------- !write(0,*) "LUDEF_SURF?", ludef_surf do j=1,3 - tfmat(j,j)=1.D0 + tfmat(j,j)=1._real32 if(j.eq.term%axis)then if(ludef_surf)then tfmat(j,j) = height @@ -1618,7 +1776,7 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes !else ! tfmat(j,j) = tfmat(j,j) + (& ! term%arr(iterm)%hmax - & - ! term%arr(iterm)%hmin) + term%tol*2.D0 + ! term%arr(iterm)%hmin) + term%tol*2._real32 end if end if end do @@ -1640,7 +1798,7 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes !! ... hmin and hmax !!-------------------------------------------------------------------- shift_val = term%tol * slab_thickness / modu(lat(term%axis,:)) - call transformer(lat,bas,tfmat,map) + call transformer(bas,tfmat,map) call shifter(bas,term%axis,-shift_val/tfmat(term%axis,term%axis),.true.) @@ -1648,10 +1806,10 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes !! Check number of atoms is expected !!-------------------------------------------------------------------- if(term%nterm.gt.1.or.term%nstep.gt.1)then - do j=1,max(0,term%nstep-istep),1 + do j = 1, max(0,term%nstep-istep), 1 natom_check = natom_check - sum(term%arr(:)%natom) end do - do j=j_start,term%nterm,1 + do j = j_start, term%nterm, 1 natom_check = natom_check - term%arr(iterm_list(j))%natom end do end if @@ -1659,12 +1817,12 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes write(msg, '("NUMBER OF ATOMS IN '//to_upper(lowerupper)//' SLAB! & &Expected ",I0," but generated ",I0," instead")') & natom_check,bas%natom - if(tfmat(term%axis,term%axis).gt.1.D0)then + if(tfmat(term%axis,term%axis).gt.1._real32)then write(0,'("THE TRANSFORMATION IS GREATER THAN ONE ",F0.9)') & tfmat(term%axis,term%axis) end if !call err_abort(trim(msg),fmtd=.true.) - call err_abort_print_struc(lat,bas,lwup//"_term.vasp",& + call err_abort_print_struc(bas,lwup//"_term.vasp",& trim(msg),.true.) lcycle = .true. end if @@ -1673,9 +1831,9 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes !!-------------------------------------------------------------------- !! Apply slab_cuber to orthogonalise lower material !!-------------------------------------------------------------------- - call normalise_basis(bas,dtmp=0.9999D0,lfloor=.true.,zero_round=0.D0) - call set_vacuum(lat,bas,term%axis,1.D0-term%tol/tfmat(term%axis,term%axis),vacuum) - !call err_abort_print_struc(lat,bas,"check.vasp","stop") + call normalise_basis(bas,dtmp=0._real32,lfloor=.true.,zero_round=0._real32) + call set_vacuum(bas,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum) + !call err_abort_print_struc(bas,"check.vasp","stop") abc=cshift(abc,3-term%axis) if(lortho)then ortho_check: do j=1,2 @@ -1685,7 +1843,7 @@ subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thicknes end if end do ortho_check end if - call normalise_basis(bas,dtmp=0.9999D0,lfloor=.true.,zero_round=0.D0) + call bas%normalise(ceil_val=0.9999_real32,floor_coords=.true.,zero_round=0._real32) end subroutine prepare_slab diff --git a/src/fortran/mod_help.f90 b/src/fortran/mod_help.f90 index c7d98d7..01d4f41 100644 --- a/src/fortran/mod_help.f90 +++ b/src/fortran/mod_help.f90 @@ -1,8 +1,13 @@ module mod_help - use io + use artemis__io_utils, only: err_abort, tag_type, io_print_help implicit none - private !everything is private unless explicitly defined as public + + private + + public :: settings_help + public :: cell_edits_help + public :: interface_help ! logical, save :: ltag_present(ntags) !!!REPLACE READVAR WITH THIS @@ -113,16 +118,8 @@ module mod_help - - public :: settings_help - public :: cell_edits_help - public :: interface_help - - -!!!updated 2023/03/27 - - contains + !!!############################################################################# !!! setup settings tag descriptions !!!############################################################################# @@ -1068,6 +1065,4 @@ subroutine interface_help(unit, helpword, search) end subroutine interface_help !!!############################################################################# - - end module mod_help diff --git a/src/fortran/mod_intf_identifier.f90 b/src/fortran/mod_intf_identifier.f90 index cc9b0f2..6621ff2 100644 --- a/src/fortran/mod_intf_identifier.f90 +++ b/src/fortran/mod_intf_identifier.f90 @@ -4,11 +4,12 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module interface_identifier - use misc, only: swap_d,sort1D + use artemis__constants, only: real32 + use artemis__misc, only: swap,sort1D use misc_linalg, only: modu,simeq,get_area,uvec use misc_maths, only: gauss_array,get_turn_points,overlap_indiv_points,& running_avg,mean,median,mode - use rw_geom + use artemis__geom_rw implicit none private @@ -17,14 +18,14 @@ module interface_identifier type intf_info_type integer :: axis - double precision, dimension(2) :: loc + real(real32), dimension(2) :: loc end type intf_info_type type den_of_neigh_type - double precision, allocatable, dimension(:,:) :: atom + real(real32), allocatable, dimension(:,:) :: atom end type den_of_neigh_type type den_of_spec_type - double precision, allocatable, dimension(:,:,:) :: atom + real(real32), allocatable, dimension(:,:,:) :: atom end type den_of_spec_type @@ -47,9 +48,9 @@ function get_interface(lat,bas,axis) result(intf) implicit none integer :: nstep real :: dist_max - type(bas_type) :: bas + type(basis_type) :: bas type(intf_info_type) :: intf - double precision, dimension(3,3) :: lat + real(real32), dimension(3,3) :: lat type(den_of_spec_type), allocatable, dimension(:) :: DOS integer, optional, intent(in) :: axis @@ -67,7 +68,7 @@ function get_interface(lat,bas,axis) result(intf) intf%loc=get_intf_CAD(lat,bas,intf%axis,nstep) - if(intf%loc(1).gt.intf%loc(2)) call swap_d(intf%loc(1),intf%loc(2)) + if(intf%loc(1).gt.intf%loc(2)) call swap(intf%loc(1),intf%loc(2)) end function get_interface @@ -92,8 +93,8 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) real, optional, intent(in) :: dist_max logical, optional, intent(in) :: scale_dist,norm - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in) :: lat real, allocatable, dimension(:) :: dist_list @@ -116,7 +117,7 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) end do allocate(distance(nstep)) - rdist_max=12.D0 + rdist_max=12._real32 if(present(dist_max)) rdist_max=dist_max do i=1,nstep distance(i)=real(i)*rdist_max/real(nstep) @@ -192,10 +193,10 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) nsize = bas%natom*(2*ncell(1)+1) * (2*ncell(2)+1) * (2*ncell(3)+1) - 1 allocate(dist_list(nsize)) - gauss_tol=16.E0!38.D0 + gauss_tol=16.E0!38._real32 DON_sigma=0.5E-1 specloop1: do is=1,bas%nspec - DOS(is)%atom(:,:,:)=0.D0 + DOS(is)%atom(:,:,:)=0._real32 atomloop1: do ia=1,bas%spec(is)%num specloop2: do js=1,bas%nspec @@ -238,8 +239,8 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) end do specloop2 if(lscale_dist)then - do i=minloc(abs(distance(:)-2.D0),dim=1),nstep - !dist=abs(1.D0/distance(i))**2.D0 + do i=minloc(abs(distance(:)-2._real32),dim=1),nstep + !dist=abs(1._real32/distance(i))**2._real32 dist=exp(-abs(distance(i)-2.E0)) DOS(is)%atom(ia,:,i)=DOS(is)%atom(ia,:,i)*dist end do @@ -265,8 +266,8 @@ function gen_DON(lat,bas,dist_max,scale_dist,norm) result(DON) real, optional, intent(in) :: dist_max logical, optional, intent(in) :: scale_dist,norm - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in) :: lat if(present(scale_dist))then @@ -328,12 +329,12 @@ function gen_DONsim(DON,dist_max,cutoff,avg_mthd) result(intf_atoms) !!!----------------------------------------------------------------------------- nstep=size(DON(1)%atom(1,:)) allocate(distance(nstep)) - rdist_max=12.D0 + rdist_max=12._real32 if(present(dist_max)) rdist_max=dist_max do i=1,nstep distance(i)=real(i)*rdist_max/real(nstep) end do - rcutoff=4.D0 + rcutoff=4._real32 if(present(cutoff)) rcutoff=min(rcutoff,cutoff) cutloc=minloc(abs(distance(:)-rcutoff),dim=1) @@ -415,7 +416,7 @@ function gen_DONsim(DON,dist_max,cutoff,avg_mthd) result(intf_atoms) itmp1=i end do case(3) - maxjump=0.D0 + maxjump=0._real32 do i=2,natom if(simi(i)-simi(i-1).gt.maxjump)then maxjump = simi(i) - simi(i-1) @@ -450,7 +451,7 @@ end function gen_DONsim !!!############################################################################# ! subroutine get_intf_atoms(lat1,bas1,lat2,bas2) ! implicit none -! double precision, dimension(3,3) :: lat1,lat2 +! real(real32), dimension(3,3) :: lat1,lat2 ! integer, allocatable, dimension(:,:) :: intf_list1,intf_list2 ! ! @@ -472,10 +473,10 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) real :: rdist_max,rcutoff,power,rtmp1 real, optional, intent(in) :: dist_max,cutoff logical, optional :: lprint - type(bas_type) :: bas - double precision, dimension(3) :: dir_disim + type(basis_type) :: bas + real(real32), dimension(3) :: dir_disim real, dimension(3) :: vtmp1,vtmp2,vtmp3 - double precision, dimension(3,3) :: lat + real(real32), dimension(3,3) :: lat real, allocatable, dimension(:) :: sim_dist,distance @@ -517,7 +518,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) distloop2: do is=1,bas%nspec do ia=1,bas%spec(is)%num itmp1=0 - sim_dist=0.D0 + sim_dist=0._real32 !!----------------------------------------------------------------- !! identifies the similarity (scaled by inverse distance) ... !! ... between an atom and each other atom of the same species. @@ -533,7 +534,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) nloop3: do n=-1,1,1 vtmp2(3) = vtmp1(3) + real(n) vtmp3 = matmul(vtmp2,real(lat)) - !rtmp1=table_func(vtmp3(i),0.8D0) + !rtmp1=table_func(vtmp3(i),0.8_real32) !rtmp1=exp(-abs(vtmp3(i))*power) rtmp1=exp(-modu(vtmp3)*power) if(rtmp1.lt.1.D-3) cycle nloop3 @@ -558,7 +559,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) end do end do distloop2 - dir_disim(i)=0.D0 + dir_disim(i)=0._real32 !!----------------------------------------------------------------------- !! finds max difference between points within the cell along a direction !!----------------------------------------------------------------------- @@ -567,7 +568,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) do ja=ia+1,bas%spec(is)%num if( abs( & intf_func(i,is)%atom(ia,1) - & - intf_func(i,is)%atom(ja,1)).lt.1.D0)then + intf_func(i,is)%atom(ja,1)).lt.1._real32)then if( abs( & intf_func(i,is)%atom(ia,2) - & intf_func(i,is)%atom(ja,2)).gt.dir_disim(i) )then @@ -604,17 +605,17 @@ function get_intf_axis_CAD(lat,bas) result(axis) implicit none integer :: i,j,is,iaxis integer :: pntl,pntr,nstep - double precision :: sigma,gauss_tol,area + real(real32) :: sigma,gauss_tol,area integer, dimension(3) :: abc - double precision, dimension(3) :: vtmp1,vtmp2,axis_vec + real(real32), dimension(3) :: vtmp1,vtmp2,axis_vec real, allocatable, dimension(:) :: rangevec - double precision, allocatable, dimension(:) :: dist,multiCADD - double precision, allocatable, dimension(:,:) :: CAD,deriv - double precision, allocatable, dimension(:,:,:) :: CADD + real(real32), allocatable, dimension(:) :: dist,multiCADD + real(real32), allocatable, dimension(:,:) :: CAD,deriv + real(real32), allocatable, dimension(:,:,:) :: CADD integer :: axis - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in) :: lat @@ -623,10 +624,10 @@ function get_intf_axis_CAD(lat,bas) result(axis) !!!----------------------------------------------------------------------------- nstep=nstep_default allocate(dist(nstep)) - dist=0.D0 + dist=0._real32 - sigma=2.D0 - gauss_tol=16.D0 + sigma=2._real32 + gauss_tol=16._real32 allocate(rangevec(bas%nspec)) allocate(deriv(bas%nspec,nstep)) allocate(CAD(bas%nspec,nstep)) @@ -643,8 +644,8 @@ function get_intf_axis_CAD(lat,bas) result(axis) end do abc = cshift(abc,1,1) area = get_area(lat(abc(1),:),lat(abc(2),:)) - CAD=0.D0 - CADD=0.D0 + CAD=0._real32 + CADD=0._real32 !!-------------------------------------------------------------------------- !! set up CAD and CADD !!-------------------------------------------------------------------------- @@ -655,7 +656,7 @@ function get_intf_axis_CAD(lat,bas) result(axis) do j=-1,1,1 CAD(is,:) = CAD(is,:) + gauss_array(& dist(:),& - (bas%spec(is)%atom(:,iaxis)+dble(j))*modu(lat(iaxis,:)),& + (bas%spec(is)%atom(:,iaxis)+real(j,real32))*modu(lat(iaxis,:)),& sigma,gauss_tol,.false.) end do !!----------------------------------------------------------------------- @@ -671,12 +672,12 @@ function get_intf_axis_CAD(lat,bas) result(axis) pntl=i-1 pntr=i+1 do j=-1,1,1 - vtmp1(j+2)=dble(i+j-1)*modu(lat(iaxis,:))/nstep + vtmp1(j+2)=real(i+j-1,real32)*modu(lat(iaxis,:))/nstep end do - vtmp2=0.D0 + vtmp2=0._real32 vtmp2(2)=CAD(is,i) if(i.eq.1)then - vtmp2(1)=0.D0 + vtmp2(1)=0._real32 vtmp2(3)=CAD(is,pntr) !pntl=nstep-1 elseif(i.eq.nstep)then @@ -698,7 +699,7 @@ function get_intf_axis_CAD(lat,bas) result(axis) !!-------------------------------------------------------------------------- !! multiply the CADDs of each species into an overal CADD (multiCADD) !!-------------------------------------------------------------------------- - multiCADD=1.D0 + multiCADD=1._real32 do is=1,bas%nspec if(rangevec(is).lt.maxval(rangevec)*5.D-2) cycle multiCADD(:) = multiCADD(:)*CADD(is,:,1) @@ -729,16 +730,16 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) integer :: i,j,is integer :: pntl,pntr,nstep integer, optional, intent(in) :: num_step - type(bas_type) :: bas - double precision :: sigma, gauss_tol - double precision, dimension(2) :: intf_loc - double precision, dimension(3) :: vtmp1,vtmp2 - double precision, dimension(3,3) :: lat + type(basis_type) :: bas + real(real32) :: sigma, gauss_tol + real(real32), dimension(2) :: intf_loc + real(real32), dimension(3) :: vtmp1,vtmp2 + real(real32), dimension(3,3) :: lat integer, allocatable, dimension(:) :: ivec1 real, allocatable, dimension(:) :: rangevec - double precision, allocatable, dimension(:) :: dist,multiCADD - double precision, allocatable, dimension(:,:) :: CAD,deriv - double precision, allocatable, dimension(:,:,:) :: CADD + real(real32), allocatable, dimension(:) :: dist,multiCADD + real(real32), allocatable, dimension(:,:) :: CAD,deriv + real(real32), allocatable, dimension(:,:,:) :: CADD logical, optional :: lprint @@ -748,19 +749,19 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) nstep=nstep_default if(present(num_step)) nstep=num_step allocate(dist(nstep)) - dist=0.D0 + dist=0._real32 do i=1,nstep dist(i)=(i-1)*modu(lat(axis,:))/nstep end do - sigma=2.D0 - gauss_tol=16.D0 + sigma=2._real32 + gauss_tol=16._real32 allocate(rangevec(bas%nspec)) allocate(deriv(bas%nspec,nstep)) allocate(CAD(bas%nspec,nstep)) allocate(CADD(bas%nspec,nstep,3)) !!CADD(spec,nstep,nth order deriv) - CAD=0.D0 - CADD=0.D0 + CAD=0._real32 + CADD=0._real32 !!!----------------------------------------------------------------------------- @@ -773,7 +774,7 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) do j=-1,1,1 CAD(is,:) = CAD(is,:) + gauss_array(& dist(:),& - (bas%spec(is)%atom(:,axis)+dble(j))*modu(lat(axis,:)),& + (bas%spec(is)%atom(:,axis)+real(j,real32))*modu(lat(axis,:)),& sigma,gauss_tol,.false.) end do !!----------------------------------------------------------------------- @@ -789,12 +790,12 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) pntl=i-1 pntr=i+1 do j=-1,1,1 - vtmp1(j+2)=dble(i+j-1)*modu(lat(axis,:))/nstep + vtmp1(j+2)=real(i+j-1,real32)*modu(lat(axis,:))/nstep end do - vtmp2=0.D0 + vtmp2=0._real32 vtmp2(2)=CAD(is,i) if(i.eq.1)then - vtmp2(1)=0.D0 + vtmp2(1)=0._real32 vtmp2(3)=CAD(is,pntr) !pntl=nstep-1 elseif(i.eq.nstep)then @@ -817,7 +818,7 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) !!! multiply the CADDs of each species into an overal CADD (multiCADD) !!!----------------------------------------------------------------------------- allocate(multiCADD(nstep)) - multiCADD=1.D0 + multiCADD=1._real32 do is=1,bas%nspec if(rangevec(is).lt.maxval(rangevec)*5.D-2) cycle multiCADD(:)=multiCADD(:)*CADD(is,:,1) @@ -852,7 +853,7 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) !!! finds the turning points of the multiCADD and attributes them to ... !!! ... the two interfaces !!!----------------------------------------------------------------------------- - ivec1=get_turn_points(dble(multiCADD(:)),window=8,lperiodic=.true.) + ivec1=get_turn_points(real(multiCADD(:),real32),window=8,lperiodic=.true.) intf_loc(1)=dist(ivec1(size(ivec1))) intf_loc(2)=dist(ivec1(size(ivec1)-1)) @@ -869,22 +870,22 @@ function get_layered_axis(lat,bas,lprint) result(axis) implicit none integer :: i,is,j,nstep,diffcount,axis !integer, dimension(3) :: nturns - double precision :: sigma, gauss_tol + real(real32) :: sigma, gauss_tol logical :: udef_lprint - double precision, dimension(3) :: diff - double precision, dimension(3,2) :: minmax - double precision, allocatable, dimension(:) :: AD,dist + real(real32), dimension(3) :: diff + real(real32), dimension(3,2) :: minmax + real(real32), allocatable, dimension(:) :: AD,dist !integer, allocatable, dimension(:) :: ivec1 - type(bas_type), intent(in) :: bas - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(3,3), intent(in) :: lat logical, optional, intent(in) :: lprint !!!----------------------------------------------------------------------------- !!! initialise variables !!!----------------------------------------------------------------------------- - sigma=0.5D0 - gauss_tol=16.D0 + sigma=0.5_real32 + gauss_tol=16._real32 if(present(lprint))then udef_lprint=lprint else @@ -897,21 +898,21 @@ function get_layered_axis(lat,bas,lprint) result(axis) !!!----------------------------------------------------------------------------- axis_loop1: do i=1,3 if(allocated(dist)) deallocate(dist) - nstep=nint(modu(lat(i,:))/0.001D0) + nstep=nint(modu(lat(i,:))/0.001_real32) allocate(dist(nstep)) - dist=0.D0 + dist=0._real32 do j=1,nstep dist(j)=(j-1)*modu(lat(i,:))/nstep end do if(allocated(AD)) deallocate(AD) allocate(AD(nstep)) - AD=0.D0 + AD=0._real32 do is=1,bas%nspec do j=-1,1,1 AD(:) = AD(:) + gauss_array(& dist(:),& - (bas%spec(is)%atom(:,i)+dble(j))*modu(lat(i,:)),& + (bas%spec(is)%atom(:,i)+real(j,real32))*modu(lat(i,:)),& sigma,gauss_tol,.false.) end do end do @@ -927,7 +928,7 @@ function get_layered_axis(lat,bas,lprint) result(axis) !!! checks each axis !!!----------------------------------------------------------------------------- axis=0 - select case(count(diff.gt.huge(0.D0))) + select case(count(diff.gt.huge(0._real32))) case(1) axis=maxloc(diff(:),dim=1) if(udef_lprint) write(0,'("Found a 2D system along ",I0)') axis @@ -941,7 +942,7 @@ function get_layered_axis(lat,bas,lprint) result(axis) case default axis_loop2: do i=1,3 !!! ADD A TOLERANCE FOR 'COULD BE LAYERED' - diffcount=count(diff(i).gt.5.D0*diff(:)) + diffcount=count(diff(i).gt.5._real32*diff(:)) if(diffcount.eq.2)then axis=i exit axis_loop2 @@ -1013,16 +1014,16 @@ function gen_single_DOS(lat,bas,ispec,iatom,dist_max,weight_dist) result(DOS) integer :: nstep real :: rdist_max real :: gauss_tol,DON_sigma,dist,dist_cutoff,rtmp1 - type(bas_type) :: bas + type(basis_type) :: bas logical :: lweight real, dimension(3) :: vtmp1,vtmp2,vtmp3 real, allocatable, dimension(:) :: distance integer, intent(in) :: ispec,iatom - double precision, dimension(3,3), intent(in) :: lat + real(real32), dimension(3,3), intent(in) :: lat real, optional, intent(in) :: dist_max logical, optional, intent(in) :: weight_dist - double precision, allocatable, dimension(:,:) :: DOS + real(real32), allocatable, dimension(:,:) :: DOS real, allocatable, dimension(:) :: dist_list @@ -1032,17 +1033,17 @@ function gen_single_DOS(lat,bas,ispec,iatom,dist_max,weight_dist) result(DOS) allocate(DOS(bas%nspec,nstep)) allocate(distance(nstep)) - rdist_max=12.D0 + rdist_max=12._real32 if(present(dist_max)) rdist_max=dist_max do i=1,nstep distance(i)=real(i)*rdist_max/real(nstep) end do - gauss_tol=16.E0!38.D0 + gauss_tol=16.E0!38._real32 DON_sigma=0.5E-1 dist_cutoff=dist_max+sqrt(2*gauss_tol*DON_sigma**2) - DOS(:,:)=0.D0 + DOS(:,:)=0._real32 specloop1: do js=1,bas%nspec count1=0 dist_list = 0.0 @@ -1101,10 +1102,10 @@ end function gen_single_DOS function gen_single_DON(lat,bas,ispec,iatom,dist_max) result(DON) implicit none integer :: i,nstep - type(bas_type) :: bas - double precision, dimension(3,3) :: lat - double precision, allocatable, dimension(:) :: DON - double precision, allocatable, dimension(:,:) :: DOS + type(basis_type) :: bas + real(real32), dimension(3,3) :: lat + real(real32), allocatable, dimension(:) :: DON + real(real32), allocatable, dimension(:,:) :: DOS integer, intent(in) :: ispec,iatom real, optional, intent(in) :: dist_max diff --git a/src/fortran/mod_lat_compare.f90 b/src/fortran/mod_lat_compare.f90 index fd70ae0..5681ff6 100644 --- a/src/fortran/mod_lat_compare.f90 +++ b/src/fortran/mod_lat_compare.f90 @@ -14,10 +14,11 @@ !!! convert_n_tf1!!! endcode !!!############################################################################# module lat_compare - use constants + use artemis__constants + use artemis__misc_types, only: latmatch_type, tol_type use misc_linalg, only: cross,uvec,modu,get_area,find_tf,det,reduce_vec_gcd,& inverse_3x3,get_vec_multiple,get_frac_denom - use rw_geom, only: bas_type + use artemis__geom_rw, only: basis_type use edit_geom, only: MATNORM,planecutter implicit none integer :: ierr_compare @@ -25,25 +26,6 @@ module lat_compare logical :: lreduce=.true. integer, private :: match_method=0 - type latmatch_type - integer :: nfit - logical :: lreduced - character(1) :: abc(3)=(/'a','b','c'/) - - integer, dimension(2) :: axes - integer, allocatable, dimension(:,:,:) :: tf1,tf2 - double precision, allocatable, dimension(:,:) :: tol - double precision, dimension(3,3) :: lat1,lat2 - end type latmatch_type - - type tol_type - integer :: maxsize,maxfit,nstore - double precision :: maxlen=20.D0 - double precision :: maxarea=400.D0 - double precision :: vec,ang,area - double precision :: ang_weight = 10.D0 - double precision :: area_weight = 100.D0 - end type tol_type !!!updated 2021/11/19 @@ -59,9 +41,9 @@ function get_best_match(tol,lat1,lat2,bas1,bas2,str1,str2,lprint,ierr,plane1,pla character(3) :: str1,str2 logical :: lprint type(tol_type) :: tol - type(bas_type) :: bas1,bas2 + type(basis_type) :: bas1,bas2 type(latmatch_type) :: SAV - double precision, dimension(3,3) :: lat1,lat2 + real(real32), dimension(3,3) :: lat1,lat2 integer, optional :: ierr,imatch,nmiller integer, dimension(3), optional :: plane1,plane2 @@ -190,8 +172,8 @@ subroutine cyc_lat1(SAV,tol,ltmp) type(latmatch_type) :: SAV integer, dimension(3,3) :: tf1,tf2 integer, dimension(2,3) :: n - double precision, dimension(3,3) :: tlat1,tlat2 - double precision, allocatable, dimension(:,:,:) :: match_tfs + real(real32), dimension(3,3) :: tlat1,tlat2 + real(real32), allocatable, dimension(:,:,:) :: match_tfs logical, optional :: ltmp @@ -201,7 +183,7 @@ subroutine cyc_lat1(SAV,tol,ltmp) lprint=.false. if(present(ltmp)) lprint=ltmp allocate(match_tfs(tol%maxfit,3,3)) - match_tfs=0.D0 + match_tfs=0._real32 SAV%nfit=0 count1=0 n=0 @@ -271,11 +253,11 @@ subroutine cyc_lat1(SAV,tol,ltmp) !!! Creates transformation matrix using n array !!!----------------------------------------------------------------------------- tf1=convert_n_tf1(n,SAV%axes(1)) -! if(abs(nint(get_area(dble(tf1(1,:)),dble(tf1(2,:))))).gt.tol%area)then +! if(abs(nint(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32)))).gt.tol%area)then ! n(1,1)=n(1,1)-1 ! l1change=.true. ! cycle - if(abs(get_area(dble(tf1(1,:)),dble(tf1(2,:)))).lt.0.99D0) goto 103 + if(abs(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))).lt.0.99_real32) goto 103 ! tf1(1,:)=(/1,0,0/) @@ -375,8 +357,8 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) type(latmatch_type) :: SAV integer, dimension(3,3) :: tf1,tf2 integer, dimension(3,3) :: it1_mat,it2_mat - double precision, dimension(3,3) :: t_mat,tlat1,tlat2 - double precision, dimension(:,:,:) :: match_tfs + real(real32), dimension(3,3) :: t_mat,tlat1,tlat2 + real(real32), dimension(:,:,:) :: match_tfs select case(match_method) @@ -395,7 +377,7 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) !!! ... transformation of lat1 and the corresponding transformation of lat2. !!!----------------------------------------------------------------------------- SAV%lreduced=.false. - match_tfs(SAV%nfit+1,:,:)=find_tf((dble(tf1)),(dble(tf2))) + match_tfs(SAV%nfit+1,:,:)=find_tf((real(tf1,real32)),(real(tf2,real32))) if(any(isnan(match_tfs(SAV%nfit+1,:,:)))) goto 201 t_mat(:,:)=match_tfs(SAV%nfit+1,:,:) if(ierr_compare.ge.1) then @@ -419,7 +401,7 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) if(any(abs(t_mat(i,:)-nint(t_mat(i,:))).gt.1.D-5)) exit reduce_if it2_mat(i,:)=nint(t_mat(i,:)) do j=1,3 - if(match_tfs(SAV%nfit+1,j,i).ne.0.D0)then + if(match_tfs(SAV%nfit+1,j,i).ne.0._real32)then it1_mat(i,i)=nint(t_mat(i,j)/match_tfs(SAV%nfit+1,j,i)) exit end if @@ -427,8 +409,8 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) if(all(it2_mat(i,:).eq.0)) exit reduce_if if(it1_mat(i,i).eq.0) exit reduce_if end do - if(abs(get_area(dble(tf1(1,:)),dble(tf1(2,:)))).lt.& - abs(get_area(dble(it1_mat(1,:)),dble(it1_mat(2,:)))))& + if(abs(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))).lt.& + abs(get_area(real(it1_mat(1,:),real32),real(it1_mat(2,:),real32))))& exit reduce_if SAV%lreduced=.true. tf1=it1_mat @@ -455,10 +437,10 @@ end function cyc_lat2 function get_lat2(SAV,tlat1) result(tf) implicit none integer :: i,kmax - double precision :: dtmp,t_area,ang1,ang2,t_ang + real(real32) :: dtmp,t_area,ang1,ang2,t_ang type(latmatch_type) :: SAV integer, dimension(3,3) :: tf,it_mat - double precision, dimension(3,3) :: t_mat,t_lat,tlat1,tlat2 + real(real32), dimension(3,3) :: t_mat,t_lat,tlat1,tlat2 tf=0 @@ -473,8 +455,8 @@ function get_lat2(SAV,tlat1) result(tf) !!!----------------------------------------------------------------------------- ang1=acos(dot_product(tlat1(1,:),tlat1(2,:))/& (modu(tlat1(1,:)*modu(tlat1(2,:))))) - t_area=1000.D0 - t_ang=5.D0 + t_area=1000._real32 + t_ang=5._real32 kmax=1 if(SAV%axes(2).eq.3) kmax=3 t_lat=SAV%lat2 @@ -498,12 +480,12 @@ function get_lat2(SAV,tlat1) result(tf) t_mat=find_tf(t_lat,tlat1) it_mat=nint(t_mat) - tlat2=matmul(dble(it_mat),t_lat) + tlat2=matmul(real(it_mat,real32),t_lat) ang2=acos(dot_product(tlat2(1,:),tlat2(2,:))/& (modu(tlat2(1,:))*modu(tlat2(2,:)))) t_mat=tlat1-tlat2 dtmp=get_area(t_mat(1,:),t_mat(2,:)) - t_area=1000.D0 + t_area=1000._real32 !! SORT OUT HANDLING OF AREA COMPARISON if(dtmp.le.t_area.and.&!-1.D-8.and.& abs(ang1-ang2).lt.t_ang)then @@ -530,8 +512,8 @@ function get_lat2_alt(SAV,tol,tlat1) result(tf) type(latmatch_type) :: SAV integer, dimension(2,3) :: m integer, dimension(3,3) :: tf - double precision, dimension(3,3) :: tlat1 - double precision, dimension(3,3) :: mA,mB,S,newlat + real(real32), dimension(3,3) :: tlat1 + real(real32), dimension(3,3) :: mA,mB,S,newlat logical :: lchange @@ -549,10 +531,10 @@ function get_lat2_alt(SAV,tol,tlat1) result(tf) mB(i,j)=dot_product(SAV%lat2(i,:),SAV%lat2(j,:)) end do end do - S=1.D0 - S(:,:)=sqrt(mA(1,1))*sqrt(mA(2,2))*cos(pi/2.D0-tol%ang) + S=1._real32 + S(:,:)=sqrt(mA(1,1))*sqrt(mA(2,2))*cos(pi/2._real32-tol%ang) do i=1,3 - S(i,i)=(2.D0*tol%vec)*mA(i,i) + S(i,i)=(2._real32*tol%vec)*mA(i,i) end do @@ -627,7 +609,7 @@ function get_lat2_alt(SAV,tol,tlat1) result(tf) !!!using 1 Å as the tolerance !!! probably want smaller off, diagonal differences - if(all((abs(newlat(:2,:2)-mA(:2,:2))-S(:2,:2)).lt.0.D0))then + if(all((abs(newlat(:2,:2)-mA(:2,:2))-S(:2,:2)).lt.0._real32))then if(ierr_compare.gt.1)then write(0,*) "success" write(0,'(3(I0,1X))') tf @@ -654,14 +636,14 @@ end function get_lat2_alt function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) implicit none integer :: i,j - double precision :: ang1,ang2,t_area1,t_area2,diff + real(real32) :: ang1,ang2,t_area1,t_area2,diff logical :: la1a2,la1b2,l12,lmatch type(tol_type) :: tol type(latmatch_type) :: SAV integer, dimension(3,3) :: tf1,tf2 - double precision, dimension(2) :: mag_mat1,mag_mat2 - double precision, dimension(3) :: tvec - double precision, dimension(3,3) :: tlat1,tlat2 + real(real32), dimension(2) :: mag_mat1,mag_mat2 + real(real32), dimension(3) :: tvec + real(real32), dimension(3,3) :: tlat1,tlat2 logical, optional :: lprint @@ -689,8 +671,8 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) !!----------------------------------------------------------------------- !! Changed angles to all less than pi/2 to deal with negative vectors !!----------------------------------------------------------------------- - if(ang1.gt.pi/2.D0) ang1=pi-ang1 - if(ang2.gt.pi/2.D0) ang2=pi-ang2 + if(ang1.gt.pi/2._real32) ang1=pi-ang1 + if(ang2.gt.pi/2._real32) ang2=pi-ang2 if(ierr_compare.gt.1) write(0,*) ang1,ang2 !!----------------------------------------------------------------------- la1a2=(abs((mag_mat1(1)-mag_mat2(1))/mag_mat1(1)).lt.tol%vec.and.& @@ -720,8 +702,8 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) !! Generating unit vector c axis for both superlattices ... !! ... perpendicular to the interface plane. !!----------------------------------------------------------------------- - tf1(3,:)=nint(uvec(cross(dble(tf1(1,:)),dble(tf1(2,:))))) - tf2(3,:)=nint(uvec(cross(dble(tf2(1,:)),dble(tf2(2,:))))) + tf1(3,:)=nint(uvec(cross(real(tf1(1,:),real32),real(tf1(2,:),real32)))) + tf2(3,:)=nint(uvec(cross(real(tf2(1,:),real32),real(tf2(2,:),real32)))) !!----------------------------------------------------------------------- !! Prints the mismatches for the current successful match !!----------------------------------------------------------------------- @@ -730,17 +712,17 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) write(6,'(/,A,I0,2X,A,I0)') & "Fit number: ",SAV%nfit+1,& "Area increase: ",& - nint(get_area(dble(tf1(1,:)),dble(tf1(2,:)))) + nint(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))) write(6,'(" Transmat 1: Transmat 2:")') write(6,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc write(6,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & tf1(1,1:3),tf2(1,1:3),& tf1(2,1:3),tf2(2,1:3),& tf1(3,1:3),tf2(3,1:3) - write(6,'(" vector mismatch (%) = ",F0.9)') diff*100.D0 + write(6,'(" vector mismatch (%) = ",F0.9)') diff*100._real32 write(6,'(" angle mismatch (°) = ",F0.9)') abs(ang1-ang2)*180/pi write(6,'(" area mismatch (%) = ",F0.9)') (& - 1-abs(t_area1/t_area2))*100.D0 + 1-abs(t_area1/t_area2))*100._real32 write(6,*) "reduced:",SAV%lreduced end if end if @@ -749,27 +731,27 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) !!----------------------------------------------------------------------- best_check: do i=1,tol%nstore if(i.gt.SAV%nfit)then - SAV%tol(i,1)=diff*100.D0 + SAV%tol(i,1)=diff*100._real32 SAV%tol(i,2)=abs(ang1-ang2) - SAV%tol(i,3)=(1-abs(t_area1/t_area2))*100.D0 + SAV%tol(i,3)=(1-abs(t_area1/t_area2))*100._real32 SAV%tf1(i,:,:)=tf1(:,:) SAV%tf2(i,:,:)=tf2(:,:) exit best_check end if - if(diff*100.D0.le.SAV%tol(i,1).and.& + if(diff*100._real32.le.SAV%tol(i,1).and.& abs(ang1-ang2).le.SAV%tol(i,2).and.& - (1-abs(t_area1/t_area2))*100.D0.le.SAV%tol(i,3)) then - if(nint(get_area(dble(tf1(1,:)),dble(tf1(2,:)))).ge.& - nint(get_area(dble(SAV%tf1(i,1,:)),dble(SAV%tf1(i,2,:)))))& + (1-abs(t_area1/t_area2))*100._real32.le.SAV%tol(i,3)) then + if(nint(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))).ge.& + nint(get_area(real(SAV%tf1(i,1,:),real32),real(SAV%tf1(i,2,:),real32))))& cycle best_check do j=tol%nstore,i+1,-1 SAV%tol(j,:)=SAV%tol(j-1,:) SAV%tf1(j,:,:)=SAV%tf1(j-1,:,:) SAV%tf2(j,:,:)=SAV%tf2(j-1,:,:) end do - SAV%tol(i,1)=diff*100.D0 + SAV%tol(i,1)=diff*100._real32 SAV%tol(i,2)=abs(ang1-ang2) - SAV%tol(i,3)=(1-abs(t_area1/t_area2))*100.D0 + SAV%tol(i,3)=(1-abs(t_area1/t_area2))*100._real32 SAV%tf1(i,:,:)=tf1(:,:) SAV%tf2(i,:,:)=tf2(:,:) exit best_check @@ -790,11 +772,11 @@ end function tol_check function lat_check(SAV,tol,lat) result(lcheck) implicit none integer :: i - double precision :: ang1,ang2,tiny + real(real32) :: ang1,ang2,tiny logical :: lcheck,lmatch_aa,lmatch_ab type(tol_type) :: tol type(latmatch_type) :: SAV - double precision, dimension(3,3) :: lat,tlat + real(real32), dimension(3,3) :: lat,tlat tiny=1.D-6 @@ -807,8 +789,8 @@ function lat_check(SAV,tol,lat) result(lcheck) ang2=acos(dot_product(tlat(1,:),tlat(2,:))/(& sqrt(dot_product(tlat(1,:),tlat(1,:)))*& sqrt(dot_product(tlat(2,:),tlat(2,:))))) - if(ang1.gt.pi/2.D0) ang1=pi-ang1 - if(ang2.gt.pi/2.D0) ang2=pi-ang2 + if(ang1.gt.pi/2._real32) ang1=pi-ang1 + if(ang2.gt.pi/2._real32) ang2=pi-ang2 if(abs(ang1-ang2).lt.tiny)then lmatch_aa=& (abs(dot_product(lat(1,:),lat(1,:))-& @@ -879,7 +861,7 @@ subroutine endcode(SAV) end if write(6,'(1X,"BEST MATCH Area increase: ",I0)') & - nint(get_area(real(SAV%tf1(1,1,:),real12),real(SAV%tf1(1,2,:),real12))) + nint(get_area(real(SAV%tf1(1,1,:),real32),real(SAV%tf1(1,2,:),real32))) write(6,'(" Transmat 1: Transmat 2:")') write(6,'((/,1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & SAV%abc,SAV%abc,& @@ -904,14 +886,14 @@ end subroutine endcode !!!############################################################################# function vec_comp(S1,S1p,S2p,delta) result(match) implicit none - double precision :: ct,cp,cv,th,ph,va - double precision :: beta,pm1,alpha,pm2 - double precision :: mS1,mS1p,mS2p,tiny,md - double precision, dimension(2) :: match - double precision, dimension(3) :: S1,S1p,S2p,delta + real(real32) :: ct,cp,cv,th,ph,va + real(real32) :: beta,pm1,alpha,pm2 + real(real32) :: mS1,mS1p,mS2p,tiny,md + real(real32), dimension(2) :: match + real(real32), dimension(3) :: S1,S1p,S2p,delta - match=0.D0 + match=0._real32 tiny=1.D-8 mS1=modu(S1) mS1p=modu(S1p) @@ -926,9 +908,9 @@ function vec_comp(S1,S1p,S2p,delta) result(match) va=acos(dot_product(S1,S2p) /(mS1* mS2p)) beta=mS1*(cv-ct*cp)/(mS2p*sin(acos(ct))**2.0) - pm1=(cv-ct*cp)**2.0 - (sin(th)*sin(ph))**2.0 !- md*(sin(th)/mS1)**2.D0 - if(abs(pm1).lt.tiny.or.pm1+(md*sin(th)/mS1)**2.D0.gt.0.D0) pm1=0.D0 - pm1=mS1*sqrt(pm1)/( mS2p*(1-ct**2.D0) ) + pm1=(cv-ct*cp)**2.0 - (sin(th)*sin(ph))**2.0 !- md*(sin(th)/mS1)**2._real32 + if(abs(pm1).lt.tiny.or.pm1+(md*sin(th)/mS1)**2._real32.gt.0._real32) pm1=0._real32 + pm1=mS1*sqrt(pm1)/( mS2p*(1-ct**2._real32) ) if(abs(beta+pm1-nint(beta+pm1)).lt.& abs(beta-pm1-nint(beta-pm1)))then match(1)=beta+pm1 @@ -937,12 +919,12 @@ function vec_comp(S1,S1p,S2p,delta) result(match) end if beta=match(1) - !t_beta=beta+pm1*(-1.0)**dble(i) + !t_beta=beta+pm1*(-1.0)**real(i,real32) alpha=-( beta*mS2p*ct - mS1*cp )/mS1p - pm2=-(beta*mS2p*sin(th))**2.D0 & - -(mS1*sin(ph))**2.D0 + & - 2.D0*beta*mS1*mS2p*(cv - ct*cp) !- md - if(abs(pm2).lt.tiny.or.pm2+md**2.D0.gt.0.D0) pm2=0.D0 + pm2=-(beta*mS2p*sin(th))**2._real32 & + -(mS1*sin(ph))**2._real32 + & + 2._real32*beta*mS1*mS2p*(cv - ct*cp) !- md + if(abs(pm2).lt.tiny.or.pm2+md**2._real32.gt.0._real32) pm2=0._real32 pm2=sqrt(pm2)/mS1p @@ -971,14 +953,14 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) type(tol_type) :: tol type(pm_tol_type) :: pm_tol type(latmatch_type) :: SAV - double precision, dimension(3,3) :: tf - double precision, dimension(3,3) :: lat1,lat2 !original lattices. - double precision, dimension(3,3) :: templat1,templat2 !tmp lattices to feed into plane matching. + real(real32), dimension(3,3) :: tf + real(real32), dimension(3,3) :: lat1,lat2 !original lattices. + real(real32), dimension(3,3) :: templat1,templat2 !tmp lattices to feed into plane matching. integer :: itmp1,nsym1,nsym2 integer :: m1,m2,m3,i1,i2,i3,loc integer :: loopsize !size of the main loops integer :: i,j,num_of_transforms ! n = number of output transforms - double precision :: dtmp1 + real(real32) :: dtmp1 logical, allocatable, dimension(:) :: lvec1 integer, dimension(3,3) :: tmat1,tmat2 @@ -987,21 +969,21 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) real, dimension(3) :: rvec1, rvec2 real, dimension(3,3) :: rmat1 - double precision, allocatable, dimension(:,:,:) :: tmpsym1,tmpsym2,tmpsym - double precision, allocatable, dimension(:,:,:) :: transform1_saved,transform2_saved !The transformations output by plane cutter + real(real32), allocatable, dimension(:,:,:) :: tmpsym1,tmpsym2,tmpsym + real(real32), allocatable, dimension(:,:,:) :: transform1_saved,transform2_saved !The transformations output by plane cutter integer, allocatable, dimension(:,:,:) :: Tcellmatch_1,Tcellmatch_2 !The transformation matrices output from the cell_match program for lattices 1 and 2. - double precision, allocatable, dimension(:,:,:) :: Tsaved_1,Tsaved_2 - double precision, allocatable, dimension(:,:,:) :: big_T_1,big_T_2 ! 3x3 versions of the matrices output by cell_match - double precision, dimension(3,3) :: dummy_mat1,dummy_mat2 ! temporary matrices used when the info is stored in a tensor. - double precision, dimension(2,2) :: temp_mat1,temp_mat2 ! temporary matrices used when the info is stored in a tensor. - double precision, allocatable, dimension(:,:,:) :: comb_trans_1,comb_trans_2 !The combined transformations (planecutter output)x(cellmatch output). + real(real32), allocatable, dimension(:,:,:) :: Tsaved_1,Tsaved_2 + real(real32), allocatable, dimension(:,:,:) :: big_T_1,big_T_2 ! 3x3 versions of the matrices output by cell_match + real(real32), dimension(3,3) :: dummy_mat1,dummy_mat2 ! temporary matrices used when the info is stored in a tensor. + real(real32), dimension(2,2) :: temp_mat1,temp_mat2 ! temporary matrices used when the info is stored in a tensor. + real(real32), allocatable, dimension(:,:,:) :: comb_trans_1,comb_trans_2 !The combined transformations (planecutter output)x(cellmatch output). - double precision, allocatable, dimension(:,:) :: tolerances,saved_tolerances + real(real32), allocatable, dimension(:,:) :: tolerances,saved_tolerances integer, allocatable, dimension(:,:) :: ivtmp1,miller1,miller2 integer, dimension(3) :: ivtmp2 - type(bas_type), intent(in) :: bas1,bas2 + type(basis_type), intent(in) :: bas1,bas2 integer, intent(in) :: nmiller logical, optional, intent(in) :: lprint integer, dimension(3), optional, intent(in) :: plane1,plane2 @@ -1015,10 +997,10 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) allocate(transform2_saved(tol%nstore,3,3)) allocate(Tsaved_1(tol%nstore,2,2)) allocate(Tsaved_2(tol%nstore,2,2)) - transform1_saved = 0.D0 - transform2_saved = 0.D0 - Tsaved_1 = 0.D0 - Tsaved_2 = 0.D0 + transform1_saved = 0._real32 + transform2_saved = 0._real32 + Tsaved_1 = 0._real32 + Tsaved_2 = 0._real32 allocate(tolerances(tol%nstore,3)) allocate(saved_tolerances(tol%nstore,3)) saved_tolerances = INF @@ -1157,20 +1139,20 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !!-------------------------------------------------------------------------- allocate(tmpsym(max(grp1%nsym,grp2%nsym),3,3)) MAINLOOP1: do m1=1,size(miller1(:,1),dim=1) - transform1 = nint(planecutter(lat1,dble(miller1(m1,:)))) + transform1 = nint(planecutter(lat1,real(miller1(m1,:),real32))) if (all(transform1 .eq. 0)) cycle MAINLOOP1 templat1 = matmul(transform1,lat1) - tmpsym=0.D0 + tmpsym=0._real32 do i=1,grp1%nsym tmpsym(i,:3,:3) = & - matmul(grp1%sym(i,:3,:3),inverse_3x3(dble(transform1))) + matmul(grp1%sym(i,:3,:3),inverse_3x3(real(transform1,real32))) ! next step required to transform properly into the space? tmpsym(i,:3,:3) = & - matmul(dble(transform1),tmpsym(i,:3,:3)) + matmul(real(transform1,real32),tmpsym(i,:3,:3)) end do nsym1=0 - tmpsym1=0.D0 + tmpsym1=0._real32 !!! IS THIS REASONABLE TO DO IT THIS WAY? OR DO WE NEED TO CHANGE sym TO BE IN THE NEW LAT? !!! Wait, should it be instead that the cross product of the a-b plane is always consistent? rvec1=real(cross([templat1(1,:)],[templat1(2,:)])) @@ -1206,20 +1188,20 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) MAINLOOP2: do m2=1,size(miller2(:,1),dim=1) - transform2 = nint(planecutter(lat2,dble(miller2(m2,:)))) + transform2 = nint(planecutter(lat2,real(miller2(m2,:),real32))) if (all(transform2 .eq. 0)) cycle MAINLOOP2 templat2 = matmul(transform2,lat2) - tmpsym=0.D0 + tmpsym=0._real32 do i=1,grp2%nsym tmpsym(i,:3,:3) = & - matmul(grp2%sym(i,:3,:3),inverse_3x3(dble(transform2))) + matmul(grp2%sym(i,:3,:3),inverse_3x3(real(transform2,real32))) ! next step required to transform properly into the space? tmpsym(i,:3,:3) = & - matmul(dble(transform2),tmpsym(i,:3,:3)) + matmul(real(transform2,real32),tmpsym(i,:3,:3)) end do nsym2=0 - tmpsym2=0.D0 + tmpsym2=0._real32 do i=1,grp2%nsym !write(0,*) "################################" !write(0,*) i @@ -1257,8 +1239,8 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) loop110: do i=1,num_of_transforms IF101: if ( dot_product(tolerances(i,:),vaa_weighting).le.& dot_product(saved_tolerances(tol%nstore,:),vaa_weighting) )then - temp_mat1(:,:) = dble(Tcellmatch_1(i,:,:)) - temp_mat2(:,:) = dble(Tcellmatch_2(i,:,:)) + temp_mat1(:,:) = real(Tcellmatch_1(i,:,:),real32) + temp_mat2(:,:) = real(Tcellmatch_2(i,:,:),real32) IF102: if (.not.is_duplicate(& (Tsaved_1),(Tsaved_2),& (temp_mat1),(temp_mat2),& @@ -1266,8 +1248,8 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) saved_tolerances(tol%nstore,:) = tolerances(i,:) Tsaved_1(tol%nstore,:,:) = temp_mat1(:,:) Tsaved_2(tol%nstore,:,:) = temp_mat2(:,:) - transform1_saved(tol%nstore,:,:) = dble(transform1(:,:)) - transform2_saved(tol%nstore,:,:) = dble(transform2(:,:)) + transform1_saved(tol%nstore,:,:) = real(transform1(:,:),real32) + transform2_saved(tol%nstore,:,:) = real(transform2(:,:),real32) if(SAV%nfit.lt.tol%nstore) SAV%nfit = SAV%nfit + 1 @@ -1325,25 +1307,25 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) SAV%tol(i,:) = saved_tolerances(i,:) if_reduce: if(lreduce)then tf = find_tf(comb_trans_1(i,:,:),comb_trans_2(i,:,:)) - if(abs(abs(det(comb_trans_1(i,:,:)))-1.D0).lt.1.D-6) exit if_reduce + if(abs(abs(det(comb_trans_1(i,:,:)))-1._real32).lt.1.D-6) exit if_reduce if(ierror.eq.1)then write(0,*) i write(0,'( 3( 3(F7.3,1X), /) )') tf end if if(any( (/ (maxval(abs(reduce_vec_gcd(tf(j,:3)))),j=1,3) /)& - .eq.0.D0))then + .eq.0._real32))then exit if_reduce else tmat1(:,:) = & reshape((/ 1, 0, 0, 0, 1, 0, 0, 0, 1 /),shape(tmat1(:,:))) tmat2(:,:) = nint(tf) do j=1,3 - dtmp1=1.D0 + dtmp1=1._real32 if(any(abs(tf(j,:3)-nint(tf(j,:3))).gt.1.D-6))then dtmp1=get_vec_multiple(tf(j,:3),reduce_vec_gcd(tf(j,:3))) end if if(abs(dtmp1-nint(dtmp1)).gt.1.D-6)then - dtmp1=get_frac_denom(1.D0/dtmp1) + dtmp1=get_frac_denom(1._real32/dtmp1) end if tmat1(j,:) = tmat1(j,:3)*nint(dtmp1) tmat2(j,:) = nint(tf(j,:3)*dtmp1) @@ -1358,8 +1340,8 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) SAV%tf1(i,:,:) = nint(comb_trans_1(i,:,:)) SAV%tf2(i,:,:) = nint(comb_trans_2(i,:,:)) end do OUTLOOP - SAV%tol(:,1) = SAV%tol(:,1)*100.D0 - SAV%tol(:,3) = SAV%tol(:,3)*100.D0 + SAV%tol(:,1) = SAV%tol(:,1)*100._real32 + SAV%tol(:,3) = SAV%tol(:,3)*100._real32 write(6,*) "Total number of matches saved:",SAV%nfit @@ -1372,7 +1354,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) write(6,'(/,A,I0,2X,A,I0)') & "Fit number: ",i,& "Area increase: ",& - nint(get_area(dble(SAV%tf1(i,1,:)),dble(SAV%tf1(i,2,:)))) + nint(get_area(real(SAV%tf1(i,1,:),real32),real(SAV%tf1(i,2,:),real32))) write(6,'(" Transmat 1: Transmat 2:")') write(6,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc write(6,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & @@ -1407,16 +1389,16 @@ end subroutine lattice_matching ! function compensate_strains(tfmat,w_elastic_tensor,up_elastic_tensor) ! implicit none ! integer :: i -! double precision, dimension(3) :: strain_vec +! real(real32), dimension(3) :: strain_vec ! ! integer, intent(in) :: axis -! double precision, dimension(3,3), intent(in) :: lat1,lat2 -! double precision, dimension(6,6), intent(in) :: elastic_tensor +! real(real32), dimension(3,3), intent(in) :: lat1,lat2 +! real(real32), dimension(6,6), intent(in) :: elastic_tensor ! ! -! ident = 0.D0 +! ident = 0._real32 ! do i=1,3 -! ident(i,i) = 1.D0 +! ident(i,i) = 1._real32 ! end do ! ! do i=1,3 @@ -1448,12 +1430,12 @@ end subroutine lattice_matching ! function tester(lw_lat,up_lat,lw_tfmat,up_tfmat,lw_elastic,up_elastic) result(stress_vec) ! implicit none ! integer :: i -! double precision, dimension(6) :: strain_vec, stress_vec +! real(real32), dimension(6) :: strain_vec, stress_vec ! ! integer, intent(in) :: axis -! double precision, dimension(2,3), intent(in) :: lw_tfmat,up_tfmat -! double precision, dimension(3,3), intent(in) :: lw_lat,up_lat -! double precision, dimension(6,6), intent(in) :: lw_elastic,up_elastic +! real(real32), dimension(2,3), intent(in) :: lw_tfmat,up_tfmat +! real(real32), dimension(3,3), intent(in) :: lw_lat,up_lat +! real(real32), dimension(6,6), intent(in) :: lw_elastic,up_elastic ! ! ! ! turn lw_elastic and up_elastic into 3x3x3x3 matrices @@ -1469,18 +1451,18 @@ end subroutine lattice_matching ! lw_tflat = matmul(lw_lat,lw_tfmat) ! up_tflat = matmul(up_lat,up_tfmat) ! -! ident = 0.D0 +! ident = 0._real32 ! do i=1,3 -! ident(i,i) = 1.D0 +! ident(i,i) = 1._real32 ! end do ! ! strain_mat = matmul(lat1,inverse(lat2))-ident ! do i=1,3 ! strain_vec(i) = strain_mat(i,i) ! end do -! strain_vec(4) = 2.D0*strain_mat(2,3) -! strain_vec(5) = 2.D0*strain_mat(3,1) -! strain_vec(6) = 2.D0*strain_mat(1,2) +! strain_vec(4) = 2._real32*strain_mat(2,3) +! strain_vec(5) = 2._real32*strain_mat(3,1) +! strain_vec(6) = 2._real32*strain_mat(1,2) ! ! stress_vec = matmul(strain_vec,elastic_tensor) ! @@ -1504,25 +1486,25 @@ end subroutine lattice_matching ! function get_stress(lat1,lat2,axis,elastic_tensor) result(stress_vec) ! implicit none ! integer :: i -! double precision, dimension(6) :: strain_vec, stress_vec +! real(real32), dimension(6) :: strain_vec, stress_vec ! ! integer, intent(in) :: axis -! double precision, dimension(3,3), intent(in) :: lat1,lat2 -! double precision, dimension(6,6), intent(in) :: elastic_tensor +! real(real32), dimension(3,3), intent(in) :: lat1,lat2 +! real(real32), dimension(6,6), intent(in) :: elastic_tensor ! ! -! ident = 0.D0 +! ident = 0._real32 ! do i=1,3 -! ident(i,i) = 1.D0 +! ident(i,i) = 1._real32 ! end do ! ! strain_mat = matmul(lat1,inverse(lat2))-ident ! do i=1,3 ! strain_vec(i) = strain_mat(i,i) ! end do -! strain_vec(4) = 2.D0*strain_mat(2,3) -! strain_vec(5) = 2.D0*strain_mat(3,1) -! strain_vec(6) = 2.D0*strain_mat(1,2) +! strain_vec(4) = 2._real32*strain_mat(2,3) +! strain_vec(5) = 2._real32*strain_mat(3,1) +! strain_vec(6) = 2._real32*strain_mat(1,2) ! ! stress_vec = matmul(strain_vec,elastic_tensor) ! diff --git a/src/fortran/mod_plane_matching.f90 b/src/fortran/mod_plane_matching.f90 index 7c9c9f8..ed7be8c 100644 --- a/src/fortran/mod_plane_matching.f90 +++ b/src/fortran/mod_plane_matching.f90 @@ -4,20 +4,20 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module plane_matching - use constants + use artemis__constants, only: real32, INF, pi use misc_linalg, only: cross,modu,get_angle,get_area,find_tf,& reduce_vec_gcd,gcd implicit none !! importance of vector, angle, and area - double precision, dimension(3) :: vaa_weighting=(/1.D0,5.D0,2.5D0/) + real(real32), dimension(3) :: vaa_weighting=(/1._real32,5._real32,2.5_real32/) type :: pm_tol_type integer :: maxsize,maxfit,nstore - double precision :: maxlen=20.D0 - double precision :: maxarea=400.D0 - double precision :: vec,ang,area - double precision :: ang_weight = 10.D0 - double precision :: area_weight = 100.D0 + real(real32) :: maxlen=20._real32 + real(real32) :: maxarea=400._real32 + real(real32) :: vec,ang,area + real(real32) :: ang_weight = 10._real32 + real(real32) :: area_weight = 100._real32 end type pm_tol_type @@ -31,10 +31,10 @@ module plane_matching !!!############################################################################# subroutine datasort(list_in,tol_in) implicit none - double precision, dimension(:,:,:) :: list_in - double precision, allocatable, dimension(:,:,:) :: list_out - double precision, dimension(:) :: tol_in - double precision, allocatable, dimension(:) :: tol_out + real(real32), dimension(:,:,:) :: list_in + real(real32), allocatable, dimension(:,:,:) :: list_out + real(real32), dimension(:) :: tol_in + real(real32), allocatable, dimension(:) :: tol_out integer :: a,dummylocation,len len=size(list_in(:,1,1)) @@ -62,12 +62,12 @@ subroutine datasortmain(list_in,mat1_in,mat2_in,trans1_in,trans2_in) implicit none integer :: len integer :: a,dummylocation - double precision, dimension(:,:,:) :: mat1_in,mat2_in - double precision, allocatable, dimension(:,:,:) :: mat1_out,mat2_out - double precision, dimension(:,:,:) :: trans1_in,trans2_in - double precision, allocatable, dimension(:,:,:) :: trans1_out,trans2_out - double precision, dimension(:) :: list_in - double precision, allocatable, dimension(:) :: list_out + real(real32), dimension(:,:,:) :: mat1_in,mat2_in + real(real32), allocatable, dimension(:,:,:) :: mat1_out,mat2_out + real(real32), dimension(:,:,:) :: trans1_in,trans2_in + real(real32), allocatable, dimension(:,:,:) :: trans1_out,trans2_out + real(real32), dimension(:) :: list_in + real(real32), allocatable, dimension(:) :: list_out len = size(list_in) @@ -103,11 +103,11 @@ end subroutine datasortmain subroutine datasort_tols(list_in,tol_in) implicit none integer :: i,j,len,ntol_features - double precision, allocatable,dimension(:) :: vtmp1 - double precision, dimension(:,:,:) :: list_in - double precision, allocatable, dimension(:,:,:) :: list_out - double precision, dimension(:,:) :: tol_in - double precision, allocatable, dimension(:,:) :: tol_out,tmp_store + real(real32), allocatable,dimension(:) :: vtmp1 + real(real32), dimension(:,:,:) :: list_in + real(real32), allocatable, dimension(:,:,:) :: list_out + real(real32), dimension(:,:) :: tol_in + real(real32), allocatable, dimension(:,:) :: tol_out,tmp_store ntol_features = size(tol_in(1,:)) len = size(list_in(:,1,1)) @@ -147,12 +147,12 @@ end subroutine datasort_tols subroutine datasortmain_tols(tol,mat1,mat2,trans1,trans2) implicit none integer :: i,j,len - double precision, dimension(3) :: vtmp1 - double precision, dimension(2,2) :: dmat1 - double precision, dimension(3,3) :: dmat2 - double precision, dimension(:,:,:) :: mat1,mat2 - double precision, dimension(:,:,:) :: trans1,trans2 - double precision, dimension(:,:) :: tol + real(real32), dimension(3) :: vtmp1 + real(real32), dimension(2,2) :: dmat1 + real(real32), dimension(3,3) :: dmat2 + real(real32), dimension(:,:,:) :: mat1,mat2 + real(real32), dimension(:,:,:) :: trans1,trans2 + real(real32), dimension(:,:) :: tol len=size(tol,dim=1) @@ -198,11 +198,11 @@ function is_duplicate(list1,list2,lat1,lat2,sym1,sym2) result(outval) implicit none integer :: i,len logical :: outval - double precision, dimension(:,:,:) :: list1,list2 ! The lists of already saved matrices - double precision, dimension(:,:) :: lat1,lat2 ! The pair of matrices we want to check - double precision, allocatable, dimension(:,:) :: dummy1,dummy2 - double precision, allocatable, dimension(:,:) :: tmplat1,tmplat2 - double precision, dimension(:,:,:), optional :: sym1,sym2 + real(real32), dimension(:,:,:) :: list1,list2 ! The lists of already saved matrices + real(real32), dimension(:,:) :: lat1,lat2 ! The pair of matrices we want to check + real(real32), allocatable, dimension(:,:) :: dummy1,dummy2 + real(real32), allocatable, dimension(:,:) :: tmplat1,tmplat2 + real(real32), dimension(:,:,:), optional :: sym1,sym2 len = size(list1(:,1,1)) @@ -212,12 +212,12 @@ function is_duplicate(list1,list2,lat1,lat2,sym1,sym2) result(outval) allocate( tmplat1( size( lat1(:,1)), size(lat1(1,:)) ) ) allocate( tmplat2( size( lat2(:,1)), size(lat2(1,:)) ) ) - dummy1 = dble(find_tf(lat1,lat2)) + dummy1 = real(find_tf(lat1,lat2),real32) LOOP: do i=1,len if(all(abs(list1(i,:,:)).lt.1.D-5)) cycle LOOP tmplat1(:,:) = list1(i,:,:) tmplat2(:,:) = list2(i,:,:) - dummy2 = dble(find_tf(tmplat1,tmplat2)) + dummy2 = real(find_tf(tmplat1,tmplat2),real32) if ( all(abs( dummy1(:,:)-dummy2(:,:) ) .lt. 1.D-5) ) then outval = .true. @@ -244,19 +244,19 @@ end function is_duplicate function is_unique(miller,sym) result(outval) implicit none integer :: i,j - double precision :: tol + real(real32) :: tol logical :: outval integer, dimension(3) :: miller - double precision, dimension(3) :: vec_in,vec_out,vec_tmp1,vec_tmp2 - double precision, dimension(:,:,:) :: sym + real(real32), dimension(3) :: vec_in,vec_out,vec_tmp1,vec_tmp2 + real(real32), dimension(:,:,:) :: sym ! if(dot_product(vec_out-vec_in,vec_out-vec_in).lt.1.D-5) ! if(all(abs(vec_out-vec_in).lt.1.D-5)) -! any(vec_in.eq.3.D0) -! all(vec_in.eq.3.D0) +! any(vec_in.eq.3._real32) +! all(vec_in.eq.3._real32) outval = .true. - vec_in = dble(miller) + vec_in = real(miller,real32) vec_out = reduce_vec_gcd(vec_in) if (all(miller.eq.0)) then @@ -270,13 +270,13 @@ function is_unique(miller,sym) result(outval) tol=1.D-5 - if(all(vec_in.le.0.D0))then + if(all(vec_in.le.0._real32))then outval=.false. return end if signloop1: do j=1,3 if(abs(vec_in(j)).lt.tol) cycle signloop1 - vec_in=sign(1.D0,vec_in(j))*vec_in + vec_in=sign(1._real32,vec_in(j))*vec_in exit signloop1 end do signloop1 @@ -316,18 +316,18 @@ end function is_unique function is_unique_set(vec1,vec2,sym) result(outval) implicit none integer :: i,j - double precision :: tol + real(real32) :: tol integer, dimension(2) :: vec1,vec2 - double precision, dimension(3) :: vec_in,vec_out,vec_tmp1,vec_tmp2 - double precision, dimension(:,:,:) :: sym + real(real32), dimension(3) :: vec_in,vec_out,vec_tmp1,vec_tmp2 + real(real32), dimension(:,:,:) :: sym logical :: outval tol=1.D-5 outval=.true. - vec_in=(/ dble(vec1(1)), dble(vec1(2)), 0.D0/) - !vec_in1=(/ dble(vec1(1)), dble(vec1(2)), 0.D0/) - !vec_in2=(/ dble(vec2(1)), dble(vec2(2)), 0.D0/) + vec_in=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) + !vec_in1=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) + !vec_in2=(/ real(vec2(1),real32), real(vec2(2),real32), 0._real32/) symloop1: do i=1,size(sym(:,1,1),dim=1) ! matmul inmat with sym @@ -349,7 +349,7 @@ function is_unique_set(vec1,vec2,sym) result(outval) !tol=1.D-5 !outval=.true. - !vec_in=(/ dble(vec1(1)), dble(vec1(2)), 0.D0/) + !vec_in=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) ! !symloop1: do i=1,size(sym(:,1,1),dim=1) ! vec_out=matmul(vec_in,sym(i,:3,:3)) @@ -380,18 +380,18 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list implicit none integer :: i,isym,jsym integer :: nlist,matched_loc - double precision :: tol + real(real32) :: tol logical :: lunique - double precision, dimension(2,2) :: mat1,mat2,tf - double precision, dimension(2,4) :: inmat - double precision, allocatable, dimension(:,:,:) :: tf_testlist,mat_testlist + real(real32), dimension(2,2) :: mat1,mat2,tf + real(real32), dimension(2,4) :: inmat + real(real32), allocatable, dimension(:,:,:) :: tf_testlist,mat_testlist - double precision, dimension(:,:,:), intent(in) :: sym1,sym2 + real(real32), dimension(:,:,:), intent(in) :: sym1,sym2 - double precision, dimension(2,4), optional, intent(in) :: check_set - double precision, dimension(:,:,:), intent(inout), optional :: test_list - double precision, dimension(4), optional, intent(in) :: lw_check,up_check - double precision, dimension(:,:), optional, intent(inout) :: up_list + real(real32), dimension(2,4), optional, intent(in) :: check_set + real(real32), dimension(:,:,:), intent(inout), optional :: test_list + real(real32), dimension(4), optional, intent(in) :: lw_check,up_check + real(real32), dimension(:,:), optional, intent(inout) :: up_list !logical :: ltest_print !logical, optional, intent(in) :: ltest @@ -400,7 +400,7 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list !if(present(ltest)) ltest_print=ltest !! test set - !double precision, dimension(2,2) :: test1,test2 + !real(real32), dimension(2,2) :: test1,test2 !test1(1,:) = [ 0, 1 ] !test1(2,:) = [ 3, 0 ] !test2(1,:) = [ 1, 0 ] @@ -571,20 +571,20 @@ subroutine cell_match(& implicit none integer :: i,j,l,m,total_list_count,nvec1,nvec2, k real :: tol_up_ang,tol_dw_ang,tol_up_vec,tol_dw_vec - double precision :: tiny - double precision :: reference_mag,considered_mag - double precision :: reference_angle,considered_angle + real(real32) :: tiny + real(real32) :: reference_mag,considered_mag + real(real32) :: reference_angle,considered_angle type(pm_tol_type) :: tol - double precision, dimension(3) :: lat1_veca,lat1_vecb,lat2_veca,lat2_vecb - double precision, dimension(tol%maxfit) :: MAIN_LOOP_LIST_TOLERANCES - !double precision, dimension(:) :: MAIN_LOOP_LIST_TOLERANCES + real(real32), dimension(3) :: lat1_veca,lat1_vecb,lat2_veca,lat2_vecb + real(real32), dimension(tol%maxfit) :: MAIN_LOOP_LIST_TOLERANCES + !real(real32), dimension(:) :: MAIN_LOOP_LIST_TOLERANCES integer, dimension(2,6) :: tmpmat - double precision, dimension(2,2) :: tf,mat1,mat2 - double precision, dimension(2,3) :: considered_vectors - double precision, dimension(3,3) :: lat1,lat2 - double precision, dimension(1000,3) :: tmp_tolerances - double precision, allocatable, dimension(:,:) :: matched_tols - double precision, dimension(tol%maxfit,2,4) :: MAIN_LOOP_LIST + real(real32), dimension(2,2) :: tf,mat1,mat2 + real(real32), dimension(2,3) :: considered_vectors + real(real32), dimension(3,3) :: lat1,lat2 + real(real32), dimension(1000,3) :: tmp_tolerances + real(real32), allocatable, dimension(:,:) :: matched_tols + real(real32), dimension(tol%maxfit,2,4) :: MAIN_LOOP_LIST integer :: ntransforms !! The 2x2 transformation matrices output by the code. @@ -592,9 +592,9 @@ subroutine cell_match(& integer, allocatable, dimension(:,:,:) :: transforms1,transforms2 integer, allocatable, dimension(:,:) :: numstore_1,numstore_2 integer, allocatable, dimension(:,:) :: iarrtmp1 - double precision, allocatable, dimension(:,:) :: latstore_1,latstore_2 - double precision, allocatable, dimension(:,:) :: darrtmp1 - double precision, dimension(:,:,:), optional :: sym1,sym2 + real(real32), allocatable, dimension(:,:) :: latstore_1,latstore_2 + real(real32), allocatable, dimension(:,:) :: darrtmp1 + real(real32), dimension(:,:,:), optional :: sym1,sym2 !!! Layout of each of the 1000 cells: @@ -611,13 +611,13 @@ subroutine cell_match(& integer :: len_list_final !Length of final list of compatible vector pairs after angle check !! list of vec combins (of 2a and 2b) that fit vec lat1_a, mag of tol on fit - double precision, dimension(1000,3) :: list_1a + real(real32), dimension(1000,3) :: list_1a !! layout: int num of lat2_a, int num of lat2_b, tol !! list of vec combins (of 2a and 2b) that fit vec lat1_b, mag of tol on fit - double precision, dimension(1000,3) :: list_1b + real(real32), dimension(1000,3) :: list_1b !! layout: integer number of lat2_a, integer number of lat2_b, tol - double precision, dimension(1000,5) :: list_angle_fits + real(real32), dimension(1000,5) :: list_angle_fits !Layout: ! First 2 components(1-2); integer number of lat2_a, integer number of lat2_b ! Next 2 components(3-4); integer number of lat2_a, integer number of lat2_b @@ -630,8 +630,8 @@ subroutine cell_match(& tiny = 1.D-5 tol_up_ang = 1.E0 + real(tol%ang)/(2.E0*pi) tol_dw_ang = 1.E0 - real(tol%ang)/(2.E0*pi) - tol_up_vec = 1.E0 + real(tol%vec)!/100.D0 - tol_dw_vec = 1.E0 - real(tol%vec)!/100.D0 + tol_up_vec = 1.E0 + real(tol%vec)!/100._real32 + tol_dw_vec = 1.E0 - real(tol%vec)!/100._real32 if(allocated(matched_tols)) deallocate(matched_tols) allocate(matched_tols(tol%maxfit,3)) @@ -665,7 +665,7 @@ subroutine cell_match(& pmloop2: do j=1,-1,-2 nvec1=nvec1+1 numstore_1(nvec1,:) = (/ i*l, j*m /) - latstore_1(nvec1,:) = dble(i*l) * lat1_veca + dble(j*m) * lat1_vecb + latstore_1(nvec1,:) = real(i*l,real32) * lat1_veca + real(j*m,real32) * lat1_vecb if(abs(modu(latstore_1(nvec1,:))).gt.tol%maxlen)then nvec1=nvec1-1 cycle pmloop1 @@ -695,7 +695,7 @@ subroutine cell_match(& pmloop4: do j=1,-1,-2 nvec2=nvec2+1 numstore_2(nvec2,:) = (/ i*l, j*m /) - latstore_2(nvec2,:) = dble(i*l) * lat2_veca + dble(j*m) * lat2_vecb + latstore_2(nvec2,:) = real(i*l,real32) * lat2_veca + real(j*m,real32) * lat2_vecb if(modu(latstore_2(nvec2,:)).gt.tol%maxlen)then nvec2=nvec2-1 cycle vecmakeloop3 @@ -747,14 +747,14 @@ subroutine cell_match(& tmpmat(2,:2) = numstore_1(m,:2) if(all(latstore_1(l,:).eq.latstore_1(m,:))) cycle MAINLOOP2 if(get_area([latstore_1(l,:)],[latstore_1(m,:)]).gt.tol%maxarea) cycle MAINLOOP2 - if(all(cross([latstore_1(l,:)],[latstore_1(m,:)]).eq.0.D0)) cycle MAINLOOP2 + if(all(cross([latstore_1(l,:)],[latstore_1(m,:)]).eq.0._real32)) cycle MAINLOOP2 reference_angle = get_angle([latstore_1(l,:)],[latstore_1(m,:)]) if (abs(reference_angle) .lt. tiny) cycle MAINLOOP2 !!! CHANGE IT TO TAKE IN A 2x2 MATRIX LATER !!! if(modu(latstore_1(l,:)).gt.modu(latstore_1(m,:))) cycle MAINLOOP2 if(dot_product(latstore_1(l,:),latstore_1(m,:)).gt.& - (0.5D0*dot_product(latstore_1(l,:),latstore_1(l,:))))& + (0.5_real32*dot_product(latstore_1(l,:),latstore_1(l,:))))& cycle MAINLOOP2 !SHOULD I REMOVE THIS? WHAT DOES IT WANT TO DO? !if(.not.is_unique_set(numstore_1(l,:),numstore_1(m,:),sym1)) & @@ -809,13 +809,13 @@ subroutine cell_match(& ! total_list_count,len_list_final, considered_angle if(total_list_count.ne.0)then if(.not.is_unique_match( sym1, sym2, & - check_set = dble(tmpmat),& + check_set = real(tmpmat,real32),& test_list = MAIN_LOOP_LIST(:total_list_count,:2,:4)))& cycle loop110 end if if(len_list_final.ne.0)then if(.not.is_unique_match( sym1, sym2, & - check_set = dble(tmpmat),& + check_set = real(tmpmat,real32),& up_list = list_angle_fits(:len_list_final,:4)))& cycle loop110 end if @@ -828,7 +828,7 @@ subroutine cell_match(& max(list_1a(i,3),list_1b(j,3)) tmp_tolerances(len_list_final,2) = & abs(considered_angle-reference_angle) - tmp_tolerances(len_list_final,3) = abs(1.D0 - & + tmp_tolerances(len_list_final,3) = abs(1._real32 - & get_area([considered_vectors(1,:)],[considered_vectors(2,:)])& /get_area([latstore_1(l,:)],[latstore_1(m,:)])) list_angle_fits(len_list_final,5) = & @@ -845,14 +845,14 @@ subroutine cell_match(& !!! output list down to that size !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! loop112: do i=1, len_list_final - mat1(1,:2)=dble(numstore_1(l,:2)) - mat1(2,:2)=dble(numstore_1(m,:2)) - mat2(1,:2)=dble(list_angle_fits(i,1:2)) - mat2(2,:2)=dble(list_angle_fits(i,3:4)) + mat1(1,:2)=real(numstore_1(l,:2),real32) + mat1(2,:2)=real(numstore_1(m,:2),real32) + mat2(1,:2)=real(list_angle_fits(i,1:2),real32) + mat2(2,:2)=real(list_angle_fits(i,3:4),real32) tf=find_tf(mat1,mat2) do j=1,tol%maxfit - if(all(abs(tf-find_tf(dble(MAIN_LOOP_LIST(j,:2,1:2)),& - dble(MAIN_LOOP_LIST(j,:2,3:4)))).lt.1.D-6))then + if(all(abs(tf-find_tf(real(MAIN_LOOP_LIST(j,:2,1:2),real32),& + real(MAIN_LOOP_LIST(j,:2,3:4),real32))).lt.1.D-6))then cycle loop112 end if end do diff --git a/src/fortran/mod_shifting.f90 b/src/fortran/mod_shifting.f90 index 86c820b..396707a 100644 --- a/src/fortran/mod_shifting.f90 +++ b/src/fortran/mod_shifting.f90 @@ -4,12 +4,13 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module shifting - use constants, only: ierror,pi,INF + use artemis__constants, only: real32, ierror, pi, INF use misc_maths, only: get_nth_plane use misc_linalg, only: modu - use rw_geom, only: bas_type,clone_bas,geom_write - use edit_geom, only: split_bas,get_centre_atom,bas_merge,set_vacuum,shifter - use io + use artemis__geom_rw, only: basis_type,geom_write + use edit_geom, only: split_bas,get_centre_atom,set_vacuum,shifter + use artemis__io_utils + use artemis__io_utils_extd, only: err_abort_print_struc use interface_identifier implicit none @@ -40,15 +41,15 @@ module shifting subroutine get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) implicit none integer :: i,is,ia,itop,ibot,axis,count1 - double precision :: centre,dist,dist_max - double precision, optional :: depth - type(bas_type) :: bas,bas_top,bas_bot - double precision, dimension(:) :: intf_loc - double precision, dimension(3,3) :: lat + real(real32) :: centre,dist,dist_max + real(real32), optional :: depth + type(basis_type) :: bas,bas_top,bas_bot + real(real32), dimension(:) :: intf_loc + real(real32), dimension(3,3) :: lat integer, allocatable, dimension(:) :: vtmp1 integer, allocatable, dimension(:,:) :: intf_list - double precision, allocatable, dimension(:,:) :: regions - type(bas_type), allocatable, dimension(:) :: splitbas + real(real32), allocatable, dimension(:,:) :: regions + type(basis_type), allocatable, dimension(:) :: splitbas !!!----------------------------------------------------------------------------- @@ -90,8 +91,8 @@ subroutine get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) LOOP105: do is=1,bas%nspec allocate(bas_top%spec(is)%atom(bas_top%spec(is)%num,3)) allocate(bas_bot%spec(is)%atom(bas_bot%spec(is)%num,3)) - bas_top%spec(is)%atom(:,:)=0.D0 - bas_bot%spec(is)%atom(:,:)=0.D0 + bas_top%spec(is)%atom(:,:)=0._real32 + bas_bot%spec(is)%atom(:,:)=0._real32 end do LOOP105 @@ -114,7 +115,7 @@ subroutine get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) end do LOOP104 end do LOOP103 else - dist_max=4.D0/modu(lat(axis,:)) + dist_max=4._real32/modu(lat(axis,:)) allocate(vtmp1(bas%nspec)) allocate(regions(size(intf_loc,dim=1),2)) regions(1,1:2)=intf_loc(1:2) @@ -215,23 +216,23 @@ end subroutine get_top_bot_basis !!! ... required minimum bulk bond length. !!!############################################################################# function get_fit_shifts(lat,bas,bond,axis,intf_loc,depth,nstore,itmp1,itmp2) result(best_shifts) - double precision :: depth,bond ! the depth into the material we are interested (physical size in the c direction). + real(real32) :: depth,bond ! the depth into the material we are interested (physical size in the c direction). integer :: i - type(bas_type) :: bas_bot,bas_top + type(basis_type) :: bas_bot,bas_top - double precision :: depth_bascoord - double precision, dimension(:) :: intf_loc - double precision, allocatable, dimension(:,:) :: min_atom_sep - double precision, allocatable, dimension(:,:,:) :: avg_min_atom_sep + real(real32) :: depth_bascoord + real(real32), dimension(:) :: intf_loc + real(real32), allocatable, dimension(:,:) :: min_atom_sep + real(real32), allocatable, dimension(:,:,:) :: avg_min_atom_sep integer :: axis integer :: num_steps,num_c_shifts !number of pieces to divide the unit cell into in a and b direction. - double precision, allocatable, dimension(:,:) :: best_shifts + real(real32), allocatable, dimension(:,:) :: best_shifts integer :: nstore ! The required output number of the best shifts. integer, optional :: itmp1,itmp2 - type(bas_type) :: bas !The basis input by interfaces.f90 - double precision, dimension(3,3) :: lat !The lattice input by interfaces.f90 + type(basis_type) :: bas !The basis input by interfaces.f90 + real(real32), dimension(3,3) :: lat !The lattice input by interfaces.f90 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -245,7 +246,7 @@ function get_fit_shifts(lat,bas,bond,axis,intf_loc,depth,nstore,itmp1,itmp2) res allocate(best_shifts(nstore,4)) - if(depth.eq.0.D0)then + if(depth.eq.0._real32)then call get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc) else call get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) @@ -289,10 +290,10 @@ end function get_fit_shifts !!!######################################################################### function findbestfits(bulkbond,avg_min_sep,num_steps,num_c_shifts,num_best_shifts,depth) result(best_shifts) implicit none - double precision, dimension(:,:,:) :: avg_min_sep - double precision :: bulkbond,current_difference,min_difference,depth + real(real32), dimension(:,:,:) :: avg_min_sep + real(real32) :: bulkbond,current_difference,min_difference,depth integer :: i,ia,ib,ic,num_steps,num_c_shifts,num_best_shifts,c_shift_low,c_shift_high - double precision, allocatable, dimension(:,:) :: best_shifts + real(real32), allocatable, dimension(:,:) :: best_shifts integer, dimension(3) :: placeholder allocate(best_shifts(num_best_shifts,4)) @@ -306,16 +307,16 @@ function findbestfits(bulkbond,avg_min_sep,num_steps,num_c_shifts,num_best_shift end if shiftloop: do i=1,num_best_shifts - min_difference = huge(0.D0) + min_difference = huge(0._real32) LOOP5A: do ia=0,num_steps-1 !loop through shifts in a LOOP5B: do ib=0,num_steps-1 !loop through shifts in b LOOP5C: do ic=c_shift_low,c_shift_high,1 !Loop through shifts of the top plane in c current_difference = abs(avg_min_sep(ia+1,ib+1,ic-c_shift_low+1) - bulkbond) if (current_difference.lt.min_difference) then min_difference = current_difference - best_shifts(i,1) = dble(ia)/dble(num_steps) - best_shifts(i,2) = dble(ib)/dble(num_steps) - best_shifts(i,3) = dble(ic)*depth*2.D0/dble(num_c_shifts) + best_shifts(i,1) = real(ia,real32)/real(num_steps,real32) + best_shifts(i,2) = real(ib,real32)/real(num_steps,real32) + best_shifts(i,3) = real(ic,real32)*depth*2._real32/real(num_c_shifts,real32) best_shifts(i,4) = min_difference placeholder(1) = ia placeholder(2) = ib @@ -325,7 +326,7 @@ function findbestfits(bulkbond,avg_min_sep,num_steps,num_c_shifts,num_best_shift end do LOOP5C end do LOOP5B end do LOOP5A - avg_min_sep(placeholder(1)+1,placeholder(2)+1,placeholder(3)-c_shift_low+1) = huge(0.D0) + avg_min_sep(placeholder(1)+1,placeholder(2)+1,placeholder(3)-c_shift_low+1) = huge(0._real32) end do shiftloop end function findbestfits @@ -338,17 +339,17 @@ end function findbestfits !!!############################################################################# function avgminsep(lat,plane_up,plane_dw,num_steps,num_c_shifts,depth) result(avg_min_sep) implicit none - type(bas_type) :: plane_up,plane_dw,tplane_up,tplane_dw - double precision :: avg_sep_up,avg_sep_dw,depth + type(basis_type) :: plane_up,plane_dw,tplane_up,tplane_dw + real(real32) :: avg_sep_up,avg_sep_dw,depth integer :: num_steps,num_c_shifts !number of pieces to divide the unit cell into in a and b direction. - double precision, allocatable, dimension(:,:,:) :: avg_min_sep + real(real32), allocatable, dimension(:,:,:) :: avg_min_sep integer :: ia,ib,ic,is_up,ia_up,c_shift_low,c_shift_high - double precision, dimension(3,3) :: lat + real(real32), dimension(3,3) :: lat allocate(avg_min_sep(num_steps,num_steps,num_c_shifts)) - call clone_bas(plane_up,tplane_up) - call clone_bas(plane_dw,tplane_dw) + call tplane_up%copy(plane_up) + call tplane_dw%copy(plane_dw) if (mod(num_c_shifts,2) .eq. 0) then c_shift_low = -nint(real(num_c_shifts)/2.0)+1 c_shift_high = nint(real(num_c_shifts)/2.0) @@ -358,7 +359,7 @@ function avgminsep(lat,plane_up,plane_dw,num_steps,num_c_shifts,depth) result(av end if - avg_min_sep = huge(0.D0) + avg_min_sep = huge(0._real32) LOOP4C: do ic=c_shift_low,c_shift_high,1 !Loop through shifts of the top plane in c LOOP4A: do ia=0,num_steps-1 !loop through shifts in a LOOP4B: do ib=0,num_steps-1 !loop through shifts in b @@ -368,9 +369,9 @@ function avgminsep(lat,plane_up,plane_dw,num_steps,num_c_shifts,depth) result(av plane_up%spec(is_up)%atom(ia_up,:) = & plane_up%spec(is_up)%atom(ia_up,:) + & (/& - (dble(ia)/dble(num_steps)),& - (dble(ib)/dble(num_steps)),& - (dble(ic)*depth*2.D0/dble(num_c_shifts)) /) + (real(ia,real32)/real(num_steps,real32)),& + (real(ib,real32)/real(num_steps,real32)),& + (real(ic,real32)*depth*2._real32/real(num_c_shifts,real32)) /) end do end do @@ -378,7 +379,7 @@ function avgminsep(lat,plane_up,plane_dw,num_steps,num_c_shifts,depth) result(av avg_sep_dw = find_avg_min_sep(lat, plane_dw,tplane_up) avg_min_sep(ia+1,ib+1,ic-c_shift_low+1) = & - (avg_sep_up + avg_sep_dw)/2.D0 + (avg_sep_up + avg_sep_dw)/2._real32 end do LOOP4B end do LOOP4A @@ -395,17 +396,17 @@ end function avgminsep function find_avg_min_sep(lat,plane_1,plane_2) result(avg_min_sep) implicit none integer :: is_1,ia_1,is_2,ia_2,j - double precision :: avg_min_sep,min_sep,cur_sep - type(bas_type) :: plane_1,plane_2 - double precision, dimension(3) :: dvtmp1 - double precision, dimension(3,3) :: lat + real(real32) :: avg_min_sep,min_sep,cur_sep + type(basis_type) :: plane_1,plane_2 + real(real32), dimension(3) :: dvtmp1 + real(real32), dimension(3,3) :: lat - avg_min_sep=0.D0 + avg_min_sep=0._real32 LOOP401: do is_1=1,plane_1%nspec ! Loop though 1st plane LOOP402: do ia_1=1,plane_1%spec(is_1)%num - min_sep = huge(0.D0) + min_sep = huge(0._real32) LOOP403: do is_2=1,plane_2%nspec ! Loop through 2nd plane LOOP404: do ia_2=1,plane_2%spec(is_2)%num @@ -414,7 +415,7 @@ function find_avg_min_sep(lat,plane_1,plane_2) result(avg_min_sep) plane_1%spec(is_1)%atom(ia_1,:) do j=1,3 - dvtmp1(j) = dvtmp1(j) - ceiling( dvtmp1(j) - 0.5D0 ) + dvtmp1(j) = dvtmp1(j) - ceiling( dvtmp1(j) - 0.5_real32 ) end do dvtmp1 = dvtmp1(1) * lat(1,:) & + dvtmp1(2) * lat(2,:) & @@ -455,13 +456,13 @@ function get_descriptive_shifts(lat,bas,bond,axis,intf_loc,depth,nstore,c_scale, implicit none integer :: is integer :: nstore,axis,num_steps - double precision :: bond,depth,cur_vac,c_shift - type(bas_type) :: bas,bas_bot,bas_top - double precision, dimension(3,3) :: lat - double precision, dimension(:) :: intf_loc - double precision, allocatable, dimension(:) :: specval_bot,specval_top - double precision, allocatable, dimension(:,:) :: res_shifts - double precision, optional :: c_scale + real(real32) :: bond,depth,cur_vac,c_shift + type(basis_type) :: bas,bas_bot,bas_top + real(real32), dimension(3,3) :: lat + real(real32), dimension(:) :: intf_loc + real(real32), allocatable, dimension(:) :: specval_bot,specval_top + real(real32), allocatable, dimension(:,:) :: res_shifts + real(real32), optional :: c_scale logical, optional :: lprint @@ -470,7 +471,7 @@ function get_descriptive_shifts(lat,bas,bond,axis,intf_loc,depth,nstore,c_scale, !!!----------------------------------------------------------------------------- !!! separates basis into atoms above and below interface within a depth window !!!----------------------------------------------------------------------------- - if(depth.eq.0.D0)then + if(depth.eq.0._real32)then call get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc) else call get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth=depth) @@ -482,8 +483,8 @@ function get_descriptive_shifts(lat,bas,bond,axis,intf_loc,depth,nstore,c_scale, !!!----------------------------------------------------------------------------- allocate(specval_bot(bas%nspec)) allocate(specval_top(bas%nspec)) - specval_bot=-huge(0.D0) - specval_top=huge(0.D0) + specval_bot=-huge(0._real32) + specval_top=huge(0._real32) do is=1,bas%nspec if(bas_bot%spec(is)%num.ne.0)then specval_bot(is)=maxval(bas_bot%spec(is)%atom(:,axis)) @@ -545,18 +546,18 @@ function get_c_shift(lat,plane_up,plane_dw,bond,axis,num_steps) result(c_shift) implicit none integer :: num_steps,count1 integer :: ia,ib,is_up,ia_up,axis - double precision :: avg_sep_up,avg_sep_dw,bond,tol - double precision :: c_shift,prev_c_shift,new_c_shift - double precision :: prev_min_bond,min_bond - type(bas_type) :: plane_up,plane_dw,tplane_up - double precision, allocatable, dimension(:,:) :: avg_min_sep - double precision, dimension(3,3) :: lat + real(real32) :: avg_sep_up,avg_sep_dw,bond,tol + real(real32) :: c_shift,prev_c_shift,new_c_shift + real(real32) :: prev_min_bond,min_bond + type(basis_type) :: plane_up,plane_dw,tplane_up + real(real32), allocatable, dimension(:,:) :: avg_min_sep + real(real32), dimension(3,3) :: lat !!!----------------------------------------------------------------------------- !!! Clone upper basis for editing !!!----------------------------------------------------------------------------- - call clone_bas(plane_up,tplane_up) + call tplane_up%copy(plane_up) allocate(avg_min_sep(num_steps,num_steps)) @@ -565,10 +566,10 @@ function get_c_shift(lat,plane_up,plane_dw,bond,axis,num_steps) result(c_shift) !!!----------------------------------------------------------------------------- tol=1.D-2/modu(lat(axis,:)) count1=0 - prev_min_bond=0.D0 - prev_c_shift=0.D0 - c_shift=0.D0 - avg_min_sep = huge(0.D0) + prev_min_bond=0._real32 + prev_c_shift=0._real32 + c_shift=0._real32 + avg_min_sep = huge(0._real32) !!!----------------------------------------------------------------------------- @@ -584,15 +585,15 @@ function get_c_shift(lat,plane_up,plane_dw,bond,axis,num_steps) result(c_shift) do ia_up=1,plane_up%spec(is_up)%num tplane_up%spec(is_up)%atom(ia_up,:) = plane_up%spec(is_up)%atom(ia_up,:) + & (/& - (dble(ia)/dble(num_steps)),& - (dble(ib)/dble(num_steps)),& + (real(ia,real32)/real(num_steps,real32)),& + (real(ib,real32)/real(num_steps,real32)),& c_shift /) end do end do avg_sep_up = find_avg_min_sep(lat,tplane_up, plane_dw) avg_sep_dw = find_avg_min_sep(lat, plane_dw,tplane_up) - avg_min_sep(ia+1,ib+1) = (avg_sep_up + avg_sep_dw)/2.D0 + avg_min_sep(ia+1,ib+1) = (avg_sep_up + avg_sep_dw)/2._real32 end do LOOP5B end do LOOP5A @@ -618,7 +619,7 @@ function get_c_shift(lat,plane_up,plane_dw,bond,axis,num_steps) result(c_shift) (prev_c_shift - c_shift)*( prev_min_bond - bond )/( prev_min_bond - min_bond ) end if else - new_c_shift = 0.5D0/modu(lat(axis,:)) + new_c_shift = 0.5_real32/modu(lat(axis,:)) end if !!----------------------------------------------------------------------- !! Breaks afer 50 failed steps @@ -651,21 +652,21 @@ function get_descriptive_ab_shifts(lat,plane_up,plane_dw,bond,axis,nstore,num_st implicit none integer :: nstore,num_steps,count1 integer :: ia,ib,is_up,ia_up,axis,iden,inum - double precision :: avg_sep_up,avg_sep_dw,bond - double precision :: min_sep,max_sep - type(bas_type) :: plane_up,plane_dw,tplane_up,tplane_dw - double precision, allocatable, dimension(:,:) :: ab_shifts,avg_min_sep - double precision, dimension(3,3) :: lat + real(real32) :: avg_sep_up,avg_sep_dw,bond + real(real32) :: min_sep,max_sep + type(basis_type) :: plane_up,plane_dw,tplane_up,tplane_dw + real(real32), allocatable, dimension(:,:) :: ab_shifts,avg_min_sep + real(real32), dimension(3,3) :: lat - call clone_bas(plane_up,tplane_up) - call clone_bas(plane_dw,tplane_dw) + call tplane_up%copy(plane_up) + call tplane_dw%copy(plane_dw) allocate(avg_min_sep(num_steps,num_steps)) allocate(ab_shifts(nstore,2)) count1=0 - avg_min_sep = huge(0.D0) + avg_min_sep = huge(0._real32) LOOP5A: do ia=0,num_steps-1 !loop through shifts in a LOOP5B: do ib=0,num_steps-1 !loop through shifts in b @@ -673,9 +674,9 @@ function get_descriptive_ab_shifts(lat,plane_up,plane_dw,bond,axis,nstore,num_st do ia_up=1,plane_up%spec(is_up)%num tplane_up%spec(is_up)%atom(ia_up,:) = plane_up%spec(is_up)%atom(ia_up,:) + & (/& - (dble(ia)/dble(num_steps)),& - (dble(ib)/dble(num_steps)),& - 0.D0 /) + (real(ia,real32)/real(num_steps,real32)),& + (real(ib,real32)/real(num_steps,real32)),& + 0._real32 /) end do end do @@ -683,7 +684,7 @@ function get_descriptive_ab_shifts(lat,plane_up,plane_dw,bond,axis,nstore,num_st avg_sep_dw = find_avg_min_sep(lat, plane_dw,tplane_up) - avg_min_sep(ia+1,ib+1) = (avg_sep_up + avg_sep_dw)/2.D0 + avg_min_sep(ia+1,ib+1) = (avg_sep_up + avg_sep_dw)/2._real32 end do LOOP5B end do LOOP5A @@ -694,8 +695,8 @@ function get_descriptive_ab_shifts(lat,plane_up,plane_dw,bond,axis,nstore,num_st - ab_shifts(1,:)=dble((/minloc(avg_min_sep)/))/dble(num_steps) - ab_shifts(2,:)=dble((/maxloc(avg_min_sep)/))/dble(num_steps) + ab_shifts(1,:)=real((/minloc(avg_min_sep)/),real32)/real(num_steps,real32) + ab_shifts(2,:)=real((/maxloc(avg_min_sep)/),real32)/real(num_steps,real32) iden=1 count1=2 denom_loop: do @@ -704,10 +705,10 @@ function get_descriptive_ab_shifts(lat,plane_up,plane_dw,bond,axis,nstore,num_st do inum=1,iden,2 count1=count1+1 if(count1.gt.nstore) exit denom_loop - ab_shifts(count1,:) = dble((/ & + ab_shifts(count1,:) = real((/ & minloc( & - abs( avg_min_sep - ( min_sep + (max_sep-min_sep)*dble(inum)/dble(iden) ) ) )& - /))/dble(num_steps) + abs( avg_min_sep - ( min_sep + (max_sep-min_sep)*real(inum,real32)/real(iden,real32) ) ) )& + /),real32)/real(num_steps,real32) end do end do denom_loop @@ -749,7 +750,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& integer :: ntrans,iatom,nneigh,ncheck real :: stepsize,max_sep,dist_max real :: rtmp1,rtmp2,rtmp3 - double precision :: val,dtmp1,dtmp2 + real(real32) :: val,dtmp1,dtmp2 logical :: lbulk, lpresent type(confine_type) :: confine integer, dimension(2) :: plane_loc @@ -760,19 +761,19 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& type(map_type), dimension(2) :: map type(wyck_spec_type), dimension(2) :: wyckoff real, allocatable, dimension(:) :: fit_store,tmp_neigh - type(bas_type), allocatable, dimension(:) :: splitbas + type(basis_type), allocatable, dimension(:) :: splitbas type(den_of_neigh_type), allocatable, dimension(:,:) :: DON_missing integer, allocatable, dimension(:,:) :: shift_store - double precision, allocatable, dimension(:,:) :: res_shifts,trans,regions + real(real32), allocatable, dimension(:,:) :: res_shifts,trans,regions integer, intent(in) :: axis,nstore real, intent(in), optional :: max_bondlength - type(bas_type), intent(in) :: bas - double precision, dimension(:), intent(in) :: intf_loc - double precision, dimension(3,3), intent(in) :: lat - double precision, optional :: c_scale + type(basis_type), intent(in) :: bas + real(real32), dimension(:), intent(in) :: intf_loc + real(real32), dimension(3,3), intent(in) :: lat + real(real32), optional :: c_scale logical, optional :: lprint - double precision, dimension(3), optional, intent(in) :: offset + real(real32), dimension(3), optional, intent(in) :: offset integer, dimension(:,:,:), optional, intent(in) :: bulk_map @@ -817,7 +818,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !!! sets up step size !!!----------------------------------------------------------------------------- allocate(res_shifts(nstore,3)) - res_shifts=0.D0 + res_shifts=0._real32 !!!----------------------------------------------------------------------------- @@ -845,7 +846,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !!!----------------------------------------------------------------------------- !!! determines repeated translations within the cell (reduces shift by that) !!!----------------------------------------------------------------------------- - min_trans=1.D0 + min_trans=1._real32 do i=1,2 call gldfnd(confine,splitbas(i),splitbas(i),trans,ntrans) if(ntrans.eq.0) cycle @@ -857,7 +858,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& end do min_trans=abs(min_trans) where(abs(min_trans).lt.1.D-5) - min_trans=1.D0 + min_trans=1._real32 end where if(ierror.eq.1) write(6,*) "repeated_trans:",min_trans @@ -931,8 +932,8 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !!----------------------------------------------------------------- dtmp1 = splitbas(i)%spec(is)%atom(ia,axis) - intf_loc(1) dtmp2 = splitbas(i)%spec(is)%atom(ia,axis) - intf_loc(2) - if( abs(dtmp1 - ceiling(dtmp1 - 0.5D0)) .gt. & - abs(dtmp2 - ceiling(dtmp2 - 0.5D0)))then + if( abs(dtmp1 - ceiling(dtmp1 - 0.5_real32)) .gt. & + abs(dtmp2 - ceiling(dtmp2 - 0.5_real32)))then cycle atom_loop1 end if @@ -953,8 +954,8 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& DON_missing(i,is)%atom(iatom,:) - & DON_missing(i,is)%atom(ia,:) end if - !where(DON_missing(i,is)%atom(ia,:).lt.0.D0) - ! DON_missing(i,is)%atom(ia,:)=0.D0 + !where(DON_missing(i,is)%atom(ia,:).lt.0._real32) + ! DON_missing(i,is)%atom(ia,:)=0._real32 !end where if(all(abs(DON_missing(i,is)%atom(ia,:)).lt.1.D-2))& cycle atom_loop1 @@ -964,7 +965,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !! checks only 1st missing bond !!----------------------------------------------------------------- plane_loc(:)=& - get_nth_plane(invec=dble(DON_missing(i,is)%atom(ia,:)),& + get_nth_plane(invec=real(DON_missing(i,is)%atom(ia,:),real32),& nth=2,window=20,is_periodic=.false.) !! WINDOW WAS 10, NOW 20 itmp1=nint( & sum(DON_missing(i,is)%atom(ia,:plane_loc(1)))*& @@ -973,7 +974,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& count1 = count1 +1 neighbour(i,count1)%pos = splitbas(i)%spec(is)%atom(ia,:3) !neighbour(i,count1)%pos = neighbour(i,count1)%pos - & - ! ceiling(neighbour(i,count1)%pos - 1.D0) + ! ceiling(neighbour(i,count1)%pos - 1._real32) neighbour(i,count1)%bond = & ( maxloc(DON_missing(i,is)%atom(ia,:plane_loc(1)),dim=1) & - 1 ) * dist_max/nstep_default @@ -1011,9 +1012,9 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& bulk_DON(i)%spec(map(i)%spec(is,ia,1))%atom(map(i)%spec(is,ia,2),j) end do close(14) - call err_abort_print_struc(lat,splitbas(1),"lw_term.vasp",& + call err_abort_print_struc(splitbas(1),"lw_term.vasp",& "",.false.) - call err_abort_print_struc(lat,splitbas(2),"up_term.vasp",& + call err_abort_print_struc(splitbas(2),"up_term.vasp",& "",.false.) call err_abort("ERROR: Internal error in get_shifts_DON\n& & More neighbours found in slab than in bulk.",.true.) @@ -1057,14 +1058,14 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !!!----------------------------------------------------------------------------- lpresent=.false. if(present(offset))then - if(offset(axis).ge.0.D0)then + if(offset(axis).ge.0._real32)then max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:)) lpresent=.true. end if end if if(.not.lpresent)then - max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:)) + 6.D0 - add = 0.D0 + max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:)) + 6._real32 + add = 0._real32 end if stepsize=0.1 @@ -1080,7 +1081,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& nstep(:2) = min_trans(:2)*ngrid(:2) nstep(3) = 0 do jc=1,ngrid(3) - pos(3) = dble(jc-1)*gridsize(3) + pos(3) = real(jc-1,real32)*gridsize(3) if(pos(3)+highest_atom(2).gt.(ngrid(3)-1)*gridsize(3)) exit if(pos(3)-lowest_atom(1).gt.(ngrid(3)-1)*gridsize(3)) exit nstep(3) = nstep(3) + 1 @@ -1089,7 +1090,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& if(ierror.ge.1) write(6,'(1X,"user-defined offset:",3(3X,F7.3))') offset add = -1.0 do i=1,3 - if(offset(i).ge.0.D0)then + if(offset(i).ge.0._real32)then nstep(i) = 1 add(i) = offset(i) end if @@ -1123,9 +1124,9 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& write(0,*) "ERROR: Internal error in get_shifts_DON" write(0,*) "nstep:",nstep write(0,*) "ngrid:",ngrid - call err_abort_print_struc(lat,splitbas(1),"lw_term.vasp",& + call err_abort_print_struc(splitbas(1),"lw_term.vasp",& "",.false.) - call err_abort_print_struc(lat,splitbas(2),"up_term.vasp",& + call err_abort_print_struc(splitbas(2),"up_term.vasp",& "",.false.) call err_abort("ERROR: Internal error in get_shifts_DON",.true.) end if @@ -1137,24 +1138,24 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& nneigh = size(intf(k)%neigh,dim=1) do ja=1,ngrid(1) - pos(1) = dble(ja-1)*gridsize(1) + add(1) + pos(1) = real(ja-1,real32)*gridsize(1) + add(1) do jb=1,ngrid(2) - pos(2) = dble(jb-1)*gridsize(2) + add(2) + pos(2) = real(jb-1,real32)*gridsize(2) + add(2) do jc=1,ngrid(3) count1 = 0 tmp_neigh = 0 - pos(3) = dble(jc-1)*gridsize(3) + add(3) + pos(3) = real(jc-1,real32)*gridsize(3) + add(3) do is=1,nneigh vtmp1 = ( & - pos*(-1)**dble(k-1) - & - intf(k)%neigh(is)%pos(:3) )*(-1)**dble(k-1) - !vtmp1 = ( pos - intf(k)%neigh(is)%pos(:3) )!*(-1)**dble(k) + pos*(-1)**real(k-1,real32) - & + intf(k)%neigh(is)%pos(:3) )*(-1)**real(k-1,real32) + !vtmp1 = ( pos - intf(k)%neigh(is)%pos(:3) )!*(-1)**real(k,real32) vtmp2(3) = vtmp1(3) a_extend_loop: do i=-1,1,1 - vtmp2(1) = vtmp1(1) + dble(i) + vtmp2(1) = vtmp1(1) + real(i,real32) b_extend_loop: do j=-1,1,1 - vtmp2(2) = vtmp1(2) + dble(j) + vtmp2(2) = vtmp1(2) + real(j,real32) vtmp3 = matmul(vtmp2,lat) if(modu(vtmp3).gt.dist_max) cycle b_extend_loop count1 = count1 + 1 @@ -1180,24 +1181,24 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& allocate(fit_store(nstore)) allocate(shift_store(nstore,3)) fit_store=huge(0.0) - shift_store=0.D0 + shift_store=0._real32 ! !$OMP PARALLEL DEFAULT(SHARED) NUM_NHREADS(nthreads) ! !$OMP DO PRIVATE(ja,jb,jc,pos,val,l,is,nneigh,vtmp1,ivtmp1,ncheck,rtmp1,rtmp2,val) SCHEDULE(DYNAMIC,CHUNK) do ja=1,nstep(1) - pos(1) = dble(ja-1)*gridsize(1) + pos(1) = real(ja-1,real32)*gridsize(1) b_loop1: do jb=1,nstep(2) - pos(2) = dble(jb-1)*gridsize(2) + pos(2) = real(jb-1,real32)*gridsize(2) c_loop1: do jc=1,nstep(3) - pos(3) = dble(jc-1)*gridsize(3) + pos(3) = real(jc-1,real32)*gridsize(3) - val = 0.D0 + val = 0._real32 do k=1,2 l=minval([1,2],mask=[1,2].ne.k) nneigh = size(intf(l)%neigh,dim=1) do is=1,nneigh vtmp1 = ( & - pos*(-1)**dble(l) + & - intf(l)%neigh(is)%pos )*(-1)**dble(l) + pos*(-1)**real(l,real32) + & + intf(l)%neigh(is)%pos )*(-1)**real(l,real32) vtmp1(:2) = vtmp1(:2) - floor( vtmp1(:2) ) ivtmp1 = nint(vtmp1/gridsize) ivtmp1 = ivtmp1 + 1 @@ -1270,7 +1271,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& write(6,'("Determined shifts (gridsize:",3(2X,F6.4),")")') gridsize write(6,'(" num fit_val x y z")') do i=1,nstore - res_shifts(i,:) = dble(shift_store(i,:))/dble(ngrid(:)-1) + res_shifts(i,:) = real(shift_store(i,:),real32)/real(ngrid(:)-1,real32) res_shifts(i,:2) = res_shifts(i,:2) + add(:2) write(6,'(1X,I3,":",2X,F6.2,3(2X,I3))') i,fit_store(i),shift_store(i,:) end do diff --git a/src/fortran/mod_swapping.f90 b/src/fortran/mod_swapping.f90 index bac183d..1d6a639 100644 --- a/src/fortran/mod_swapping.f90 +++ b/src/fortran/mod_swapping.f90 @@ -4,15 +4,15 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module swapping - use constants, only: ierror - use misc, only: sort1D + use artemis__constants, only: real32, ierror + use artemis__misc, only: sort1D use misc_maths, only: gauss use misc_linalg, only: modu - use rw_geom, only: bas_type,clone_bas + use artemis__geom_rw, only: basis_type use mod_sym, only: sym_setup,check_sym,sym_type,basmap_type,basis_map - use io, only: err_abort + use artemis__io_utils, only: err_abort implicit none - double precision :: tiny=5.0D-5 + real(real32) :: tiny=5.0D-5 logical :: lmirror type(basmap_type) :: bas_map @@ -35,28 +35,28 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& integer :: axis,nswap integer :: nabove,nbelow,nswaps_per_cell,nfail !,nperm real :: udef_sigma,small_sigma - double precision :: dintf,dist - type(bas_type) :: tmpbas,store_bas + real(real32) :: dintf,dist + type(basis_type) :: tmpbas,store_bas type(sym_type) :: grp - !double precision, dimension(4,4) :: intf_sym + !real(real32), dimension(4,4) :: intf_sym integer, allocatable, dimension(:) :: spec_list integer, allocatable, dimension(:) :: lw_close_list,up_close_list real, allocatable, dimension(:) :: lw_dist_list,up_dist_list real, allocatable, dimension(:) :: lw_weight_list,up_weight_list integer, allocatable, dimension(:,:) :: pos_list,up_list,lw_list - double precision, allocatable, dimension(:,:) :: bas_list - double precision, dimension(4,4) :: intf_sym + real(real32), allocatable, dimension(:,:) :: bas_list + real(real32), dimension(4,4) :: intf_sym integer, intent(in) :: iswap real, intent(in) :: width real, optional, intent(in) :: sigma logical, optional, intent(in) :: require_mirror - type(bas_type), intent(in) :: bas + type(basis_type), intent(in) :: bas integer, allocatable, dimension(:), intent(in) :: seed - double precision, dimension(2), intent(in) :: intf_loc !USE 1 - type(bas_type), allocatable, dimension(:) :: bas_arr - double precision, dimension(3,3), intent(in) :: lat + real(real32), dimension(2), intent(in) :: intf_loc !USE 1 + type(basis_type), allocatable, dimension(:) :: bas_arr + real(real32), dimension(3,3), intent(in) :: lat !!!----------------------------------------------------------------------------- @@ -65,7 +65,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& grp%nsymop = 1 nfail=50 if(present(sigma))then - if(sigma.lt.0.D0)then + if(sigma.lt.0._real32)then udef_sigma = 0.05 else udef_sigma = sigma @@ -121,8 +121,8 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& !!! set up symmetries !!!----------------------------------------------------------------------------- call sym_setup(grp,lat) - call clone_bas(bas,tmpbas,trans_dim=.true.) - call clone_bas(tmpbas,store_bas,trans_dim=.true.) + call tmpbas%copy(bas) + call store_bas%copy(tmpbas) !!!----------------------------------------------------------------------------- @@ -148,7 +148,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& intf_sym_loop: do i=1,grp%nsymop !if(symops(i).eq.1) cycle intf_sym_loop if(abs(grp%sym(i,4,axis)).lt.tiny) cycle intf_sym_loop - if(abs(grp%sym(i,axis,axis)+1.D0).gt.tiny) cycle intf_sym_loop + if(abs(grp%sym(i,axis,axis)+1._real32).gt.tiny) cycle intf_sym_loop intf_sym(1:4,1:4) = grp%sym(i,1:4,1:4) bas_map = basis_map(intf_sym,tmpbas) lmirror = .true. @@ -285,10 +285,10 @@ subroutine check_intf(lat,bas,dintf,width,lw_list,up_list,nbelow,nabove,bas_list implicit none integer :: i,itmp1,itmp2 integer :: nbelow,nabove,axis - double precision :: dintf,width - type(bas_type) :: bas - double precision, dimension(3,3) :: lat - double precision, dimension(:,:) :: bas_list + real(real32) :: dintf,width + type(basis_type) :: bas + real(real32), dimension(3,3) :: lat + real(real32), dimension(:,:) :: bas_list integer, allocatable, dimension(:,:) :: lw_list,up_list,pos_list @@ -334,7 +334,7 @@ subroutine rand_swap(bas,swap_bas,nabove,nbelow,nswaps_per_cell,up_list,lw_list) integer :: lw_remove,up_remove,nabove,nbelow,nswaps_per_cell real :: r_rand integer, allocatable, dimension(:,:) :: swap_list,up_list,lw_list - type(bas_type) :: bas,swap_bas + type(basis_type) :: bas,swap_bas !!!----------------------------------------------------------------------------- !!! randomly select atoms above and below the interface @@ -433,15 +433,15 @@ subroutine check_intf_depth(lat,bas,axis,intf_loc,sigma,& integer :: i,is,ia integer :: nbelow,nabove real :: rtol - double precision, dimension(2) :: midpoint + real(real32), dimension(2) :: midpoint integer, allocatable, dimension(:) :: tmp_list1,tmp_list2 real, allocatable, dimension(:) :: tmp_dist_list1,tmp_dist_list2 integer, intent(in) :: axis real, intent(in) :: sigma - type(bas_type), intent(in) :: bas - double precision, dimension(2), intent(in) :: intf_loc - double precision, dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: bas + real(real32), dimension(2), intent(in) :: intf_loc + real(real32), dimension(3,3), intent(in) :: lat integer, allocatable, dimension(:), intent(out) :: spec_list integer, allocatable, dimension(:), intent(out) :: lw_close_list,up_close_list @@ -456,12 +456,12 @@ subroutine check_intf_depth(lat,bas,axis,intf_loc,sigma,& rtol = 0.1/modu(lat(axis,:)) midpoint(1) = (intf_loc(1) + intf_loc(2))/2 - midpoint(2) = (1.D0 + intf_loc(1) + intf_loc(2))/2 + midpoint(2) = (1._real32 + intf_loc(1) + intf_loc(2))/2 if(midpoint(1).lt.intf_loc(1)) & - midpoint(1) = midpoint(1) + 1.D0 + midpoint(1) = midpoint(1) + 1._real32 if(midpoint(2).gt.intf_loc(1)) & - midpoint(2) = midpoint(2) - 1.D0 + midpoint(2) = midpoint(2) - 1._real32 !!!----------------------------------------------------------------------------- @@ -594,9 +594,9 @@ subroutine rand_swap_depth(bas,swap_bas,& integer, dimension(:,:), intent(in) :: lw_list,up_list real, intent(in) :: sigma,small_sigma - type(bas_type), intent(inout) :: swap_bas + type(basis_type), intent(inout) :: swap_bas integer, intent(in) :: nswaps_per_cell - type(bas_type), intent(in) :: bas + type(basis_type), intent(in) :: bas ! make a list of natoms long, with each location pointing to a specific atomic species and number From 45e8f269673438b17b078f8a1da22cbbbf25c553 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 08:43:31 +0100 Subject: [PATCH 025/137] Move file --- src/fortran/{ => lib}/mod_help.f90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/fortran/{ => lib}/mod_help.f90 (100%) diff --git a/src/fortran/mod_help.f90 b/src/fortran/lib/mod_help.f90 similarity index 100% rename from src/fortran/mod_help.f90 rename to src/fortran/lib/mod_help.f90 From 49ac7045609596e7adaf6e0aa886938f78e55ee9 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 08:43:39 +0100 Subject: [PATCH 026/137] Update makefile --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 1bcf9c1..a7704de 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -57,6 +57,7 @@ set(LIB_FILES mod_misc.f90 mod_misc_types.f90 mod_io_utils.F90 + mod_help.f90 mod_misc_maths.f90 mod_misc_linalg.f90 mod_rw_geom.f90 @@ -69,7 +70,6 @@ set(LIB_FILES # Main source files set(SPECIAL_LIB_FILES aspect.f90 - mod_help.f90 mod_intf_identifier.f90 mod_plane_matching.f90 mod_lat_compare.f90 From 1ad29991b97d46eeb87041271712d9b17d806975 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 08:45:25 +0100 Subject: [PATCH 027/137] Add termination generator type --- app/main.f90 | 19 +++--- src/fortran/artemis.f90 | 3 + src/fortran/mod_generator.f90 | 106 ++++++++++++++++++++-------------- 3 files changed, 78 insertions(+), 50 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 5f1bc80..ffda2a6 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -9,7 +9,8 @@ program artemis_executable implicit none - type(artemis_generator_type) :: generator + type(artemis_termination_generator_type) :: term_gen + type(artemis_interface_generator_type) :: intf_gen @@ -31,12 +32,12 @@ program artemis_executable write(6,'(1X,"task ",I0," set",/,1X,"Performing Cell Edits")') task if(lsurf_gen)then write(0,'(1X,"Finding terminations for lower material.")') - generator%layer_separation_cutoff(1) = layer_sep - call generator%gen_terminations(struc1_bas,lw_mplane,axis,& + term_gen%layer_separation_cutoff = layer_sep + call term_gen%generate(struc1_bas,lw_mplane,axis,& num_layers = lw_num_layers, & thickness = lw_thickness & ) - call generator%write_terminations(directory = "DTERMINATIONS") + call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "term_") write(0,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop end if @@ -61,22 +62,24 @@ program artemis_executable write(6,'("Skipping...")') else write(6,'(1X,"Finding terminations for lower material.")') - generator%layer_separation_cutoff(1) = lw_layer_sep - call generator%gen_terminations(struc1_bas,lw_mplane,axis,& + term_gen%layer_separation_cutoff = lw_layer_sep + call term_gen%generate(struc1_bas,lw_mplane,axis,& num_layers = lw_num_layers, & thickness = lw_thickness & ) + call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "lw_") end if if(all(up_mplane.eq.0))then write(6,'("No Miller plane defined for upper material.")') write(6,'("Skipping...")') else write(6,'(1X,"Finding terminations for upper material.")') - generator%layer_separation_cutoff(2) = up_layer_sep - call generator%gen_terminations(struc2_bas,up_mplane,axis,& + term_gen%layer_separation_cutoff = up_layer_sep + call term_gen%generate(struc2_bas,up_mplane,axis,& num_layers = up_num_layers, & thickness = up_thickness & ) + call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "up_") end if write(6,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop diff --git a/src/fortran/artemis.f90 b/src/fortran/artemis.f90 index 0c6f2c4..3cc8d6f 100644 --- a/src/fortran/artemis.f90 +++ b/src/fortran/artemis.f90 @@ -3,4 +3,7 @@ module artemis use artemis__generator implicit none + + ! allow the identify_interface procedure to be called externally + end module artemis \ No newline at end of file diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 2794b92..5a464f2 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -36,9 +36,29 @@ module artemis__generator type(bulk_DON_type), dimension(2) :: bulk_DON + type :: abstract_artemis_generator_type + integer :: max_num_structures = 100 - type :: artemis_generator_type - integer :: max_num_structures = 100 + real(real32) :: tol_cart + real(real32), dimension(3) :: tol_crys + + type(basis_type), dimension(:), allocatable :: structures + contains + procedure, pass(this) :: write_structures + end type abstract_artemis_generator_type + + + + type, extends(abstract_artemis_generator_type) :: artemis_termination_generator_type + + real(real32) :: layer_separation_cutoff = 1._real32 + + contains + procedure, pass(this) :: generate => gen_terminations + end type artemis_termination_generator_type + + + type, extends(abstract_artemis_generator_type) :: artemis_interface_generator_type integer :: match_method = 0 integer :: max_num_matches = 5 integer :: max_num_term = 5 @@ -49,20 +69,13 @@ module artemis__generator real(real32) :: bondlength_cutoff = 6._real32 real(real32), dimension(2) :: layer_separation_cutoff = 1._real32 - real(real32) :: tol_cart - real(real32), dimension(3) :: tol_crys - type(tol_type) :: tolerance - type(basis_type), dimension(:), allocatable :: term_structures_lw - type(basis_type), dimension(:), allocatable :: term_structures_up - type(basis_type), dimension(:), allocatable :: structures + ! type(basis_type), dimension(:), allocatable :: term_structures_lw + ! type(basis_type), dimension(:), allocatable :: term_structures_up contains procedure, pass(this) :: set_tolerance - procedure, pass(this) :: gen_terminations - procedure, pass(this) :: write_terminations - end type artemis_generator_type - + end type artemis_interface_generator_type contains @@ -77,7 +90,7 @@ subroutine set_tolerance( & implicit none ! Arguments - class(artemis_generator_type), intent(inout) :: this + class(artemis_interface_generator_type), intent(inout) :: this !! Instance of artemis generator type real(real32), intent(in), optional :: vector_mismatch !! Tolerance for the vector mismatch @@ -164,7 +177,7 @@ subroutine gen_terminations( & implicit none ! Arguments - class(artemis_generator_type), intent(inout) :: this + class(artemis_termination_generator_type), intent(inout) :: this !! Instance of artemis generator type type(basis_type), intent(in) :: basis !! Atomic structure data @@ -177,11 +190,16 @@ subroutine gen_terminations( & real(real32), intent(in), optional :: thickness !! Thickness of the slab (in Å) + type(basis_type), dimension(:), allocatable :: output + !! Output structures + ! Local variables - integer :: itmp1, iterm, term_start, term_end, iterm_step + integer :: itmp1, iterm, term_start, term_end, iterm_step, i !! Termination loop variables integer :: old_natom, ncells, ntrans !! Number of cells in the slab + integer :: num_structures + !! Number of structures to be generated integer :: num_layers_ !! Number of layers in the slab real(real32) :: height @@ -242,7 +260,7 @@ subroutine gen_terminations( & ! get the terminations term = get_terminations( & tmp_bas1%lat, tmp_bas1, axis, & - lprint = .true., layer_sep = this%layer_separation_cutoff(1), & + lprint = .true., layer_sep = this%layer_separation_cutoff, & break_on_fail = lbreak_on_no_term & ) if(term%nterm .eq. 0)then @@ -282,43 +300,51 @@ subroutine gen_terminations( & !--------------------------------------------------------------------------- ! loop over terminations and write them !--------------------------------------------------------------------------- - if(.not.allocated(this%term_structures_lw))then - allocate(this%term_structures_lw(0)) - end if + num_structures = ( term_end - term_start ) / iterm_step + 1 + allocate(output(num_structures)) do iterm = term_start, term_end, iterm_step - call tmp_bas2%copy(tmp_bas1) + i = ( iterm - term_start ) / iterm_step + 1 + call output(i)%copy(tmp_bas1) if(allocated(t1bas_map)) deallocate(t1bas_map) allocate(t1bas_map,source=bas_map) - call prepare_slab(tmp_bas2%lat,tmp_bas2,bas_map,term,iterm,& + call prepare_slab(output(i)%lat,output(i),bas_map,term,iterm,& num_layers_,ncells, thickness, height,ludef_surf,lw_surf(2),& "lw",lignore,lortho,vacuum) - this%term_structures_lw = [ this%term_structures_lw, tmp_bas2 ] end do + if(.not.allocated(this%structures))then + call move_alloc(output,this%structures) + else + this%structures = [ this%structures, output ] + end if - end subroutine gen_terminations + end subroutine gen_terminations !############################################################################### !############################################################################### - subroutine write_terminations( & - this, directory & + subroutine write_structures( & + this, directory, prefix & ) !! Write the generated terminations to file implicit none ! Arguments - class(artemis_generator_type), intent(in) :: this + class(abstract_artemis_generator_type), intent(in) :: this !! Instance of artemis generator type character(len=*), intent(in) :: directory !! Directory to write the files to + character(len=*), intent(in), optional :: prefix + !! Prefix for the output files ! Local variables integer :: i !! Loop variable integer :: unit !! File unit number - character(len=256) :: filename + character(len=256) :: filename, filename_template !! File name for the output files + character(len=:), allocatable :: prefix_ + !! Prefix for the output files @@ -326,30 +352,26 @@ subroutine write_terminations( & call system('mkdir -p '//trim(adjustl(directory))) end if - if(allocated(this%term_structures_lw))then - do i = 1, size(this%term_structures_lw) - write(filename,'("POSCAR_term_lw",I0)') i - if(trim(directory).ne."") then - filename = trim(directory) // "/" // trim(filename) - end if - open(newunit=unit,file=filename) - call geom_write(unit, this%term_structures_lw(i)) - close(unit) - end do + filename_template = "POSCAR" + if(present(prefix)) then + prefix_ = trim(to_lower(prefix)) + filename_template = trim(filename_template) // "_" // trim(prefix_) end if - if(allocated(this%term_structures_up))then - do i = 1, size(this%term_structures_up) - write(filename,'("POSCAR_term_up",I0)') i + if(allocated(this%structures))then + do i = 1, size(this%structures) + write(filename,'(A,I0)') trim(filename_template), i if(trim(directory).ne."") then filename = trim(directory) // "/" // trim(filename) end if open(newunit=unit,file=filename) - call geom_write(unit, this%term_structures_up(i)) + call geom_write(unit, this%structures(i)) close(unit) end do + else + write(0,'(1X,"No structures to write.")') end if - end subroutine write_terminations + end subroutine write_structures !############################################################################### From ccd911b476218a62250e05ceb388617b228d1a5d Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 13:49:10 +0100 Subject: [PATCH 028/137] Update interface generator type --- app/main.f90 | 6 +- src/fortran/aspect.f90 | 4 +- src/fortran/lib/mod_edit_geom.f90 | 93 ++++++------- src/fortran/lib/mod_sym.f90 | 2 +- src/fortran/mod_generator.f90 | 214 ++++++++++++++++-------------- 5 files changed, 171 insertions(+), 148 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index ffda2a6..7c4c8e9 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -90,11 +90,9 @@ program artemis_executable !! interface generator !!------------------------------------------------------------------------- if(irestart.eq.0)then - call gen_interfaces(tolerance,& - struc1_lat,struc2_lat,& - struc1_bas,struc2_bas) + call intf_gen%generate(struc1_bas, struc2_bas) else - call gen_interfaces_restart(struc1_lat,struc1_bas) + call intf_gen%restart(struc1_bas) end if diff --git a/src/fortran/aspect.f90 b/src/fortran/aspect.f90 index 21220ff..7626c14 100644 --- a/src/fortran/aspect.f90 +++ b/src/fortran/aspect.f90 @@ -71,7 +71,7 @@ subroutine edit_structure(lat,bas,ofile,edits,lnorm) case(ishift_region_index) call err_abort('ERROR: SHIFT REGION NOT YET SET UP. ISSUE WITH BOUNDS') case(ivacuum_index) - call vacuumer(edited_lat,edited_bas,& + call vacuumer(edited_bas%lat,edited_bas,& edits%axis(i),edits%bounds(i,1),edits%val(i)) case(itransform_index) call transformer(basis=edited_bas,tfmat=edits%tfmat) @@ -82,7 +82,7 @@ subroutine edit_structure(lat,bas,ofile,edits,lnorm) end do if(present(lnorm))then - if(lnorm) call reducer(edited_lat,edited_bas) + if(lnorm) call reducer(edited_bas) end if diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 index 07f583a..939354b 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_edit_geom.f90 @@ -171,32 +171,36 @@ end function get_atom_height !!!############################################################################# !!! returns minimum bond within bulk !!!############################################################################# - function get_min_bulk_bond(lat,bas) result(min_bond) + function get_min_bulk_bond(basis) result(min_bond) implicit none + type(basis_type), intent(in) :: basis + integer :: is,ia,js,ja real(real32) :: dtmp1,min_bond - type(basis_type) :: bas real(real32), dimension(3) :: vdtmp1 - real(real32), dimension(3,3) :: lat min_bond=huge(0._real32) - if(bas%natom.eq.1)then - min_bond = min(modu(lat(1,:3)),modu(lat(2,:3)),modu(lat(3,:3))) + if(basis%natom.eq.1)then + min_bond = min( & + modu(basis%lat(1,:3)), & + modu(basis%lat(2,:3)), & + modu(basis%lat(3,:3)) & + ) return end if - do is=1,bas%nspec - do ia=1,bas%spec(is)%num + do is = 1, basis%nspec + do ia = 1, basis%spec(is)%num - do js=1,bas%nspec - atmloop: do ja=1,bas%spec(js)%num + do js=1,basis%nspec + atmloop: do ja=1,basis%spec(js)%num if(is.eq.js.and.ia.eq.ja) cycle atmloop - vdtmp1 = bas%spec(js)%atom(ja,:3) - bas%spec(is)%atom(ia,:3) + vdtmp1 = basis%spec(js)%atom(ja,:3) - basis%spec(is)%atom(ia,:3) vdtmp1 = & - vdtmp1(1)*lat(1,:3) + & - vdtmp1(2)*lat(2,:3) + & - vdtmp1(3)*lat(3,:3) + vdtmp1(1)*basis%lat(1,:3) + & + vdtmp1(2)*basis%lat(2,:3) + & + vdtmp1(3)*basis%lat(3,:3) dtmp1 = modu(vdtmp1) if(dtmp1.lt.min_bond) min_bond = dtmp1 end do atmloop @@ -1013,16 +1017,16 @@ end function primitive_lat !!!############################################################################# !!! Uses Buerger's algorithm to reduce cell. !!!############################################################################# - subroutine reducer(lat,bas,tmptype,ltmp) + subroutine reducer(basis,tmptype,ltmp) implicit none + type(basis_type), intent(inout) :: basis integer :: cell_type integer :: i,j,k,count,limit - real(real32), dimension(3,3) :: lat,newlat,transmat,S,tmp_mat + real(real32), dimension(3,3) :: newlat,transmat,S,tmp_mat real(real32) :: tiny,pi,pi2 logical :: verb,lreduced integer, optional :: tmptype logical, optional :: ltmp - type(basis_type) :: bas @@ -1037,22 +1041,22 @@ subroutine reducer(lat,bas,tmptype,ltmp) count=0 limit=100 lreduced=.false. - tiny=1E-5*(get_vol(lat))**(1.E0/3.E0) + tiny=1E-5*(get_vol(basis%lat))**(1.E0/3.E0) pi=4._real32*atan(1._real32) pi2=2._real32*atan(1._real32) transmat=0._real32 do i=1,3 transmat(i,i)=1._real32 end do - newlat=lat + newlat = basis%lat !!!----------------------------------------------------------------------------- !!! performs checks on the other main conditions defined by Niggli !!!----------------------------------------------------------------------------- find_reduced: do while(.not.lreduced) - count=count+1 - call mkNiggli_lat(lat,newlat,transmat,S) + count = count + 1 + call mkNiggli_lat(basis%lat,newlat,transmat,S) lreduced=reduced_check(newlat,cell_type,S) if(lreduced) exit if(verb) then @@ -1076,7 +1080,7 @@ subroutine reducer(lat,bas,tmptype,ltmp) call swap(transmat(i,:),transmat(j,:)) transmat=-transmat if(i.eq.2) cycle find_reduced - call mkNiggli_lat(lat,newlat,transmat,S) + call mkNiggli_lat(basis%lat,newlat,transmat,S) end if end do @@ -1089,7 +1093,7 @@ subroutine reducer(lat,bas,tmptype,ltmp) if(i*j*k.gt.0) then tmp_mat=reshape((/i,0,0, 0,j,0, 0,0,k/),shape(tmp_mat)) transmat=matmul(transpose(tmp_mat),transmat) - call mkNiggli_lat(lat,newlat,transmat,S) + call mkNiggli_lat(basis%lat,newlat,transmat,S) end if @@ -1101,7 +1105,7 @@ subroutine reducer(lat,bas,tmptype,ltmp) if(i*j*k.gt.0) then tmp_mat=reshape((/i,0,0, 0,j,0, 0,0,k/),shape(tmp_mat)) transmat=matmul(transpose(tmp_mat),transmat) - call mkNiggli_lat(lat,newlat,transmat,S) + call mkNiggli_lat(basis%lat,newlat,transmat,S) end if @@ -1169,7 +1173,7 @@ subroutine reducer(lat,bas,tmptype,ltmp) tmp_mat=reshape((/-1,0,0, 0,-1,0, 0,0,-1/),shape(tmp_mat)) transmat=matmul(transpose(tmp_mat),transmat) end if - call mkNiggli_lat(lat,newlat,transmat,S) + call mkNiggli_lat(basis%lat,newlat,transmat,S) lreduced=reduced_check(newlat,cell_type,S,"n") if(verb) then write(67,*) lreduced @@ -1180,13 +1184,13 @@ subroutine reducer(lat,bas,tmptype,ltmp) !!!----------------------------------------------------------------------------- !!! Renormalises the lattice and basis into the new lattice !!!----------------------------------------------------------------------------- - lat=newlat - do i=1,bas%nspec - do j=1,bas%spec(i)%num - bas%spec(i)%atom(j,:3)=& - matmul(bas%spec(i)%atom(j,:3),inverse_3x3(transmat)) - bas%spec(i)%atom(j,:3)=& - bas%spec(i)%atom(j,:3)-floor(bas%spec(i)%atom(j,:3)) + basis%lat = newlat + do i = 1, basis%nspec + do j = 1, basis%spec(i)%num + basis%spec(i)%atom(j,:3) = & + matmul( basis%spec(i)%atom(j,:3), inverse_3x3(transmat) ) + basis%spec(i)%atom(j,:3) = & + basis%spec(i)%atom(j,:3) - floor( basis%spec(i)%atom(j,:3) ) end do end do @@ -2334,35 +2338,35 @@ end function get_wyckoff !!!############################################################################# !!! identify the shortest bond in the crystal, takes in crystal basis !!!############################################################################# - function get_shortest_bond(lat,bas) result(bond) + function get_shortest_bond(basis) result(bond) implicit none + type(basis_type), intent(in) :: basis + integer :: is,js,ia,ja,ja_start real(real32) :: dist,min_bond - type(basis_type), intent(in) :: bas type(bond_type) :: bond real(real32), dimension(3) :: vec integer, dimension(2,2) :: atoms - real(real32), dimension(3,3) :: lat - min_bond = 100._real32 + min_bond = huge(1._real32) atoms = 0 - do is=1,bas%nspec - do js=is,bas%nspec - do ia=1,bas%spec(is)%num + do is = 1, basis%nspec + do js = is, basis%nspec + do ia = 1, basis%spec(is)%num if(is.eq.js)then - ja_start = ia+1 + ja_start = ia + 1 else ja_start = 1 end if - do ja=ja_start,bas%spec(js)%num - vec = bas%spec(is)%atom(ia,:3) - bas%spec(js)%atom(ja,:3) + do ja=ja_start,basis%spec(js)%num + vec = basis%spec(is)%atom(ia,:3) - basis%spec(js)%atom(ja,:3) vec = vec - ceiling(vec - 0.5_real32) - vec = matmul(vec,lat) + vec = matmul(vec,basis%lat) dist = modu(vec) if(dist.lt.min_bond)then min_bond = dist - atoms(1,:) = (/is, ia/) - atoms(2,:) = (/js, ja/) + atoms(1,:) = [ is, ia ] + atoms(2,:) = [ js, ja ] end if end do end do @@ -2371,7 +2375,6 @@ function get_shortest_bond(lat,bas) result(bond) bond%length = min_bond bond%atoms = atoms - end function get_shortest_bond !!!############################################################################# diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 8e77862..006205a 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -1148,7 +1148,7 @@ subroutine get_primitive_cell(lat,bas) !!----------------------------------------------------------------------- !! Reduce the lattice to symmetry definition !!----------------------------------------------------------------------- - call reducer(lat, bas) + call reducer(bas) !! next line necessary as FCC and BCC do not conform to Niggli reduced ... !! ... cell definitions. lat = primitive_lat(lat) diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 5a464f2..33394a8 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -54,7 +54,7 @@ module artemis__generator real(real32) :: layer_separation_cutoff = 1._real32 contains - procedure, pass(this) :: generate => gen_terminations + procedure, pass(this) :: generate => generate_terminations end type artemis_termination_generator_type @@ -75,6 +75,8 @@ module artemis__generator ! type(basis_type), dimension(:), allocatable :: term_structures_up contains procedure, pass(this) :: set_tolerance + procedure, pass(this) :: generate => generate_interfaces + procedure, pass(this) :: restart => generate_intefaces_from_existing end type artemis_interface_generator_type contains @@ -170,7 +172,7 @@ end subroutine set_tolerance !############################################################################### - subroutine gen_terminations( & + subroutine generate_terminations( & this, basis, miller_plane, axis, num_layers, thickness & ) !! Generate and prints terminations parallel to the supplied miller plane @@ -292,7 +294,7 @@ subroutine gen_terminations( & ! Normalise lattice !--------------------------------------------------------------------------- if(lnorm_lat)then - call reducer(tmp_bas1%lat,tmp_bas1) + call reducer(tmp_bas1) tmp_bas1%lat = MATNORM(tmp_bas1%lat) end if @@ -317,7 +319,7 @@ subroutine gen_terminations( & this%structures = [ this%structures, output ] end if - end subroutine gen_terminations + end subroutine generate_terminations !############################################################################### @@ -378,28 +380,36 @@ end subroutine write_structures !!!############################################################################# !!! generate interfaces !!!############################################################################# - subroutine gen_interfaces_restart(lat,bas) + subroutine generate_intefaces_from_existing(this, basis) + !! Generate interfaces for the given basis implicit none + + ! Arguments + class(artemis_interface_generator_type), intent(inout) :: this + !! Instance of artemis generator type + type(basis_type), intent(in) :: basis + !! Atomic structure data + + ! Local variables integer :: is,ia,js,ja + !! Loop variables real(real32) :: dtmp1,min_bond,min_bond1,min_bond2 - type(basis_type) :: bas + !! Minimum bond length type(intf_info_type) :: intf + !! Interface information real(real32), dimension(3) :: vtmp1 - real(real32), dimension(3,3) :: lat + !! Temporary vector - call system('mkdir -p '//trim(adjustl(dirname))) - call chdir(dirname) - min_bond1=huge(0._real32) min_bond2=huge(0._real32) if(any(udef_intf_loc.lt.0._real32))then if(ludef_axis)then - intf=get_interface(lat,bas,axis) + intf=get_interface(basis%lat,basis,axis) else - intf=get_interface(lat,bas) + intf=get_interface(basis%lat,basis) end if - intf%loc=intf%loc/modu(lat(intf%axis,:)) + intf%loc=intf%loc/modu(basis%lat(intf%axis,:)) write(6,*) "interface axis:",intf%axis write(6,*) "interface loc:",intf%loc !! write interface location to a file for user to refer back to @@ -411,28 +421,28 @@ subroutine gen_interfaces_restart(lat,bas) intf%axis = axis intf%loc = udef_intf_loc end if - specloop1: do is=1,bas%nspec - atomloop1: do ia=1,bas%spec(is)%num + specloop1: do is=1,basis%nspec + atomloop1: do ia=1,basis%spec(is)%num - specloop2: do js=1,bas%nspec - atomloop2: do ja=1,bas%spec(js)%num + specloop2: do js=1,basis%nspec + atomloop2: do ja=1,basis%spec(js)%num if(is.eq.js.and.ia.eq.ja) cycle atomloop2 if( & - ( bas%spec(is)%atom(ia,intf%axis).gt.intf%loc(1).and.& - bas%spec(is)%atom(ia,intf%axis).lt.intf%loc(2) ).and.& - ( bas%spec(js)%atom(ja,intf%axis).gt.intf%loc(1).and.& - bas%spec(js)%atom(ja,intf%axis).lt.intf%loc(2) ) )then - vtmp1 = (bas%spec(is)%atom(ia,:3)-bas%spec(js)%atom(ja,:3)) - vtmp1 = matmul(vtmp1,lat) + ( basis%spec(is)%atom(ia,intf%axis).gt.intf%loc(1).and.& + basis%spec(is)%atom(ia,intf%axis).lt.intf%loc(2) ).and.& + ( basis%spec(js)%atom(ja,intf%axis).gt.intf%loc(1).and.& + basis%spec(js)%atom(ja,intf%axis).lt.intf%loc(2) ) )then + vtmp1 = (basis%spec(is)%atom(ia,:3)-basis%spec(js)%atom(ja,:3)) + vtmp1 = matmul(vtmp1,basis%lat) dtmp1 = modu(vtmp1) if(dtmp1.lt.min_bond1) min_bond1 = dtmp1 elseif( & - ( bas%spec(is)%atom(ia,intf%axis).lt.intf%loc(1).or.& - bas%spec(is)%atom(ia,intf%axis).gt.intf%loc(2) ).and.& - ( bas%spec(js)%atom(ja,intf%axis).lt.intf%loc(1).or.& - bas%spec(js)%atom(ja,intf%axis).gt.intf%loc(2) ) )then - vtmp1 = (bas%spec(is)%atom(ia,:3)-bas%spec(js)%atom(ja,:3)) - vtmp1 = matmul(vtmp1,lat) + ( basis%spec(is)%atom(ia,intf%axis).lt.intf%loc(1).or.& + basis%spec(is)%atom(ia,intf%axis).gt.intf%loc(2) ).and.& + ( basis%spec(js)%atom(ja,intf%axis).lt.intf%loc(1).or.& + basis%spec(js)%atom(ja,intf%axis).gt.intf%loc(2) ) )then + vtmp1 = (basis%spec(is)%atom(ia,:3)-basis%spec(js)%atom(ja,:3)) + vtmp1 = matmul(vtmp1,basis%lat) dtmp1 = modu(vtmp1) if(dtmp1.lt.min_bond2) min_bond2 = dtmp1 end if @@ -446,20 +456,33 @@ subroutine gen_interfaces_restart(lat,bas) min_bond = ( min_bond1 + min_bond2 )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond write(6,'(1X,"Trans-interfacial scaling factor:",F0.3)') c_scale - call gen_shifts_and_swaps(lat,bas,intf%axis,intf%loc,min_bond,& + call gen_shifts_and_swaps(basis,intf%axis,intf%loc,min_bond,& ishift,nshift,& iswap,swap_den,nswap) - end subroutine gen_interfaces_restart + end subroutine generate_intefaces_from_existing !!!############################################################################# !!!############################################################################# !!! generate interfaces !!!############################################################################# - subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) + subroutine generate_interfaces(this, basis_lw, basis_up) + !! Generate interfaces from two bulk structures implicit none + + ! Arguments + class(artemis_interface_generator_type), intent(inout) :: this + !! Instance of artemis generator type + type(basis_type), intent(in) :: basis_lw + !! Lower bulk structure + type(basis_type), intent(in) :: basis_up + !! Upper bulk structure + + ! Local variables + type(basis_type) :: basis_lw_, basis_up_ + integer :: j,iterm,jterm,ntrans,ifit,iunique,old_natom,itmp1,old_intf integer :: iterm_step,jterm_step integer :: lw_ncells,up_ncells @@ -473,7 +496,6 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) character(1024) :: pwd,intf_dir,dirpath,msg, filename logical :: ludef_lw_surf,ludef_up_surf,lcycle type(basis_type) :: sbas - type(basis_type) :: inlw_bas,inup_bas type(basis_type) :: lw_bas,up_bas,tlw_bas,tup_bas type(tol_type) :: tolerance type(confine_type) :: confine @@ -483,7 +505,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) real(real32), dimension(2) :: intf_loc real(real32), dimension(3) :: init_offset=[0._real32,0._real32,2._real32] !real(real32), dimension(3,3) :: mtmp1,DONup_lat - real(real32), dimension(3,3) :: tfmat,slat,inlw_lat,inup_lat + real(real32), dimension(3,3) :: tfmat,slat real(real32), dimension(3,3) :: lw_lat,up_lat,tlw_lat,tup_lat integer, allocatable, dimension(:,:,:) :: lw_map,t1lw_map,t2lw_map integer, allocatable, dimension(:,:,:) :: up_map,t1up_map,t2up_map @@ -494,22 +516,24 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!!----------------------------------------------------------------------------- !!! determines the primitive and niggli reduced cell for each bulk !!!----------------------------------------------------------------------------- + call basis_lw_%copy(basis_lw) + call basis_up_%copy(basis_up) write(6,*) if(lw_use_pricel)then write(6,'(1X,"Using primitive cell for lower material")') - call get_primitive_cell(inlw_lat,inlw_bas) + call get_primitive_cell(basis_lw_%lat,basis_lw_) else write(6,'(1X,"Using supplied cell for lower material")') - call reducer(inlw_lat,inlw_bas) - inlw_lat=primitive_lat(inlw_lat) + call reducer(basis_lw_) + basis_lw_%lat=primitive_lat(basis_lw_%lat) end if if(up_use_pricel)then write(6,'(1X,"Using primitive cell for upper material")') - call get_primitive_cell(inup_lat,inup_bas) + call get_primitive_cell(basis_up_%lat,basis_up_) else write(6,'(1X,"Using supplied cell for upper material")') - call reducer(inup_lat,inup_bas) - inup_lat=primitive_lat(inup_lat) + call reducer(basis_up_) + basis_up_%lat=primitive_lat(basis_up_%lat) end if write(6,*) @@ -519,8 +543,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!! investigates individual bulks and their bondlengths !!!----------------------------------------------------------------------------- avg_min_bond = & - ( get_min_bulk_bond(inlw_lat,inlw_bas) + & - get_min_bulk_bond(inup_lat,inup_bas) )/2._real32 + ( get_min_bulk_bond(basis_lw_) + get_min_bulk_bond(basis_up_) )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond write(6,'(1X,"Trans-interfacial scaling factor: ",F0.3)') c_scale if(ishift.eq.-1) nshift=1 @@ -529,11 +552,11 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!!----------------------------------------------------------------------------- !!! gets bulk DONs, if ISHIFT = 4 !!!----------------------------------------------------------------------------- - allocate(lw_map(inlw_bas%nspec,maxval(inlw_bas%spec(:)%num,dim=1),2)) - allocate(up_map(inup_bas%nspec,maxval(inup_bas%spec(:)%num,dim=1),2)) + allocate(lw_map(basis_lw_%nspec,maxval(basis_lw_%spec(:)%num,dim=1),2)) + allocate(up_map(basis_up_%nspec,maxval(basis_up_%spec(:)%num,dim=1),2)) if(ishift.eq.4.or.ishift.eq.0)then lw_map=0 - bulk_DON(1)%spec=gen_DON(inlw_lat,inlw_bas,& + bulk_DON(1)%spec=gen_DON(basis_lw_%lat,basis_lw_,& dist_max=max_bondlength,& scale_dist=.false.,& norm=.true.) @@ -564,7 +587,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) end if end do up_map=0 - bulk_DON(2)%spec=gen_DON(inup_lat,inup_bas,& + bulk_DON(2)%spec=gen_DON(basis_up_%lat,basis_up_,& dist_max=max_bondlength,& scale_dist=.false.,& norm=.true.) @@ -603,7 +626,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!!----------------------------------------------------------------------------- !!! checks whether system appears layered !!!----------------------------------------------------------------------------- - lw_layered_axis=get_layered_axis(inlw_lat,inlw_bas) + lw_layered_axis=get_layered_axis(basis_lw_%lat,basis_lw_) if(.not.lw_layered.and.lw_layered_axis.gt.0)then ivtmp1=0 ivtmp1(lw_layered_axis)=1 @@ -625,7 +648,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) lw_mplane(lw_layered_axis)=1 end if - up_layered_axis=get_layered_axis(inup_lat,inup_bas) + up_layered_axis=get_layered_axis(basis_up_%lat,basis_up_) if(.not.up_layered.and.up_layered_axis.gt.0)then ivtmp1=0 ivtmp1(up_layered_axis)=1 @@ -675,53 +698,53 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) if(any(lw_mplane.ne.0))then if(imatch.ne.0)then abc="ab" - tfmat=planecutter(inlw_lat,real(lw_mplane,real32)) - call transformer(inlw_bas,tfmat,lw_map) + tfmat=planecutter(basis_lw_%lat,real(lw_mplane,real32)) + call transformer(basis_lw_,tfmat,lw_map) SAV=get_best_match(& - tolerance,& - inlw_lat,inup_lat,& - inlw_bas,inup_bas,& - abc,"abc",lprint_matches,ierror,imatch=imatch) + this%tolerance,& + basis_lw_%lat,basis_up_%lat,& + basis_lw_,basis_up_,& + trim(abc),"abc",lprint_matches,ierror,imatch=imatch) elseif(any(up_mplane.ne.0))then SAV=get_best_match(& - tolerance,& - inlw_lat,inup_lat,& - inlw_bas,inup_bas,& - abc,"abc",lprint_matches,ierror,imatch=imatch,& + this%tolerance,& + basis_lw_%lat,basis_up_%lat,& + basis_lw_,basis_up_,& + trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& plane1=lw_mplane,plane2=up_mplane,nmiller=nmiller) else SAV=get_best_match(& - tolerance,& - inlw_lat,inup_lat,& - inlw_bas,inup_bas,& - abc,"abc",lprint_matches,ierror,imatch=imatch,& + this%tolerance,& + basis_lw_%lat,basis_up_%lat,& + basis_lw_,basis_up_,& + trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& plane1=lw_mplane,nmiller=nmiller) end if elseif(any(up_mplane.ne.0))then SAV=get_best_match(& - tolerance,& - inlw_lat,inup_lat,& - inlw_bas,inup_bas,& - abc,"abc",lprint_matches,ierror,imatch=imatch,& + this%tolerance,& + basis_lw_%lat,basis_up_%lat,& + basis_lw_,basis_up_,& + trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& plane2=up_mplane,nmiller=nmiller) else SAV=get_best_match(& - tolerance,& - inlw_lat,inup_lat,& - inlw_bas,inup_bas,& - abc,"abc",lprint_matches,ierror,imatch=imatch,& + this%tolerance,& + basis_lw_%lat,basis_up_%lat,& + basis_lw_,basis_up_,& + trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& nmiller=nmiller) end if - if(min(tolerance%nstore,SAV%nfit).eq.0)then + if(min(this%tolerance%nstore,SAV%nfit).eq.0)then write(0,'("No matches found.")') write(0,'("Exiting...")') call exit() else write(0,'(1X,"Number of matches found: ",I0)')& - min(tolerance%nstore,SAV%nfit) + min(this%tolerance%nstore,SAV%nfit) end if write(6,'(1X,"Maximum number of generated interfaces will be: ",I0)')& - nterm*nshift*tolerance%nstore + nterm*nshift*this%tolerance%nstore if(.not.lgen_interfaces)then write(0,'(1X,"Told not to generate interfaces, just find matches.")') write(0,'("Exiting...")') @@ -742,7 +765,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) write(6,'(1X,"Generating only interfaces for match ",I0)') iintf else intf_start=1 - intf_end=min(tolerance%nstore,SAV%nfit) + intf_end=min(this%tolerance%nstore,SAV%nfit) end if iunique=0 !!!----------------------------------------------------------------------------- @@ -750,8 +773,8 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!!----------------------------------------------------------------------------- intf_loop: do ifit=intf_start,intf_end write(6,'("Fit number: ",I0)') ifit - call lw_bas%copy(inlw_bas) - call up_bas%copy(inup_bas) + call lw_bas%copy(basis_lw_) + call up_bas%copy(basis_up_) if(allocated(t1lw_map)) deallocate(t1lw_map) if(allocated(t1up_map)) deallocate(t1up_map) allocate(t1lw_map,source=lw_map) @@ -794,7 +817,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) dist_max=max_bondlength,& scale_dist=.false.,& norm=.true.) - !call err_abort_print_struc(inup_bas,"bulk_up_term.vasp",& + !call err_abort_print_struc(basis_up_,"bulk_up_term.vasp",& ! "",.false.) end if @@ -968,9 +991,9 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!----------------------------------------------------------------- !! Checks stoichiometry !!----------------------------------------------------------------- - if(tlw_bas%nspec.ne.inlw_bas%nspec.or.any(& - (inlw_bas%spec(1)%num*tlw_bas%spec(:)%num)& - /tlw_bas%spec(1)%num.ne.inlw_bas%spec(:)%num))then + if(tlw_bas%nspec.ne.basis_lw_%nspec.or.any(& + (basis_lw_%spec(1)%num*tlw_bas%spec(:)%num)& + /tlw_bas%spec(1)%num.ne.basis_lw_%spec(:)%num))then write(6,'("WARNING: This lower surface termination is not & &stoichiometric")') if(lw_layered)then @@ -980,9 +1003,9 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) cycle lw_term_loop end if end if - if(tup_bas%nspec.ne.inup_bas%nspec.or.any(& - (inup_bas%spec(1)%num*tup_bas%spec(:)%num)& - /tup_bas%spec(1)%num.ne.inup_bas%spec(:)%num))then + if(tup_bas%nspec.ne.basis_up_%nspec.or.any(& + (basis_up_%spec(1)%num*tup_bas%spec(:)%num)& + /tup_bas%spec(1)%num.ne.basis_up_%spec(:)%num))then write(6,'("WARNING: This upper surface termination is not & &stoichiometric")') if(up_layered)then @@ -1060,7 +1083,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) !!----------------------------------------------------------------- !! Generates shifts and swaps and prints the subsequent structures !!----------------------------------------------------------------- - call gen_shifts_and_swaps(slat,sbas,axis,intf_loc,avg_min_bond,& + call gen_shifts_and_swaps(sbas,axis,intf_loc,avg_min_bond,& ishift,nshift,& iswap,swap_den,nswap,t2lw_map) @@ -1083,7 +1106,7 @@ subroutine gen_interfaces(tolerance,inlw_lat,inup_lat,inlw_bas,inup_bas) return - end subroutine gen_interfaces + end subroutine generate_interfaces !!!############################################################################# @@ -1092,11 +1115,12 @@ end subroutine gen_interfaces !!! Prints these new structures to POSCARs. !!!############################################################################# !!! ISWAP METHOD NOT YET SET UP - subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& + subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& ishift,nshift,& iswap,swap_den,nswap,& map) implicit none + type(basis_type), intent(in) :: basis integer :: shift_unit=10 integer :: ounit,iaxis,k,l integer :: ngen_swaps,nswaps_per_cell @@ -1115,8 +1139,6 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& integer, intent(in) :: nshift,nswap integer, intent(in) :: ishift,iswap real(real32), intent(in) :: bond,swap_den - type(basis_type), intent(in) :: bas - real(real32), dimension(3,3), intent(in) :: lat integer, dimension(:,:,:), optional, intent(in) :: map @@ -1156,7 +1178,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& end do case(2) output_shifts = get_fit_shifts(& - lat=lat,bas=bas,& + lat=basis%lat,bas=basis,& bond=bond,& axis=axis,& intf_loc=intf_loc,& @@ -1164,7 +1186,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& nstore=nshift) case(3) output_shifts = get_descriptive_shifts(& - lat=lat,bas=bas,& + lat=basis%lat,bas=basis,& bond=bond,& axis=axis,& intf_loc=intf_loc,& @@ -1173,7 +1195,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& case(4) if(present(map))then output_shifts = get_shifts_DON(& - lat=lat,bas=bas,& + lat=basis%lat,bas=basis,& axis=axis,& intf_loc=intf_loc,& nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& @@ -1181,7 +1203,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& max_bondlength=max_bondlength) else output_shifts = get_shifts_DON(& - lat=lat,bas=bas,& + lat=basis%lat,bas=basis,& axis=axis,& intf_loc=intf_loc,& nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& @@ -1203,7 +1225,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& end do end select if(ishift.gt.0)then - output_shifts(:,axis) = output_shifts(:,axis)*modu(lat(axis,:)) + output_shifts(:,axis) = output_shifts(:,axis)*modu(basis%lat(axis,:)) end if @@ -1216,7 +1238,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& !!!----------------------------------------------------------------------------- !!! Determines number of swaps across the interface !!!----------------------------------------------------------------------------- - nswaps_per_cell=nint(swap_den*get_area([lat(abc(1),:)],[lat(abc(2),:)])) + nswaps_per_cell=nint(swap_den*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) if(iswap.ne.0)then write(6,& '(" Generating ",I0," swaps per structure ")') nswaps_per_cell @@ -1227,7 +1249,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& !!! Prints each unique shift structure !!!----------------------------------------------------------------------------- shift_loop: do k=1,nshift - call tbas%copy(bas) + call tbas%copy(basis) toffset=output_shifts(k,:3) do iaxis=1,2 call shift_region(tbas,axis,& @@ -1244,7 +1266,7 @@ subroutine gen_shifts_and_swaps(lat,bas,axis,intf_loc,bond,& basis=tbas,& axis=axis,loc=dtmp1,& vac=toffset(axis)) - min_bond = get_shortest_bond(tlat,tbas) + min_bond = get_shortest_bond(tbas) if(min_bond%length.le.1.5_real32)then write(msg,'("Smallest bond in the interface structure is\nless than 1.5 Å.")') call print_warning(trim(msg)) From 1275164ccfade15c9f708c63f0448bc86a845d16 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 14:05:33 +0100 Subject: [PATCH 029/137] Fix type conversion errors --- src/fortran/aspect.f90 | 1 - src/fortran/lib/mod_edit_geom.f90 | 46 ++++++++-------- src/fortran/lib/mod_misc.f90 | 2 +- src/fortran/lib/mod_misc_linalg.f90 | 83 +++++++++++++++-------------- src/fortran/lib/mod_sym.f90 | 20 +++---- src/fortran/mod_generator.f90 | 1 + src/fortran/mod_lat_compare.f90 | 28 +++++----- src/fortran/mod_plane_matching.f90 | 18 +++---- 8 files changed, 96 insertions(+), 103 deletions(-) diff --git a/src/fortran/aspect.f90 b/src/fortran/aspect.f90 index 7626c14..462bd5c 100644 --- a/src/fortran/aspect.f90 +++ b/src/fortran/aspect.f90 @@ -47,7 +47,6 @@ subroutine edit_structure(lat,bas,ofile,edits,lnorm) implicit none integer :: GEOMunit,i type(basis_type) :: edited_bas - real(real32), dimension(3,3) :: edited_lat character(len=*), intent(in) :: ofile logical, optional, intent(in) :: lnorm type(basis_type), intent(in) :: bas diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 index 939354b..c6295a6 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_edit_geom.f90 @@ -235,7 +235,7 @@ function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) if(present(tol))then dtol = tol else - dtol = 1.D-5 + dtol = 1.E-5_real32 end if if(present(labove))then @@ -306,7 +306,7 @@ function get_min_dist(lat,bas,loc,lignore_close,axis,labove,lreal,tol) & if(present(tol))then dtol = tol else - dtol = 1.D-5 + dtol = 1.E-5_real32 end if if(present(labove))then @@ -466,7 +466,7 @@ subroutine vacuumer(lat,bas,axis,loc,add,tol) ortho_scale = modu(lat(axis,:))/modu(normal) - rtol = 1.D-5 + rtol = 1.E-5_real32 inc = add if(present(tol)) rtol = tol cur_vac = min_dist(bas,axis,loc,.true.) - min_dist(bas,axis,loc,.false.) @@ -564,12 +564,12 @@ subroutine ortho_axis(lat,bas,axis) type(basis_type) :: bas integer, dimension(3) :: order real(real32), dimension(3) :: ortho_vec - real(real32), dimension(3,3) :: invlat,lat + real(real32), dimension(3,3) :: lat call bas%convert() - order=(/1,2,3/) - order=cshift(order,3-axis) + order = [ 1, 2, 3 ] + order = cshift( order, 3 - axis ) ortho_vec=cross(lat(order(1),:),lat(order(2),:)) ortho_comp=dot_product(lat(3,:),ortho_vec)/modu(ortho_vec)**2._real32 @@ -648,7 +648,7 @@ subroutine transformer(basis, tfmat, map) !!-------------------------------------------------------------------------- !! Convert tolerance from Å to a fraction of each direction !!-------------------------------------------------------------------------- - tol=1.D-3 !! in Å + tol = 1.E-3_real32 !! in Å do i=1,3 tolvec(i)=tol/modu(sbas%lat(i,:)) end do @@ -725,11 +725,11 @@ subroutine transformer(basis, tfmat, map) end if do ia = 1, basis%spec(is)%num do n=latmin(3),latmax(3)!,1 - translvec(3)=dble(n) + translvec(3)=real(n, real32) do m=latmin(2),latmax(2)!,1 - translvec(2)=dble(m) + translvec(2)=real(m, real32) inloop: do l=latmin(1),latmax(1)!,1 - translvec(1)=dble(l) + translvec(1)=real(l, real32) tmpbas(satom+1,:3) = & basis%spec(is)%atom(ia,:3) + matmul(translvec,invmat) !!tmpbas(satom+1,:3)=& @@ -744,7 +744,7 @@ subroutine transformer(basis, tfmat, map) if(any(tmpbas(satom+1,:).ge.1._real32-tol).or.& any(tmpbas(satom+1,:).lt.0._real32-tol)) cycle inloop !??? cycle inloop or spec_loop1? tmpbas(satom+1,:3) = tmpbas(satom+1,:3) - & - dble(floor(tmpbas(satom+1,:3))) + real(floor(tmpbas(satom+1,:3)),real32) do k=1,satom if(all(mod(abs(tmpbas(satom+1,:3)-tmpbas(k,:3)),1._real32).le.& tol)) cycle inloop @@ -1000,8 +1000,8 @@ function primitive_lat(inlat) result(plat) !tfmat=matmul(tfmat,transpose(tfmat)) tmat2=matmul(special(i,:,:),transpose(special(i,:,:))) dtmp1=tmat2(1,1)/tmat1(1,1) - !if(all(abs(tfmat-nint(tfmat)).lt.1.D-8))then - if(all(abs(tmat1*dtmp1-tmat2).lt.1.D-8))then + !if(all(abs(tfmat-nint(tfmat)).lt.1.E-8_real32))then + if(all(abs(tmat1*dtmp1-tmat2).lt.1.E-8_real32))then do j=1,3 plat(j,:)=scal(j)*special(i,j,:) end do @@ -1324,7 +1324,7 @@ function planecutter(inlat,invec) result(tfmat) !!!----------------------------------------------------------------------------- !!! Initialise variables and matrices !!!----------------------------------------------------------------------------- - tol=1.D-4 + tol = 1.E-4_real32 vec=invec lat=inlat invlat=inverse(lat) @@ -1599,12 +1599,10 @@ function basis_stack(basis1,basis2,axis,offset,length,map1,map2) result(output) !! Maps for atoms in the two bases. ! Local variables - integer :: i, j, k, itmp, length_ + integer :: i, j, k, length_ !! Loop counters. real(real32) :: loc, c1_ratio, c2_ratio, zgap, add !! Lattice parameters. - logical :: lmap - !! Boolean for map presence. type(basis_type) :: basis1_, basis2_ integer, dimension(3) :: order !! Order of axes. @@ -1614,8 +1612,6 @@ function basis_stack(basis1,basis2,axis,offset,length,map1,map2) result(output) !! Offset for the merged basis. integer, allocatable, dimension(:) :: match !! Array to match species. - integer, allocatable, dimension(:,:,:) :: new_map - !! New map for merged basis. !--------------------------------------------------------------------------- @@ -1928,7 +1924,7 @@ subroutine get_bulk(lat,bas,axis,bulk_lat,bulk_bas) atom_loop2: do ja=1,splitbas(2)%spec(is)%num if( all( abs( ( splitbas(1)%spec(is)%atom(ia,:3) + transvec ) - & - splitbas(2)%spec(is)%atom(ja,:3) ).lt.1.D-5 ) )then + splitbas(2)%spec(is)%atom(ja,:3) ).lt.1.E-5_real32 ) )then write(0,*) ia,ja cycle atom_loop1 @@ -2192,7 +2188,7 @@ function get_wyckoff(bas,axis) result(wyckoff) !! Checks atoms within a region to see if they reproduce layer above !!----------------------------------------------------------------------- up_loc = lw_loc + transvec(axis) - !if(lw_loc.eq.up_loc) up_loc = up_loc + 1.D-8 !! IS THIS NEEDED? + !if(lw_loc.eq.up_loc) up_loc = up_loc + 1.E-8_real32 !! IS THIS NEEDED? if(lw_loc.gt.up_loc)then write(0,'("ERROR: Internal error in get_wyckoff")') write(0,'(2X,"Error in subroutine get_wyckoff in mod_edit_geom.f90")') @@ -2218,7 +2214,7 @@ function get_wyckoff(bas,axis) result(wyckoff) tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5_real32 ) - if( all( abs(tmp_vec2).lt.1.D-5 ) )then + if( all( abs(tmp_vec2).lt.1.E-5_real32 ) )then cycle atom_loop1 end if @@ -2245,11 +2241,11 @@ function get_wyckoff(bas,axis) result(wyckoff) if(bas%spec(is)%atom(ia,axis).lt.lw_loc2.or.& bas%spec(is)%atom(ia,axis).ge.up_loc2) cycle atom_loop3 tmp_vec1 = bas%spec(is)%atom(ia,:3) + transvec - if( all(bas%spec(is)%atom(:,axis).lt.tmp_vec1(axis)-1.D-5) ) cycle atom_loop3 + if( all(bas%spec(is)%atom(:,axis).lt.tmp_vec1(axis)-1.E-5_real32) ) cycle atom_loop3 atom_loop4: do ja=1,bas%spec(is)%num tmp_vec2 = tmp_vec1 - bas%spec(is)%atom(ja,:3) tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5_real32 ) - if( all( abs(tmp_vec2).lt.1.D-5 ) )then + if( all( abs(tmp_vec2).lt.1.E-5_real32 ) )then cycle atom_loop3 end if end do atom_loop4 @@ -2303,7 +2299,7 @@ function get_wyckoff(bas,axis) result(wyckoff) tmp_vec3 = tmp_vec3 - ceiling(tmp_vec3 - 0.5_real32) !THIS IS WHERE WE NEED TO MAKE IT RIGHT !! FIND THE GCD AND DIVIDE - if(all(abs(tmp_vec3).lt.1.D-5))then + if(all(abs(tmp_vec3).lt.1.E-5_real32))then if(wyckoff%spec(is)%atom(ja).ne.0)then wyckoff%spec(is)%atom(ia) = wyckoff%spec(is)%atom(ja) else diff --git a/src/fortran/lib/mod_misc.f90 b/src/fortran/lib/mod_misc.f90 index 17ed52c..99e4f4f 100644 --- a/src/fortran/lib/mod_misc.f90 +++ b/src/fortran/lib/mod_misc.f90 @@ -196,7 +196,7 @@ subroutine rset(arr, tol) if(present(tol))then tiny = tol else - tiny = 1.D-4 + tiny = 1.E-4_real32 end if call sort1D(arr) diff --git a/src/fortran/lib/mod_misc_linalg.f90 b/src/fortran/lib/mod_misc_linalg.f90 index fa09f82..889952d 100644 --- a/src/fortran/lib/mod_misc_linalg.f90 +++ b/src/fortran/lib/mod_misc_linalg.f90 @@ -241,7 +241,7 @@ function ivec_dmat_mul(a,mat) result(vec) vec=0._real32 allocate(vec(size(a))) do j=1,size(a) - vec(:)=vec(:)+dble(a(j))*mat(j,:) + vec(:)=vec(:)+real(a(j),real32)*mat(j,:) end do return @@ -366,12 +366,13 @@ end function get_vol !!!##################################################### !!! finds trace of an arbitrary dimension square matrix !!!##################################################### - function trace(mat) + function trace(mat) result(output) integer::j - real(real32),dimension(:,:)::mat - real(real32)::trace - do j=1,size(mat,1) - trace=trace+mat(j,j) + real(real32), dimension(:,:), intent(in) :: mat + real(real32) :: output + output = 0._real32 + do j = 1, size(mat,1) + output = output + mat(j,j) end do end function trace !!!##################################################### @@ -380,22 +381,22 @@ end function trace !!!##################################################### !!! returns determinant of 3 x 3 matrix !!!##################################################### - function idet(mat) result(det) - integer :: det - integer, dimension(3,3) :: mat + function idet(mat) result(output) + integer :: output + integer, 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)& + output = 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) end function idet !!!----------------------------------------------------- !!!----------------------------------------------------- - function ddet(mat) result(det) - real(real32) :: det - real(real32), dimension(3,3) :: mat + function ddet(mat) result(output) + real(real32) :: 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)& + output = 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) @@ -411,9 +412,9 @@ pure function inverse(mat) real(real32), dimension(size(mat(:,1),dim=1),size(mat(1,:),dim=1)) :: inverse if(size(mat(1,:),dim=1).eq.2)then - inverse=inverse_2x2(mat) + inverse = inverse_2x2(mat) elseif(size(mat(1,:),dim=1).eq.3)then - inverse=inverse_3x3(mat) + inverse = inverse_3x3(mat) end if end function inverse @@ -423,12 +424,12 @@ end function inverse !!!##################################################### !!! returns inverse of 2 x 2 matrix !!!##################################################### - pure function inverse_2x2(mat) result(inverse) + pure function inverse_2x2(mat) result(output) real(real32) :: det - real(real32), dimension(2,2) :: inverse + real(real32), dimension(2,2) :: output real(real32), dimension(2,2), intent(in) :: mat - det=mat(1,1)*mat(2,2)-mat(1,2)*mat(2,1) + det = mat(1,1)*mat(2,2)-mat(1,2)*mat(2,1) !if(det.eq.0._real32)then ! write(0,'("ERROR: Internal error in inverse_2x2")') ! write(0,'(2X,"inverse_2x2 in mod_misc_linalg found determinant of 0")') @@ -436,10 +437,10 @@ pure function inverse_2x2(mat) result(inverse) ! stop !end if - inverse(1,1)=+1._real32/det*(mat(2,2)) - inverse(2,1)=-1._real32/det*(mat(1,2)) - inverse(1,2)=-1._real32/det*(mat(2,1)) - inverse(2,2)=+1._real32/det*(mat(1,1)) + output(1,1) = +1._real32 / det * ( mat(2,2) ) + output(2,1) = -1._real32 / det * ( mat(1,2) ) + output(1,2) = -1._real32 / det * ( mat(2,1) ) + output(2,2) = +1._real32 / det * ( mat(1,1) ) end function inverse_2x2 !!!##################################################### @@ -448,12 +449,12 @@ end function inverse_2x2 !!!##################################################### !!! returns inverse of 3 x 3 matrix !!!##################################################### - pure function inverse_3x3(mat) result(inverse) + pure function inverse_3x3(mat) result(output) real(real32) :: det - real(real32), dimension(3,3) :: inverse + 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)& + 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) @@ -464,15 +465,15 @@ pure function inverse_3x3(mat) result(inverse) ! stop !end if - inverse(1,1)=+1._real32/det*(mat(2,2)*mat(3,3)-mat(2,3)*mat(3,2)) - inverse(2,1)=-1._real32/det*(mat(2,1)*mat(3,3)-mat(2,3)*mat(3,1)) - inverse(3,1)=+1._real32/det*(mat(2,1)*mat(3,2)-mat(2,2)*mat(3,1)) - inverse(1,2)=-1._real32/det*(mat(1,2)*mat(3,3)-mat(1,3)*mat(3,2)) - inverse(2,2)=+1._real32/det*(mat(1,1)*mat(3,3)-mat(1,3)*mat(3,1)) - inverse(3,2)=-1._real32/det*(mat(1,1)*mat(3,2)-mat(1,2)*mat(3,1)) - inverse(1,3)=+1._real32/det*(mat(1,2)*mat(2,3)-mat(1,3)*mat(2,2)) - inverse(2,3)=-1._real32/det*(mat(1,1)*mat(2,3)-mat(1,3)*mat(2,1)) - inverse(3,3)=+1._real32/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 !!!##################################################### @@ -685,14 +686,14 @@ function simeq(qX,qY) P=0._real32 do i=1,n do j=1,n - P(i,j)=(qX(i)**dble(n-j)) + P(i,j)=(qX(i)**real(n-j,real32)) end do end do ! P(1,1)=qX(1)**2 ;P(1,2)=qX(1) ;P(1,3)=1.0; ! P(2,1)=qX(2)**2 ;P(2,2)=qX(2) ;P(2,3)=1.0; ! P(3,2)=qX(3)**2 ;P(3,2)=qX(3) ;P(3,3)=1.0; - if(any(qX.lt.1.D-5)) then + if(any(qX.lt.1.E-5_real32)) then loc=minloc(abs(qX),dim=1) tmpqY=funcY tmpP=P @@ -704,7 +705,7 @@ function simeq(qX,qY) ! invP=inverse(P) invP=LUinv((P)) - ! invP=LUinv(dble(P)) + ! invP=LUinv(real(P,real32)) simeq=matmul(invP,funcY) end function simeq @@ -1046,7 +1047,7 @@ integer function get_frac_denom(val) a=mod(val,1._real32) b=1._real32 - tiny=1.D-6 + tiny = 1.E-6_real32 i=0 do i=i+1 @@ -1081,7 +1082,7 @@ function reduce_vec_gcd(invec) result(vec) !!! MAKE IT DO SOMETHING IF IT CANNOT FULLY INTEGERISE - tol=1.D-5 + tol=1.E-5_real32 allocate(vec(size(invec))) vec=invec if(any(abs(vec(:)-nint(vec(:))).gt.tol))then @@ -1138,7 +1139,7 @@ function gen_group(elem,mask,tol) result(group) if(present(tol))then tiny = tol else - tiny = 1.D-5 + tiny = 1.E-5_real32 end if nelem = size(elem(:,1,1)) dim1 = size(elem(1,:,1)) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 006205a..8945d13 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -30,7 +30,7 @@ module mod_sym implicit none integer :: ierror_sym=0 integer :: s_start=1,s_end=0 - real(real32) :: tol_sym=5.D-5 + real(real32) :: tol_sym = 5.E-5_real32 character(1) :: verb_sym="n" integer, allocatable, dimension(:) :: symops_compare real(real32), allocatable, dimension(:,:,:) :: savsym @@ -133,7 +133,7 @@ subroutine set_symmetry_tolerance(tolerance) if(present(tolerance))then tol_sym = tolerance else - tol_sym = 1.D-6 + tol_sym = 1.E-6_real32 end if end subroutine set_symmetry_tolerance @@ -1042,8 +1042,7 @@ subroutine get_primitive_cell(lat,bas) real(real32), dimension(3,3) :: dmat1,invlat real(real32), allocatable, dimension(:,:) :: trans,atom_store - type(sym_type) :: grp - type(basis_type) :: bas,pbas + type(basis_type) :: bas real(real32), dimension(3,3) :: lat @@ -1081,7 +1080,7 @@ subroutine get_primitive_cell(lat,bas) if(dtmp1.lt.tol_sym) cycle trans_loop do k=1,i-1,1 - if(modu(abs(cross(trans(j,:),dmat1(k,:)))).lt.1.D-8) cycle trans_loop + if(modu(abs(cross(trans(j,:),dmat1(k,:)))).lt.1.E-8_real32) cycle trans_loop end do dtmp1 = modu(trans(j,:)) @@ -1288,7 +1287,7 @@ end function get_wyckoff_atoms_any !!!----------------------------------------------------------------------------- function get_wyckoff_atoms_loc(wyckoff,lat,bas,loc) result(wyckoff_atoms) implicit none - integer :: i,is,ia,isym,imin,itmp1 + integer :: is,ia,isym,imin,itmp1 integer :: nsym real(real32) :: dist logical :: lfound_closer @@ -1479,7 +1478,7 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te type(sym_type) :: grp1,grp_store, grp_store_inv type(term_arr_type) :: term integer, dimension(3) :: abc=(/1,2,3/) - real(real32), dimension(3) :: vec_compare,vtmp1 + real(real32), dimension(3) :: vec_compare real(real32), dimension(3,3) :: inv_mat,ident type(basis_type),allocatable, dimension(:) :: bas_arr,bas_arr_reject type(term_type), allocatable, dimension(:) :: term_arr,term_arr_uniq @@ -1885,11 +1884,8 @@ function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(te term%nterm=mterm term%lmirror = lmirror if(ludef_print)& - write(6,& - '(1X,"Term.",3X,"Min layer loc",3X,& - &"Max layer loc",3X,"no. atoms")' & - ) - dtmp1 = term_arr_uniq(1)%hmin-1.D-6 + write(6,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') + dtmp1 = term_arr_uniq(1)%hmin-1.E-6_real32 itmp1 = 1 do i=1,mterm allocate(term%arr(i)%ladder(term_arr_uniq(i)%nstep)) diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 33394a8..2f55b16 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -482,6 +482,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) ! Local variables type(basis_type) :: basis_lw_, basis_up_ + !! Temporary basis structures integer :: j,iterm,jterm,ntrans,ifit,iunique,old_natom,itmp1,old_intf integer :: iterm_step,jterm_step diff --git a/src/fortran/mod_lat_compare.f90 b/src/fortran/mod_lat_compare.f90 index 5681ff6..bcdc6c2 100644 --- a/src/fortran/mod_lat_compare.f90 +++ b/src/fortran/mod_lat_compare.f90 @@ -297,7 +297,7 @@ subroutine cyc_lat1(SAV,tol,ltmp) do i=1,SAV%nfit if(all(abs(& match_tfs(SAV%nfit+1,:2,:3)-& - match_tfs(i,:2,:3)).lt.1.D-5)) goto 103 + match_tfs(i,:2,:3)).lt.1.E-5_real32)) goto 103 end do @@ -398,7 +398,7 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) it2_mat(3,:)=nint(t_mat(3,:)) do i=1,2 t_mat(i,:)=reduce_vec_gcd(t_mat(i,:)) - if(any(abs(t_mat(i,:)-nint(t_mat(i,:))).gt.1.D-5)) exit reduce_if + if(any(abs(t_mat(i,:)-nint(t_mat(i,:))).gt.1.E-5_real32)) exit reduce_if it2_mat(i,:)=nint(t_mat(i,:)) do j=1,3 if(match_tfs(SAV%nfit+1,j,i).ne.0._real32)then @@ -487,7 +487,7 @@ function get_lat2(SAV,tlat1) result(tf) dtmp=get_area(t_mat(1,:),t_mat(2,:)) t_area=1000._real32 !! SORT OUT HANDLING OF AREA COMPARISON - if(dtmp.le.t_area.and.&!-1.D-8.and.& + if(dtmp.le.t_area.and.&!-1.E-8_real32.and.& abs(ang1-ang2).lt.t_ang)then if(i.ne.1) it_mat(:,:)=cshift(it_mat(:,:),shift=1-i,dim=2) tf=it_mat @@ -779,7 +779,7 @@ function lat_check(SAV,tol,lat) result(lcheck) real(real32), dimension(3,3) :: lat,tlat - tiny=1.D-6 + tiny=1.E-6_real32 lcheck=.false. lat_loop: do i=1,min(tol%nstore,SAV%nfit) tlat=matmul(SAV%tf1(i,:,:),SAV%lat1) @@ -894,7 +894,7 @@ function vec_comp(S1,S1p,S2p,delta) result(match) match=0._real32 - tiny=1.D-8 + tiny=1.E-8_real32 mS1=modu(S1) mS1p=modu(S1p) mS2p=modu(S2p) @@ -1159,8 +1159,8 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) do i=1,grp1%nsym rmat1=real(matmul(tmpsym(i,:3,:3),templat1(:,:))) rvec2=cross([rmat1(1,:)],[rmat1(2,:)]) - if(all(abs( rvec1(:) - rvec2(:) ).lt.1.D-8).or.& - all(abs( rvec1(:) + rvec2(:) ).lt.1.D-8))then + if(all(abs( rvec1(:) - rvec2(:) ).lt.1.E-8_real32).or.& + all(abs( rvec1(:) + rvec2(:) ).lt.1.E-8_real32))then nsym1=nsym1+1 tmpsym1(nsym1,:3,:3) = tmpsym(i,:3,:3) else @@ -1169,10 +1169,10 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) ! redundant if a-b plane works instead. !if(all(& ! abs( templat1(3,:) - matmul(templat1(3,:),tmpsym(i,:3,:3)) )& - ! .lt.1.D-8).or.& + ! .lt.1.E-8_real32).or.& ! all(& ! abs( templat1(3,:) + matmul(templat1(3,:),tmpsym(i,:3,:3)) )& - ! .lt.1.D-8))then + ! .lt.1.E-8_real32))then ! nsym1=nsym1+1 ! tmpsym1(nsym1,:3,:3) = tmpsym(i,:3,:3) !end if @@ -1210,10 +1210,10 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !write(0,'(3(2X,F7.2))') (tmpsym(i,j,:3),j=1,3) if(all(& abs( templat2(3,:) - matmul(templat2(3,:),tmpsym(i,:3,:3)) )& - .lt.1.D-8).or.& + .lt.1.E-8_real32).or.& all(& abs( templat2(3,:) + matmul(templat2(3,:),tmpsym(i,:3,:3)) )& - .lt.1.D-8))then + .lt.1.E-8_real32))then nsym2=nsym2+1 tmpsym2(nsym2,:3,:3) = tmpsym(i,:3,:3) end if @@ -1307,7 +1307,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) SAV%tol(i,:) = saved_tolerances(i,:) if_reduce: if(lreduce)then tf = find_tf(comb_trans_1(i,:,:),comb_trans_2(i,:,:)) - if(abs(abs(det(comb_trans_1(i,:,:)))-1._real32).lt.1.D-6) exit if_reduce + if(abs(abs(det(comb_trans_1(i,:,:)))-1._real32).lt.1.E-6_real32) exit if_reduce if(ierror.eq.1)then write(0,*) i write(0,'( 3( 3(F7.3,1X), /) )') tf @@ -1321,10 +1321,10 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) tmat2(:,:) = nint(tf) do j=1,3 dtmp1=1._real32 - if(any(abs(tf(j,:3)-nint(tf(j,:3))).gt.1.D-6))then + if(any(abs(tf(j,:3)-nint(tf(j,:3))).gt.1.E-6_real32))then dtmp1=get_vec_multiple(tf(j,:3),reduce_vec_gcd(tf(j,:3))) end if - if(abs(dtmp1-nint(dtmp1)).gt.1.D-6)then + if(abs(dtmp1-nint(dtmp1)).gt.1.E-6_real32)then dtmp1=get_frac_denom(1._real32/dtmp1) end if tmat1(j,:) = tmat1(j,:3)*nint(dtmp1) diff --git a/src/fortran/mod_plane_matching.f90 b/src/fortran/mod_plane_matching.f90 index ed7be8c..be928b3 100644 --- a/src/fortran/mod_plane_matching.f90 +++ b/src/fortran/mod_plane_matching.f90 @@ -214,12 +214,12 @@ function is_duplicate(list1,list2,lat1,lat2,sym1,sym2) result(outval) dummy1 = real(find_tf(lat1,lat2),real32) LOOP: do i=1,len - if(all(abs(list1(i,:,:)).lt.1.D-5)) cycle LOOP + if(all(abs(list1(i,:,:)).lt.1.E-5_real32)) cycle LOOP tmplat1(:,:) = list1(i,:,:) tmplat2(:,:) = list2(i,:,:) dummy2 = real(find_tf(tmplat1,tmplat2),real32) - if ( all(abs( dummy1(:,:)-dummy2(:,:) ) .lt. 1.D-5) ) then + if ( all(abs( dummy1(:,:)-dummy2(:,:) ) .lt. 1.E-5_real32) ) then outval = .true. ! write(0,*) "error" exit LOOP @@ -250,8 +250,8 @@ function is_unique(miller,sym) result(outval) real(real32), dimension(3) :: vec_in,vec_out,vec_tmp1,vec_tmp2 real(real32), dimension(:,:,:) :: sym -! if(dot_product(vec_out-vec_in,vec_out-vec_in).lt.1.D-5) -! if(all(abs(vec_out-vec_in).lt.1.D-5)) +! if(dot_product(vec_out-vec_in,vec_out-vec_in).lt.1.E-5_real32) +! if(all(abs(vec_out-vec_in).lt.1.E-5_real32)) ! any(vec_in.eq.3._real32) ! all(vec_in.eq.3._real32) @@ -261,7 +261,7 @@ function is_unique(miller,sym) result(outval) if (all(miller.eq.0)) then outval = .false. - else if (all(abs(vec_out-vec_in).lt.1.D-5)) then + else if (all(abs(vec_out-vec_in).lt.1.E-5_real32)) then outval = .true. else outval = .false. @@ -269,7 +269,7 @@ function is_unique(miller,sym) result(outval) if(.not.outval) return - tol=1.D-5 + tol = 1.E-5_real32 if(all(vec_in.le.0._real32))then outval=.false. return @@ -323,7 +323,7 @@ function is_unique_set(vec1,vec2,sym) result(outval) logical :: outval - tol=1.D-5 + tol = 1.E-5_real32 outval=.true. vec_in=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) !vec_in1=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) @@ -347,7 +347,7 @@ function is_unique_set(vec1,vec2,sym) result(outval) end do symloop2 end do symloop1 - !tol=1.D-5 + !tol = 1.E-5_real32 !outval=.true. !vec_in=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) ! @@ -569,7 +569,7 @@ subroutine cell_match(& transforms1,transforms2,& ntransforms,matched_tols,sym1,sym2) implicit none - integer :: i,j,l,m,total_list_count,nvec1,nvec2, k + integer :: i,j,l,m,total_list_count,nvec1,nvec2 real :: tol_up_ang,tol_dw_ang,tol_up_vec,tol_dw_vec real(real32) :: tiny real(real32) :: reference_mag,considered_mag From 5935b147a274b33e2f8addfc24a81ace36a6c211 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 16:26:56 +0100 Subject: [PATCH 030/137] Add terminations module --- CMakeLists.txt | 1 + src/fortran/inputs.f90 | 4 +- src/fortran/lib/mod_constants.f90 | 1 + src/fortran/lib/mod_edit_geom.f90 | 70 ++ src/fortran/lib/mod_sym.f90 | 547 +------------- src/fortran/lib/mod_terminations.f90 | 1044 ++++++++++++++++++++++++++ src/fortran/mod_generator.f90 | 823 +++++--------------- src/fortran/mod_lat_compare.f90 | 2 +- src/fortran/mod_shifting.f90 | 2 +- src/fortran/mod_swapping.f90 | 2 +- 10 files changed, 1322 insertions(+), 1174 deletions(-) create mode 100644 src/fortran/lib/mod_terminations.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index a7704de..30c0284 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,6 +65,7 @@ set(LIB_FILES mod_io_utils_extd.F90 mod_sym.f90 mod_tools_infile.f90 + mod_terminations.f90 ) # Main source files diff --git a/src/fortran/inputs.f90 b/src/fortran/inputs.f90 index e67d531..c094b84 100644 --- a/src/fortran/inputs.f90 +++ b/src/fortran/inputs.f90 @@ -20,7 +20,7 @@ module inputs use lat_compare, only: lreduce,tol_type use infile_tools use infile_print - use mod_sym, only: set_symmetry_tolerance + use artemis__sym, only: set_symmetry_tolerance implicit none integer :: nout,clock,task,task_defect,axis,icheck_intf,iintf integer :: irestart,idepth,imatch,ishift,iswap @@ -374,7 +374,7 @@ subroutine set_global_vars() !!!----------------------------------------------------------------------------- -!!! sets the symmetry tolerance for the mod_sym module +!!! sets the symmetry tolerance for the artemis__sym module !!!----------------------------------------------------------------------------- call set_symmetry_tolerance(tol_sym) diff --git a/src/fortran/lib/mod_constants.f90 b/src/fortran/lib/mod_constants.f90 index 63e6102..88bca78 100644 --- a/src/fortran/lib/mod_constants.f90 +++ b/src/fortran/lib/mod_constants.f90 @@ -10,4 +10,5 @@ module artemis__constants real(real32), parameter, public :: pi = 4._real32*atan(1._real32) real(real32), parameter, public :: INF = huge(0._real32) integer, public :: ierror = -1 + real(real32), parameter, public :: tolerance = 1.E-6_real32 end MODULE artemis__constants diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 index c6295a6..b95cf48 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_edit_geom.f90 @@ -65,6 +65,76 @@ module edit_geom contains + +!############################################################################### + function compare_stoichiometry(basis1, basis2) result(output) + !! Check if two basis structures have the same stoichiometry ratio + !! + !! This function compares the stoichiometry ratios of two basis structures + !! It returns true if the relative proportions of all atomic species are identical + !! and all species names match between both structures + implicit none + type(basis_type), intent(in) :: basis1, basis2 + logical :: output + + integer :: is, js, total_atoms1, total_atoms2 + real(real32) :: ratio1, ratio2, tol + logical :: found_match + + ! Set tolerance for floating-point comparisons + tol = 1.E-5_real32 + + ! Initialize output to true, will set to false if any condition fails + output = .true. + + ! Check if both basis have the same number of species + if (basis1%nspec /= basis2%nspec) then + output = .false. + return + end if + + ! Get total number of atoms in each basis + total_atoms1 = sum(basis1%spec(:)%num) + total_atoms2 = sum(basis2%spec(:)%num) + + ! Compare each species in basis1 with corresponding species in basis2 + do is = 1, basis1%nspec + found_match = .false. + + ! Find matching species in basis2 + do js = 1, basis2%nspec + ! Check if species names match + if (basis1%spec(is)%name == basis2%spec(js)%name) then + found_match = .true. + + ! Calculate and compare stoichiometry ratios + ratio1 = real(basis1%spec(is)%num, real32) / real(total_atoms1, real32) + ratio2 = real(basis2%spec(js)%num, real32) / real(total_atoms2, real32) + + ! Check if ratios are equal within tolerance + if (abs(ratio1 - ratio2) .gt. tol) then + output = .false. + return + end if + + exit ! Found matching species, continue to next species in basis1 + end if + end do + + ! If no matching species found in basis2, stoichiometry can't be the same + if (.not. found_match) then + output = .false. + return + end if + end do + + end function compare_stoichiometry + + + + + + !!!############################################################################# !!! Normalises a 3x3 matrix to the form: !!! a 0 0 diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 8945d13..eb3c651 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -16,24 +16,19 @@ !!! basis_map (finds symmetry equivalent atoms in two bases based on ... !!! ... the supplied transformation matrix) !!! setup_ladder (sets up rungs of the layer ladder) -!!! get_terminations (finds all possible terminations along an axis) -!!! print_terminations (prints the terminations to individual files) !!!############################################################################# -module mod_sym +module artemis__sym use artemis__constants, only: real32, pi - use artemis__misc, only: sort1D,sort2D,sort_col,set - use artemis__io_utils, only: err_abort - use misc_linalg, only: modu,inverse_3x3,det,gcd,gen_group,cross,uvec - use artemis__geom_rw, only: basis_type,geom_write - use edit_geom, only: vacuumer,set_vacuum,shifter,& - get_closest_atom,ortho_axis,reducer,primitive_lat,get_min_dist + use artemis__misc, only: sort2D + use misc_linalg, only: modu,inverse_3x3,det,gcd,gen_group,cross + use artemis__geom_rw, only: basis_type + use edit_geom, only: reducer, primitive_lat implicit none integer :: ierror_sym=0 integer :: s_start=1,s_end=0 real(real32) :: tol_sym = 5.E-5_real32 - character(1) :: verb_sym="n" + character(1) :: verb_sym = "n" integer, allocatable, dimension(:) :: symops_compare - real(real32), allocatable, dimension(:,:,:) :: savsym interface get_wyckoff_atoms procedure get_wyckoff_atoms_any,get_wyckoff_atoms_loc @@ -61,23 +56,6 @@ module mod_sym type(spcmap_type), allocatable, dimension(:) :: spec end type basmap_type - type term_type - !real(real32) :: add - real(real32) :: hmin - real(real32) :: hmax - integer :: natom - integer :: nstep - real(real32), allocatable, dimension(:) :: ladder - end type term_type - - type term_arr_type - integer :: nterm = 0, axis, nstep - real(real32) :: tol - logical :: lmirror=.false. - type(term_type), allocatable, dimension(:) :: arr - end type term_arr_type - - type confine_type !! apply any confinement/constraints on symmetries logical :: l=.false. @@ -97,6 +75,7 @@ module mod_sym integer, allocatable, dimension(:) :: op real(real32), allocatable, dimension(:,:,:) :: sym type(confine_type) :: confine + real(real32), allocatable, dimension(:,:,:) :: sym_save end type sym_type @@ -108,8 +87,7 @@ module mod_sym public :: get_primitive_cell - public :: term_arr_type,confine_type - public :: get_terminations + public :: confine_type public :: basmap_type,basis_map @@ -145,14 +123,15 @@ end subroutine set_symmetry_tolerance !!!############################################################################# subroutine sym_setup(grp,lat,predefined,new_start,tolerance) implicit none - logical :: lpresent - - type(sym_type) :: grp real(real32), dimension(3,3), intent(in) :: lat real(real32), optional, intent(in) :: tolerance logical, optional, intent(in) :: predefined,new_start + type(sym_type) :: grp + + logical :: predefined_, new_start_ + if(present(tolerance)) call set_symmetry_tolerance(tolerance) if(present(new_start))then @@ -162,28 +141,23 @@ subroutine sym_setup(grp,lat,predefined,new_start,tolerance) end if end if - if(present(predefined))then - if(predefined)then - call gen_fundam_sym_matrices(grp,lat) - goto 10 - end if + predefined_ = .false. + if(present(predefined)) predefined_ = predefined + if(predefined_)then + call gen_fundam_sym_matrices(grp,lat) + else + call mksym(grp,lat) end if - call mksym(grp,lat) -10 if(allocated(savsym)) deallocate(savsym) if(allocated(symops_compare)) deallocate(symops_compare) grp%nsymop=0 - lpresent=.false. - if(present(new_start))then - if(new_start) lpresent=.true. - end if - if(.not.present(new_start).or.lpresent.or.s_end.eq.0)then + new_start_ = .true. + if(present(new_start)) new_start_ = new_start + if(new_start_.or.s_end.eq.0)then s_end=grp%nsym end if - - return end subroutine sym_setup !!!############################################################################# @@ -418,14 +392,14 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) !!!----------------------------------------------------------------------------- -!!! allocates and saves the array savsym if the first time submitted +!!! allocates and saves the array sym_save if the first time submitted !!!----------------------------------------------------------------------------- if(lsaving)then - if(allocated(savsym)) deallocate(savsym) - allocate(savsym(grp%nsymop,4,4)) - savsym=0._real32 - savsym(:grp%nsymop,:,:)=tmpsav(:grp%nsymop,:,:) - savsym(:,4,4)=1._real32 + if(allocated(grp%sym_save)) deallocate(grp%sym_save) + allocate(grp%sym_save(grp%nsymop,4,4)) + grp%sym_save=0._real32 + grp%sym_save(:grp%nsymop,:,:)=tmpsav(:grp%nsymop,:,:) + grp%sym_save(:,4,4)=1._real32 deallocate(tmpsav) end if @@ -439,7 +413,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) case default if(.not.allocated(symops_compare))then write(0,'("ERROR: Internal error in check_sym")') - write(0,'(2X,"check_sym in mod_sym.f90 is trying to assign a & + write(0,'(2X,"check_sym in artemis__sym.f90 is trying to assign a & &value to symops_compare, which hasn''t been allocated")') exit iperm_if end if @@ -450,7 +424,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) if(lsaving)then deallocate(grp%sym) - call move_alloc(savsym,grp%sym) + call move_alloc(grp%sym_save, grp%sym) grp%nsym = grp%nsymop end if @@ -545,7 +519,7 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) sav_trans = 0._real32 if(lwyckoff.and.ntrans+1.gt.size(wyck_check))then write(0,'("ERROR: error encountered in gldfnd")') - write(0,'(2X,"Internal error in subroutine gldfnd in mod_sym.f90")') + write(0,'(2X,"Internal error in subroutine gldfnd in artemis__sym.f90")') write(0,'(2X,"ntrans is greater than wyck_check")') write(0,'(2X,"EXITING SUBROUTINE")') return @@ -1465,463 +1439,4 @@ function basis_map(sym,bas1,tmpbas2) result(bas_map) end function basis_map !!!############################################################################# - -!!!############################################################################# -!!! finds all possible terminations along an axis -!!!############################################################################# - function get_terminations(lat,bas,axis,lprint,layer_sep,break_on_fail) result(term) - implicit none - integer :: i,j,k,is,nterm,mterm,dim,ireject - integer :: itmp1,itmp2,init,min_loc - logical :: ludef_print,lunique,ltmp1,lmirror, break_on_fail_ - real(real32) :: dtmp1,tol,height,max_sep,c_along,centre - type(sym_type) :: grp1,grp_store, grp_store_inv - type(term_arr_type) :: term - integer, dimension(3) :: abc=(/1,2,3/) - real(real32), dimension(3) :: vec_compare - real(real32), dimension(3,3) :: inv_mat,ident - type(basis_type),allocatable, dimension(:) :: bas_arr,bas_arr_reject - type(term_type), allocatable, dimension(:) :: term_arr,term_arr_uniq - integer, allocatable, dimension(:) :: success,tmpop - integer, allocatable, dimension(:,:) :: reject_match - real(real32), allocatable, dimension(:,:) :: bas_list - real(real32), allocatable, dimension(:,:,:) :: tmpsym - - integer, intent(in) :: axis - type(basis_type), intent(in) :: bas - real(real32), dimension(3,3), intent(in) :: lat - character(len=256) :: err_msg - - real(real32), optional, intent(in) :: layer_sep - logical, optional, intent(in) :: lprint, break_on_fail - - integer, dimension(:), allocatable :: comparison_list - - - -!!!APPLY TRANSFORMATION MATRIX TO FIND TERMINATIONS ALONG OTHER PLANES -!!! E.G. (1 0 1) - - term%nterm = 0 - s_end=0 - grp_store%confine%l=.false. - grp_store%confine%axis=axis - grp_store%confine%laxis=.false. -!!!----------------------------------------------------------------------------- -!!! Sets printing option -!!!----------------------------------------------------------------------------- - if(present(lprint))then - ludef_print = lprint - else - ludef_print = .false. - end if - break_on_fail_ = .false. - if(present(break_on_fail)) break_on_fail_ = break_on_fail - - -!!!----------------------------------------------------------------------------- -!!! Sets the surface identification tolerance -!!!----------------------------------------------------------------------------- - if(present(layer_sep))then - tol = layer_sep - else - tol = 1._real32 !!!tolerance of 1 Å for defining a layer - end if - - abc=cshift(abc,3-axis) - c_along = abs(dot_product(lat(axis,:),& - uvec(cross([lat(abc(1),:)],[lat(abc(2),:)])))) - tol = tol / c_along - lmirror=.false. - - -!!!----------------------------------------------------------------------------- -!!! Set up basis list that will order them wrt distance along 'axis' -!!!----------------------------------------------------------------------------- - allocate(bas_list(bas%natom,3)) - init = 1 - do is=1,bas%nspec - bas_list(init:init+bas%spec(is)%num-1,:3) = bas%spec(is)%atom(:,:3) - init = init + bas%spec(is)%num - end do - call sort_col(bas_list,col=axis) - - -!!!----------------------------------------------------------------------------- -!!! Find largest separation between atoms -!!!----------------------------------------------------------------------------- - max_sep = bas_list(1,axis) - (bas_list(bas%natom,axis)-1._real32) - height = ( bas_list(1,axis) + (bas_list(bas%natom,axis)-1._real32) )/2._real32 - do i=1,bas%natom-1 - dtmp1 = bas_list(i+1,axis) - bas_list(i,axis) - if(dtmp1.gt.max_sep)then - max_sep = dtmp1 - height = ( bas_list(i+1,axis) + bas_list(i,axis) )/2._real32 - end if - end do - if(max_sep.lt.tol)then - if(break_on_fail_)then - write(0,'("ERROR: Error in mod_sym.f90")') - else - write(0,'("WARNING:")') - end if - write(0,'(2X,"get_terminations subroutine unable to find a separation & - &in the material that is greater than LAYER_SEP")') - write(0,'(2X,"Writing material to ''unlayerable.vasp''")') - open(13,file="unlayerable.vasp") - call geom_write(13,bas) - close(13) - write(0,'(2X,"We suggest reducing LAYER_SEP to less than ",F6.4)') & - max_sep - write(0,'(2X,"NOTE: If LAYER_SEP < 0.7, the material likely does not & - &support the Miller plane")') - write(0,'(2X,"Please inform the developers of this and give details & - &of what structure caused this")') - if(break_on_fail_)then - write( 0, & - '("To allow the program to continue, set & - &LBREAK_ON_NO_TERM = F")' & - ) - write(0,'("Stopping...")') - call exit() - else - return - end if - end if - bas_list(:,axis) = bas_list(:,axis) - height - bas_list(:,axis) = bas_list(:,axis) - floor(bas_list(:,axis)) - call sort_col(bas_list,col=axis) - - -!!!----------------------------------------------------------------------------- -!!! Finds number of non-unique terminations -!!!----------------------------------------------------------------------------- - nterm=1 - allocate(term_arr(bas%natom)) - term_arr(:)%natom=0 - term_arr(:)%hmin=0 - term_arr(:)%hmax=0 - term_arr(1)%hmin=bas_list(1,axis) - term_arr(1)%hmax=bas_list(1,axis) - min_loc = 1 - itmp1 = 1 - term_loop1: do - - !! get the atom at that height. - !vtmp1 = get_min_dist(lat,bas,bas_list(itmp1,:3),.true.,axis,.true.,.false.) - !itmp1 = minloc(bas_list(:,axis) - vtmp1(axis), dim=1, & - ! mask = abs(bas_list(:,axis) - (bas_list(itmp1,axis) + vtmp1(axis))& - ! ).lt.tol_sym) - - itmp1 = minloc(bas_list(:,axis) - term_arr(nterm)%hmax, dim=1, & - mask = bas_list(:,axis) - term_arr(nterm)%hmax.gt.0._real32) - if(itmp1.gt.bas%natom.or.itmp1.le.0)then - term_arr(nterm)%natom = bas%natom - min_loc + 1 - exit term_loop1 - end if - - !dtmp1 = modu(matmul(vtmp1,lat)) - dtmp1 = bas_list(itmp1,axis) - term_arr(nterm)%hmax - if(dtmp1.le.tol)then - term_arr(nterm)%hmax = bas_list(itmp1,axis) - else - term_arr(nterm)%natom = itmp1 - min_loc - min_loc = itmp1 - nterm = nterm + 1 - term_arr(nterm)%hmin = bas_list(itmp1,axis) - term_arr(nterm)%hmax = bas_list(itmp1,axis) - end if - - end do term_loop1 - term_arr(:nterm)%hmin = term_arr(:nterm)%hmin + height - term_arr(:nterm)%hmax = term_arr(:nterm)%hmax + height - - -!!!----------------------------------------------------------------------------- -!!! Set up system symmetries -!!!----------------------------------------------------------------------------- - allocate(bas_arr(2*nterm)) - allocate(bas_arr_reject(2*nterm)) - dim = size(bas%spec(1)%atom(1,:)) - do i=1,2*nterm - allocate(bas_arr(i)%spec(bas%nspec)) - allocate(bas_arr_reject(i)%spec(bas%nspec)) - do is=1,bas%nspec - allocate(bas_arr(i)%spec(is)%atom(& - bas%spec(is)%num,dim)) - allocate(bas_arr_reject(i)%spec(is)%atom(& - bas%spec(is)%num,dim)) - end do - end do - - -!!!----------------------------------------------------------------------------- -!!! Print location of unique terminations -!!!----------------------------------------------------------------------------- - mterm = 0 - ireject = 0 - grp_store%lspace = .true. - grp_store%confine%l = .true. - grp_store%confine%laxis(axis) = .true. - call sym_setup(grp_store,lat,predefined=.false.,new_start=.true.) - - - - !!-------------------------------------------------------------------------- - !! Handle inversion matrix (centre of inversion must be accounted for) - !!-------------------------------------------------------------------------- - !! change symmetry constraints after setting up symmetries - !! this is done to constrain the matching of two bases in certain directions - grp_store%confine%l = .false. - grp_store%confine%laxis(axis) = .false. - call check_sym(grp_store,bas1=bas,iperm=-1,lsave=.true.) - inv_mat = 0._real32 - do i=1,3 - inv_mat(i,i) = -1._real32 - end do - itmp1 = 0 - do i=1,grp_store%nsym - if(all(abs(grp_store%sym(i,:3,:3)-inv_mat).lt.tol_sym))then - itmp1 = i - exit - end if - end do - if(itmp1.eq.0)then - write(err_msg,*) "No inversion symmetry found!" - call err_abort(err_msg) - end if - do i=1,grp_store%nsymop - if(all(abs(savsym(i,:3,:3)-inv_mat).lt.tol_sym)) & - grp_store%sym(itmp1,4,:3) = savsym(i,4,:3) - end do - - - - !!-------------------------------------------------------------------------- - !! Determine unique surface terminations - !!-------------------------------------------------------------------------- - grp_store%confine%l = .true. - grp_store%confine%laxis(axis) = .true. - allocate(term_arr_uniq(2*nterm)) - allocate(reject_match(nterm,2)) - shift_loop1:do i=1,nterm - mterm = mterm + 1 - - bas_arr(mterm) = bas - centre = term_arr(i)%hmin + (term_arr(i)%hmax - term_arr(i)%hmin)/2._real32 - call shifter(bas_arr(mterm),axis,1-centre,.true.) - !if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - ! i,term_arr(i)%hmin,term_arr(i)%hmax,term_arr(i)%natom - sym_if: if(i.ne.1)then - sym_loop1:do j=1,mterm-1 - if(abs(abs(term_arr(i)%hmax-term_arr(i)%hmin) - & - abs(term_arr_uniq(j)%hmax-term_arr_uniq(j)%hmin)).gt.tol_sym) & - cycle sym_loop1 - call clone_grp(grp_store,grp1) - call check_sym(grp1,bas1=bas_arr(mterm),& - iperm=-1,tmpbas2=bas_arr(j),lsave=.true.) - if(grp1%nsymop.ne.0)then - !write(0,*) "we have a possible reject" - !if(any(savsym(:grp1%nsymop,axis,axis).eq.-1.D0))then - if(abs(savsym(1,axis,axis)+1.D0).lt.tol_sym)then - ireject = ireject + 1 - reject_match(ireject,:) = [ i, j ] - bas_arr_reject(ireject) = bas_arr(mterm) - lmirror=.true. - else - term_arr_uniq(j)%nstep = term_arr_uniq(j)%nstep + 1 - term_arr_uniq(j)%ladder(term_arr_uniq(j)%nstep) = & - term_arr(i)%hmin - term_arr_uniq(j)%hmin - end if - mterm = mterm - 1 - cycle shift_loop1 - end if - end do sym_loop1 - end if sym_if - term_arr_uniq(mterm) = term_arr(i) - term_arr_uniq(mterm)%nstep = 1 - allocate(term_arr_uniq(mterm)%ladder(nterm)) - term_arr_uniq(mterm)%ladder(:) = 0._real32 - end do shift_loop1 - - - !!-------------------------------------------------------------------------- - !! Set up mirror/inversion symmetries of the matrix - !!-------------------------------------------------------------------------- - grp_store_inv%confine%axis=axis - grp_store_inv%confine%laxis=.false. - grp_store_inv%lspace = .true. - grp_store_inv%confine%l = .true. - grp_store_inv%confine%laxis(axis) = .true. - call sym_setup(grp_store_inv,lat,predefined=.false.,new_start=.true.) - itmp1 = count(abs(grp_store_inv%sym(:,3,3)+1._real32).lt.tol_sym) - allocate(tmpsym(itmp1,4,4)) - allocate(tmpop(itmp1)) - itmp1 = 0 - do i=1,grp_store_inv%nsym - if(abs(grp_store_inv%sym(i,3,3)+1._real32).lt.tol_sym)then - itmp1=itmp1+1 - tmpsym(itmp1,:,:) = grp_store_inv%sym(i,:,:) - tmpop(itmp1) = i - end if - end do - grp_store_inv%nsym = itmp1 - grp_store_inv%nlatsym = itmp1 - call move_alloc(tmpsym,grp_store_inv%sym) - allocate(grp_store_inv%op(itmp1)) - grp_store_inv%op(:) = tmpop(:itmp1) - s_end = grp_store_inv%nsym - - - !!-------------------------------------------------------------------------- - !! Check rejects for inverse surface termination of saved - !!-------------------------------------------------------------------------- - ident = 0._real32 - do i=1,3 - ident(i,i) = 1._real32 - end do - vec_compare = 0._real32 - vec_compare(axis) = -1._real32 - allocate(success(ireject)) - success=0 - reject_loop1: do i=1,ireject - lunique=.true. - itmp1=reject_match(i,1) - itmp2=reject_match(i,2) - !! Check if comparison termination has already been compared successfully - comparison_list = [ itmp2 ] - !! check against all previous reject-turned-unique terminations - prior_check: if(any(success(1:i-1:1).eq.itmp2))then - do j = 1, i-1, 1 - if(success(j).eq.itmp2)then - s_end = grp_store%nsym - call clone_grp(grp_store,grp1) - call check_sym(grp1,bas1=bas_arr_reject(j),& - iperm=-1,tmpbas2=bas_arr_reject(i),lsave=.true.) - if(grp1%nsymop.ne.0)then - if(abs(savsym(1,axis,axis)+1._real32).gt.tol_sym)then - lunique = .false. - itmp2 = reject_match(j,2) - exit prior_check - end if - end if - comparison_list = [ comparison_list, reject_match(j,2) ] - end if - end do - end if prior_check - - unique_condition1: if(lunique)then - s_end = grp_store_inv%nsym - lunique = .true. - do k = 1, size(comparison_list) - itmp2 = comparison_list(k) - call clone_grp(grp_store_inv,grp1) - call check_sym(grp1,bas_arr(itmp2),& - iperm=-1,lsave=.true.,lcheck_all=.true.) - - !! Check if inversions are present in comparison termination - ltmp1=.false. - do j = 1, grp1%nsymop, 1 - if(abs(det(savsym(j,:3,:3))+1.D0).le.tol_sym) ltmp1=.true. - end do - !! If they are not, then no point comparing. It is a new termination - if(.not.ltmp1) cycle - - call clone_grp(grp_store_inv,grp1) - call check_sym(grp1,bas_arr(itmp2),& - tmpbas2=bas_arr_reject(i), & - iperm=-1, & - lsave=.true., & - lcheck_all=.true. & - ) - - !! Check det of all symmetry operations. If any are 1, move on - !! This is because they are just rotations as can be captured ... - !! ... through lattice matches. - !! Solely inversions are unique and must be captured. - do j = 1, grp1%nsymop, 1 - if(abs(det(savsym(j,:3,:3))-1.D0).le.tol_sym) lunique=.false. - end do - if(savsym(1,4,axis).eq.& - 2.D0 * min( & - term_arr_uniq(itmp2)%hmin, & - 0.5D0-term_arr_uniq(itmp2)%hmin & - ) & - ) lunique=.false. - - if(.not.( & - all(abs(savsym(1,axis,:3) - vec_compare(:)).lt.tol_sym).and.& - all(abs(savsym(1,:3,axis) - vec_compare(:)).lt.tol_sym) & - ) ) lunique=.false. - - if(lunique) exit unique_condition1 - end do - end if unique_condition1 - - if(lunique)then - mterm = mterm + 1 - success(i) = itmp2 - bas_arr(mterm) = bas_arr_reject(i) - term_arr_uniq(mterm) = term_arr(itmp1) - reject_match(i,2) = mterm - term_arr_uniq(mterm)%nstep = 1 - allocate(term_arr_uniq(mterm)%ladder(ireject+1)) - term_arr_uniq(mterm)%ladder(1) = 0._real32 - else - term_arr_uniq(itmp2)%nstep = term_arr_uniq(itmp2)%nstep + 1 - term_arr_uniq(itmp2)%ladder(term_arr_uniq(itmp2)%nstep) = & - term_arr(itmp1)%hmin - term_arr_uniq(itmp2)%hmin - end if - end do reject_loop1 - - - !!-------------------------------------------------------------------------- - !! Populate termination output - !!-------------------------------------------------------------------------- - allocate(term%arr(mterm)) - term%tol=tol - term%axis=axis - term%nterm=mterm - term%lmirror = lmirror - if(ludef_print)& - write(6,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') - dtmp1 = term_arr_uniq(1)%hmin-1.E-6_real32 - itmp1 = 1 - do i=1,mterm - allocate(term%arr(i)%ladder(term_arr_uniq(i)%nstep)) - term%arr(i)%hmin = term_arr_uniq(itmp1)%hmin - term%arr(i)%hmax = term_arr_uniq(itmp1)%hmax - term%arr(i)%natom = term_arr_uniq(itmp1)%natom - term%arr(i)%nstep = term_arr_uniq(itmp1)%nstep - term%arr(i)%ladder(:term%arr(i)%nstep) = & - term_arr_uniq(i)%ladder(:term%arr(i)%nstep) - if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - i,term%arr(i)%hmin,term%arr(i)%hmax,term%arr(i)%natom - itmp1 = minloc(term_arr_uniq(:)%hmin,& - mask=term_arr_uniq(:)%hmin.gt.dtmp1+tol,dim=1) - if(itmp1.eq.0) then - itmp1 = minloc(term_arr_uniq(:)%hmin,& - mask=term_arr_uniq(:)%hmin.gt.dtmp1+tol-1._real32,dim=1) - end if - dtmp1 = term_arr_uniq(itmp1)%hmin - end do - term%nstep = maxval(term%arr(:)%nstep) - - - !!-------------------------------------------------------------------------- - !! Check to ensure equivalent number of steps for each termination - !!-------------------------------------------------------------------------- - !! Not yet certain whether each termination should have samve number ... - !! ... of ladder rungs. That's why this check is here. - if(all(term%arr(:)%nstep.ne.term%nstep))then - write(0,'("ERROR: Number of rungs in terminations no equivalent for & - &every termination! Please report this to developers.\n& - &Exiting...")') - call exit() - end if - - - end function get_terminations -!!!############################################################################# - -end module mod_sym +end module artemis__sym diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 new file mode 100644 index 0000000..aff5b98 --- /dev/null +++ b/src/fortran/lib/mod_terminations.f90 @@ -0,0 +1,1044 @@ +module artemis__terminations + !! Module for handling termination identification and generation + use artemis__constants, only: real32, tolerance + use artemis__geom_rw, only: basis_type, geom_write + use artemis__misc, only: sort_col, to_lower, to_upper + use artemis__io_utils, only: err_abort + use artemis__io_utils_extd, only: err_abort_print_struc + use misc_linalg, only: modu, cross, uvec, det + use artemis__sym, only: sym_type, check_sym, sym_setup, clone_grp, s_end + use edit_geom, only: shifter, transformer, ortho_axis, set_vacuum + implicit none + + private + + public :: term_arr_type + public :: get_termination_info + public :: set_layer_tol + public :: set_slab_height + public :: build_slab + + + type term_type + !real(real32) :: add + real(real32) :: hmin + real(real32) :: hmax + integer :: natom + integer :: nstep + real(real32), allocatable, dimension(:) :: ladder + end type term_type + + type term_arr_type + integer :: nterm = 0, axis, nstep + real(real32) :: tol + logical :: lmirror=.false. + type(term_type), allocatable, dimension(:) :: arr + end type term_arr_type + + type term_list_type + integer :: term + real(real32) :: loc + end type term_list_type + + + +contains + +!############################################################################### + function get_termination_info( & + basis, axis, lprint, layer_sep, break_on_fail & + ) result(term) + !! Function to find the terminations of a material along a given axis + implicit none + + ! Arguments + type(basis_type), intent(in) :: basis + !! Basis structure + integer, intent(in) :: axis + !! Axis to find terminations along (1,2,3) + !! 1=a, 2=b, 3=c + real(real32), intent(in), optional :: layer_sep + !! Minimum separation between layers + logical, intent(in), optional :: lprint + !! Boolean whether to print terminations + logical, intent(in), optional :: break_on_fail + !! Boolean whether to break on failure to find terminations + + + integer :: i,j,is,nterm,mterm,dim,ireject + integer :: itmp1,itmp2,init,min_loc + logical :: ludef_print,lunique,ltmp1,lmirror, break_on_fail_ + real(real32) :: rtmp1,tol,height,max_sep,c_along,centre + type(sym_type) :: grp1,grp_store + type(term_arr_type) :: term + integer, dimension(3) :: abc=(/1,2,3/) + real(real32), dimension(3) :: vec_compare + real(real32), dimension(3,3) :: inv_mat,ident + type(basis_type),allocatable, dimension(:) :: basis_arr,basis_arr_reject + type(term_type), allocatable, dimension(:) :: term_arr,term_arr_uniq + integer, allocatable, dimension(:) :: success,tmpop + integer, allocatable, dimension(:,:) :: reject_match + real(real32), allocatable, dimension(:,:) :: basis_list + real(real32), allocatable, dimension(:,:,:) :: tmpsym + character(len=256) :: err_msg + + + + +!!!APPLY TRANSFORMATION MATRIX TO FIND TERMINATIONS ALONG OTHER PLANES +!!! E.G. (1 0 1) + + term%nterm = 0 + s_end=0 + grp_store%confine%l=.false. + grp_store%confine%axis=axis + grp_store%confine%laxis=.false. +!!!----------------------------------------------------------------------------- +!!! Sets printing option +!!!----------------------------------------------------------------------------- + if(present(lprint))then + ludef_print = lprint + else + ludef_print = .false. + end if + break_on_fail_ = .false. + if(present(break_on_fail)) break_on_fail_ = break_on_fail + + +!!!----------------------------------------------------------------------------- +!!! Sets the surface identification tolerance +!!!----------------------------------------------------------------------------- + if(present(layer_sep))then + tol = layer_sep + else + tol = 1._real32 !!!tolerance of 1 Å for defining a layer + end if + + abc=cshift(abc,3-axis) + c_along = abs(dot_product(basis%lat(axis,:),& + uvec(cross([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])))) + tol = tol / c_along + lmirror=.false. + + +!!!----------------------------------------------------------------------------- +!!! Set up basis list that will order them wrt distance along 'axis' +!!!----------------------------------------------------------------------------- + allocate(basis_list(basis%natom,3)) + init = 1 + do is=1,basis%nspec + basis_list(init:init+basis%spec(is)%num-1,:3) = basis%spec(is)%atom(:,:3) + init = init + basis%spec(is)%num + end do + call sort_col(basis_list,col=axis) + + +!!!----------------------------------------------------------------------------- +!!! Find largest separation between atoms +!!!----------------------------------------------------------------------------- + max_sep = basis_list(1,axis) - (basis_list(basis%natom,axis)-1._real32) + height = ( basis_list(1,axis) + (basis_list(basis%natom,axis)-1._real32) )/2._real32 + do i=1,basis%natom-1 + rtmp1 = basis_list(i+1,axis) - basis_list(i,axis) + if(rtmp1.gt.max_sep)then + max_sep = rtmp1 + height = ( basis_list(i+1,axis) + basis_list(i,axis) )/2._real32 + end if + end do + if(max_sep.lt.tol)then + if(break_on_fail_)then + write(0,'("ERROR: Error in artemis__sym.f90")') + else + write(0,'("WARNING:")') + end if + write(0,'(2X,"get_terminations subroutine unable to find a separation & + &in the material that is greater than LAYER_SEP")') + write(0,'(2X,"Writing material to ''unlayerable.vasp''")') + open(13,file="unlayerable.vasp") + call geom_write(13,basis) + close(13) + write(0,'(2X,"We suggest reducing LAYER_SEP to less than ",F6.4)') & + max_sep + write(0,'(2X,"NOTE: If LAYER_SEP < 0.7, the material likely does not & + &support the Miller plane")') + write(0,'(2X,"Please inform the developers of this and give details & + &of what structure caused this")') + if(break_on_fail_)then + write( 0, & + '("To allow the program to continue, set & + &LBREAK_ON_NO_TERM = F")' & + ) + write(0,'("Stopping...")') + call exit() + else + return + end if + end if + basis_list(:,axis) = basis_list(:,axis) - height + basis_list(:,axis) = basis_list(:,axis) - floor(basis_list(:,axis)) + call sort_col(basis_list,col=axis) + + +!!!----------------------------------------------------------------------------- +!!! Finds number of non-unique terminations +!!!----------------------------------------------------------------------------- + nterm=1 + allocate(term_arr(basis%natom)) + term_arr(:)%natom=0 + term_arr(:)%hmin=0 + term_arr(:)%hmax=0 + term_arr(1)%hmin=basis_list(1,axis) + term_arr(1)%hmax=basis_list(1,axis) + min_loc = 1 + itmp1 = 1 + term_loop1: do + + !! get the atom at that height. + !vtmp1 = get_min_dist(basis%lat,basis,basis_list(itmp1,:3),.true.,axis,.true.,.false.) + !itmp1 = minloc(basis_list(:,axis) - vtmp1(axis), dim=1, & + ! mask = abs(basis_list(:,axis) - (basis_list(itmp1,axis) + vtmp1(axis))& + ! ).lt.tolerance) + + itmp1 = minloc(basis_list(:,axis) - term_arr(nterm)%hmax, dim=1, & + mask = basis_list(:,axis) - term_arr(nterm)%hmax.gt.0._real32) + if(itmp1.gt.basis%natom.or.itmp1.le.0)then + term_arr(nterm)%natom = basis%natom - min_loc + 1 + exit term_loop1 + end if + + !rtmp1 = modu(matmul(vtmp1,basis%lat)) + rtmp1 = basis_list(itmp1,axis) - term_arr(nterm)%hmax + if(rtmp1.le.tol)then + term_arr(nterm)%hmax = basis_list(itmp1,axis) + else + term_arr(nterm)%natom = itmp1 - min_loc + min_loc = itmp1 + nterm = nterm + 1 + term_arr(nterm)%hmin = basis_list(itmp1,axis) + term_arr(nterm)%hmax = basis_list(itmp1,axis) + end if + + end do term_loop1 + term_arr(:nterm)%hmin = term_arr(:nterm)%hmin + height + term_arr(:nterm)%hmax = term_arr(:nterm)%hmax + height + + +!!!----------------------------------------------------------------------------- +!!! Set up system symmetries +!!!----------------------------------------------------------------------------- + allocate(basis_arr(2*nterm)) + allocate(basis_arr_reject(2*nterm)) + dim = size(basis%spec(1)%atom(1,:)) + do i=1,2*nterm + allocate(basis_arr(i)%spec(basis%nspec)) + allocate(basis_arr_reject(i)%spec(basis%nspec)) + do is=1,basis%nspec + allocate(basis_arr(i)%spec(is)%atom(& + basis%spec(is)%num,dim)) + allocate(basis_arr_reject(i)%spec(is)%atom(& + basis%spec(is)%num,dim)) + end do + end do + + +!!!----------------------------------------------------------------------------- +!!! Print location of unique terminations +!!!----------------------------------------------------------------------------- + mterm = 0 + ireject = 0 + grp_store%lspace = .true. + grp_store%confine%l = .true. + grp_store%confine%laxis(axis) = .true. + call sym_setup(grp_store,basis%lat,predefined=.false.,new_start=.true.) + + + + !!-------------------------------------------------------------------------- + !! Handle inversion matrix (centre of inversion must be accounted for) + !!-------------------------------------------------------------------------- + !! change symmetry constraints after setting up symmetries + !! this is done to constrain the matching of two basises in certain directions + grp_store%confine%l = .false. + grp_store%confine%laxis(axis) = .false. + call check_sym(grp_store,bas1=basis,iperm=-1,lsave=.true.) + inv_mat = 0._real32 + do i=1,3 + inv_mat(i,i) = -1._real32 + end do + itmp1 = 0 + do i=1,grp_store%nsym + if(all(abs(grp_store%sym(i,:3,:3)-inv_mat).lt.tolerance))then + itmp1 = i + exit + end if + end do + if(itmp1.eq.0)then + write(err_msg,*) "No inversion symmetry found!" + call err_abort(err_msg) + end if + do i=1,grp_store%nsymop + if(all(abs(grp_store%sym(i,:3,:3)-inv_mat).lt.tolerance)) & + grp_store%sym(itmp1,4,:3) = grp_store%sym(i,4,:3) + end do + + + + !!-------------------------------------------------------------------------- + !! Determine unique surface terminations + !!-------------------------------------------------------------------------- + grp_store%confine%l = .true. + grp_store%confine%laxis(axis) = .true. + allocate(term_arr_uniq(2*nterm)) + allocate(reject_match(nterm,2)) + shift_loop1:do i=1,nterm + mterm = mterm + 1 + + basis_arr(mterm) = basis + centre = term_arr(i)%hmin + (term_arr(i)%hmax - term_arr(i)%hmin)/2._real32 + call shifter(basis_arr(mterm),axis,1-centre,.true.) + !if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + ! i,term_arr(i)%hmin,term_arr(i)%hmax,term_arr(i)%natom + sym_if: if(i.ne.1)then + sym_loop1:do j=1,mterm-1 + if(abs(abs(term_arr(i)%hmax-term_arr(i)%hmin) - & + abs(term_arr_uniq(j)%hmax-term_arr_uniq(j)%hmin)).gt.tolerance) & + cycle sym_loop1 + call clone_grp(grp_store,grp1) + call check_sym(grp1,bas1=basis_arr(mterm),& + iperm=-1,tmpbas2=basis_arr(j),lsave=.true.) + if(grp1%nsymop.ne.0)then + !write(0,*) "we have a possible reject" + !if(any(grp1%sym_save(:grp1%nsymop,axis,axis).eq.-1._real32))then + if(grp1%sym_save(1,axis,axis).eq.-1._real32)then + ireject = ireject + 1 + reject_match(ireject,:) = [ i, j ] + basis_arr_reject(ireject) = basis_arr(mterm) + lmirror=.true. + else + term_arr_uniq(j)%nstep = term_arr_uniq(j)%nstep + 1 + term_arr_uniq(j)%ladder(term_arr_uniq(j)%nstep) = & + term_arr(i)%hmin - term_arr_uniq(j)%hmin + end if + mterm = mterm - 1 + cycle shift_loop1 + end if + end do sym_loop1 + end if sym_if + term_arr_uniq(mterm) = term_arr(i) + term_arr_uniq(mterm)%nstep = 1 + allocate(term_arr_uniq(mterm)%ladder(nterm)) + term_arr_uniq(mterm)%ladder(:) = 0._real32 + !open(100+mterm) + !call geom_write(100+mterm,basis_arr(mterm)) + !close(100+mterm) + end do shift_loop1 + + + !!-------------------------------------------------------------------------- + !! Set up mirror/inversion symmetries of the matrix + !!-------------------------------------------------------------------------- + call sym_setup(grp_store,basis%lat,predefined=.false.,new_start=.true.) + allocate(tmpsym(count(grp_store%sym(:,3,3).eq.-1._real32),4,4)) + allocate(tmpop(count(grp_store%sym(:,3,3).eq.-1._real32))) + itmp1 = 0 + do i=1,grp_store%nsym + if(grp_store%sym(i,3,3).eq.-1._real32)then + itmp1=itmp1+1 + tmpsym(itmp1,:,:) = grp_store%sym(i,:,:) + tmpop(itmp1) = i + end if + end do + grp_store%nsym = itmp1 + grp_store%nlatsym = itmp1 + call move_alloc(tmpsym,grp_store%sym) + allocate(grp_store%op(itmp1)) + grp_store%op(:) = tmpop(:itmp1) + s_end = grp_store%nsym + + + !!-------------------------------------------------------------------------- + !! Check rejects for inverse surface termination of saved + !!-------------------------------------------------------------------------- + ident = 0._real32 + do i=1,3 + ident(i,i) = 1._real32 + end do + vec_compare = 0._real32 + vec_compare(axis) = -1._real32 + allocate(success(ireject)) + success=0 + reject_loop1: do i=1,ireject + lunique=.true. + itmp1=reject_match(i,1) + itmp2=reject_match(i,2) + !! Check if comparison termination has already been compared successfully + prior_check: if(any(success(1:i-1).eq.itmp2))then + lunique=.false. + else + call clone_grp(grp_store,grp1) + call check_sym(grp1,basis_arr(itmp2),& + iperm=-1,lsave=.true.,lcheck_all=.true.) + ltmp1=.false. + +!!!HERE + !! Check if pure translations are present in comparison termination? + !do j=1,grp1%nsymop + ! if(all(abs(grp1%sym_save(j,:3,:3)-ident).le.tolerance))then + ! write(0,*) "FOUND TRANSLATION" + ! cycle reject_loop1 + ! end if + !end do + !! Check if inversions are present in comparison termination + do j=1,grp1%nsymop + if(abs(det(grp1%sym_save(j,:3,:3))+1._real32).le.tolerance) ltmp1=.true. + end do + !! If they are not, then no point comparing. It is a new termination + if(.not.ltmp1) exit prior_check + + call clone_grp(grp_store,grp1) + call check_sym(grp1,basis_arr(itmp2),& + tmpbas2=basis_arr_reject(i),iperm=-1,lsave=.true.,lcheck_all=.true.) + + !! Check det of all symmetry operations. If any are 1, move on + !! This is because they are just rotations as can be captured ... + !! ... through lattice matches. + !! Solely inversions are unique and must be captured. + do j=1,grp1%nsymop + !write(0,'(4(2X,F9.4))') grp1%sym_save(j,:,:) + !write(0,*) det(grp1%sym_save(j,:3,:3)) + if(abs(det(grp1%sym_save(j,:3,:3))-1._real32).le.tolerance) lunique=.false. + end do + if(grp1%sym_save(1,4,axis).eq.& + 2._real32*min(term_arr_uniq(itmp2)%hmin,0.5_real32-term_arr_uniq(itmp2)%hmin))then + lunique=.false. + end if + + if(.not.(all(grp1%sym_save(1,axis,:3).eq.vec_compare(:)).and.& + all(grp1%sym_save(1,:3,axis).eq.vec_compare(:)))) lunique=.false. + + end if prior_check + + if(lunique)then + mterm=mterm+1 + success(i)=itmp2 + term_arr_uniq(mterm)=term_arr(reject_match(i,1)) + !if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + ! mterm,& + ! term_arr_uniq(mterm)%hmin,& + ! term_arr_uniq(mterm)%hmax,term_arr_uniq(mterm)%natom + reject_match(i,2)=0 + term_arr_uniq(mterm)%nstep = 1 + allocate(term_arr_uniq(mterm)%ladder(ireject+1)) + term_arr_uniq(mterm)%ladder(1) = 0._real32 + else + term_arr_uniq(itmp2)%nstep = term_arr_uniq(itmp2)%nstep + 1 + term_arr_uniq(itmp2)%ladder(term_arr_uniq(itmp2)%nstep) = & + term_arr(itmp1)%hmin - term_arr_uniq(itmp2)%hmin + end if + end do reject_loop1 + + + !!-------------------------------------------------------------------------- + !! Populate termination output + !!-------------------------------------------------------------------------- + allocate(term%arr(mterm)) + term%tol=tol + term%axis=axis + term%nterm=mterm + term%lmirror = lmirror + if(ludef_print)& + write(6,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') + rtmp1 = term_arr_uniq(1)%hmin-1.E-6_real32 + itmp1 = 1 + do i=1,mterm + allocate(term%arr(i)%ladder(term_arr_uniq(i)%nstep)) + term%arr(i)%hmin = term_arr_uniq(itmp1)%hmin + term%arr(i)%hmax = term_arr_uniq(itmp1)%hmax + term%arr(i)%natom = term_arr_uniq(itmp1)%natom + term%arr(i)%nstep = term_arr_uniq(itmp1)%nstep + term%arr(i)%ladder(:term%arr(i)%nstep) = term_arr_uniq(i)%ladder(:term%arr(i)%nstep) + if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + i,term%arr(i)%hmin,term%arr(i)%hmax,term%arr(i)%natom + itmp1 = minloc(term_arr_uniq(:)%hmin,& + mask=term_arr_uniq(:)%hmin.gt.rtmp1+tol,dim=1) + if(itmp1.eq.0) then + itmp1 = minloc(term_arr_uniq(:)%hmin,& + mask=term_arr_uniq(:)%hmin.gt.rtmp1+tol-1._real32,dim=1) + end if + rtmp1 = term_arr_uniq(itmp1)%hmin + end do + term%nstep = maxval(term%arr(:)%nstep) + + + !!-------------------------------------------------------------------------- + !! Check to ensure equivalent number of steps for each termination + !!-------------------------------------------------------------------------- + !! Not yet certain whether each termination should have samve number ... + !! ... of ladder rungs. That's why this check is here. + if(all(term%arr(:)%nstep.ne.term%nstep))then + write(0,'("ERROR: Number of rungs in terminations no equivalent for & + &every termination! Please report this to developers.\n& + &Exiting...")') + call exit() + end if + + + end function get_termination_info +!############################################################################### + + +!############################################################################### + function get_term_list(term) result(list) + !! Function to get a list of all terminations in the system + implicit none + + ! Arguments + type(term_arr_type), intent(in) :: term + !! Termination info + type(term_list_type), allocatable, dimension(:) :: list + !! List of terminations + + ! Local variables + integer :: i, j + !! Loop indices + integer :: itmp1, nlist, loc + !! Temporary indices + type(term_list_type) :: tmp_element + !! Temporary element for swapping + + + if(.not.allocated(term%arr(1)%ladder))then + nlist = term%nterm + allocate(list(nlist)) + list(:)%loc = term%arr(:)%hmin + do i = 1, term%nterm + list(i)%term = i + end do + else + nlist = term%nstep*term%nterm + allocate(list(nlist)) + itmp1 = 0 + do i = 1, term%nterm + do j = 1, term%nstep + itmp1=itmp1+1 + list(itmp1)%loc = term%arr(i)%hmin+term%arr(i)%ladder(j) + list(itmp1)%loc = list(itmp1)%loc - & + ceiling( list(itmp1)%loc - 1._real32 ) + list(itmp1)%term = i + end do + end do + end if + + !! sort the list now + do i = 1, nlist + loc = minloc(list(i:nlist)%loc,dim=1) + i - 1 + tmp_element = list(i) + list(i) = list(loc) + list(loc) = tmp_element + end do + + end function get_term_list +!############################################################################### + + +!############################################################################### + subroutine set_layer_tol(term) + !! Set the tolerance for the layer definitions + implicit none + + ! Arguments + type(term_arr_type), intent(inout) :: term + !! Termination info + + ! Local variables + integer :: i + !! Loop index + real(real32) :: rtmp1 + !! Temporary variable for tolerance + + + do i = 1, term%nterm + if(i.eq.1)then + rtmp1 = abs(term%arr(i)%hmin - & + (term%arr(term%nterm)%hmax+term%arr(i)%ladder(term%nstep)-1._real32)& + )/4._real32 + else + rtmp1 = abs(term%arr(i)%hmin-term%arr(i-1)%hmax)/4._real32 + end if + if(rtmp1.lt.term%tol)then + term%tol = rtmp1 + end if + end do + + !! add the tolerances to the edges of the layers + !! this ensures that all atoms in the layers are captured + term%arr(:)%hmin = term%arr(:)%hmin - term%tol + term%arr(:)%hmax = term%arr(:)%hmax + term%tol + + end subroutine set_layer_tol +!############################################################################### + + +!############################################################################### + subroutine set_slab_height( basis, map, term, surf,& + height, num_layers, thickness, ncells,& + term_start, term_end, term_step & + ) + !! Extend the basis to the maximum required height for all terminations + !! + !! This procedure extends the basis to form a supercell of the required + !! integer extension along the surface normal vector. This supercell is + !! sufficiently large to be able to be cut down to all required + !! terminations. + implicit none + + ! Arguments + type(basis_type), intent(inout) :: basis + !! Basis to be extended + integer, allocatable, dimension(:,:,:), intent(inout) :: map + !! Map from the original basis to the extended basis + type(term_arr_type), intent(inout) :: term + !! List of termination information + integer, dimension(2), intent(in) :: surf + !! Surface termination indices (for a single slab with both surface indices) + integer, intent(in) :: num_layers + integer, intent(out) :: term_start, term_end, ncells + integer, intent(out) :: term_step + real(real32), intent(in) :: thickness + real(real32), intent(out) :: height + + + integer :: i,itmp1 + real(real32) :: rtmp1, slab_thickness, largest_sep + character(1024) :: msg + real(real32), dimension(3,3) :: tfmat + real(real32), allocatable, dimension(:) :: vtmp1 + type(term_list_type), allocatable, dimension(:) :: list + + + integer :: icell, istep, iterm + real(real32) :: layer_thickness + logical :: success + logical :: ludef_surf + + + !!-------------------------------------------------------------------- + !! Initialise variables + !!-------------------------------------------------------------------- + height = 0._real32 + + + !!----------------------------------------------------------------------- + !! Defines height of slab from user-defined values + !!----------------------------------------------------------------------- + ludef_surf = .false. + term_start = 1 + term_end = term%nterm + if(all(surf.ne.0))then + if(any(surf.gt.term%nterm))then + write(msg, '("INVALID SURFACE VALUES!\nOne or more value & + &exceeds the maximum number of terminations in the & + structure.\n& + & Supplied values: ",I0,1X,I0,"\n& + & Maximum allowed: ",I0)') surf, term%nterm + call err_abort(trim(msg),fmtd=.true.) + end if + ludef_surf = .true. + list = get_term_list(term) + !! set term_start to first surface value + term_start = surf(1) + !! set term_end to first surface value as a user-defined surface ... + !! ... should not be cycled over. + !! it is just one, potentially assymetric, slab to be explored. + term_end = surf(1) + + !! determines the maximum number of cells required + allocate(vtmp1(size(list))) + height = term%arr(term_start)%hmin + do i=num_layers,2,-1 + vtmp1 = list(:)%loc - height + vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) + itmp1 = minloc( vtmp1(:), dim=1,& + mask=& + vtmp1(:).gt.0.and.& + list(:)%term.eq.surf(1)) + height = height + vtmp1(itmp1) + end do + vtmp1 = list(:)%loc - height + !vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) + where(vtmp1.lt.-1.D-5) + vtmp1 = vtmp1 - ceiling( vtmp1 + 1.D-5 - 1._real32 ) + end where + itmp1 = minloc( vtmp1(:), dim=1,& + mask=& + vtmp1(:).ge.-1.D-5.and.& + list(:)%term.eq.surf(2)) + height = height + vtmp1(itmp1) - term%arr(term_start)%hmin + + !if(.not.term%lmirror)then + ! get thickness of top/surface layer + rtmp1 = term%arr(surf(2))%hmax - term%arr(surf(2))%hmin + if(rtmp1.lt.-1.D-5) rtmp1 = rtmp1 + 1._real32 + height = height + rtmp1 !(1._real32 - rtmp1) + !end if + + ncells = ceiling(height) + height = height/real(ncells,real32) + end if + + + !!----------------------------------------------------------------------- + !! Define termination iteration counter + !!----------------------------------------------------------------------- + if(term_end.lt.term_start)then + term_step = -1 + else + term_step = 1 + end if + + + !!----------------------------------------------------------------------- + !! Extend slab to user-defined thickness + !!----------------------------------------------------------------------- + if(.not.ludef_surf) ncells = int((num_layers-1)/term%nstep)+1 + !! convert thickness, in angstroms to number of cells + if(thickness.gt.0._real32)then + select case(term%axis) + case(1) + slab_thickness = dot_product(uvec(cross(basis%lat(2,:),basis%lat(3,:))), basis%lat(1,:)) + case(2) + slab_thickness = dot_product(uvec(cross(basis%lat(1,:),basis%lat(3,:))), basis%lat(2,:)) + case(3) + slab_thickness = dot_product(uvec(cross(basis%lat(1,:),basis%lat(2,:))), basis%lat(3,:)) + end select + ! get the largest separation between two terminations + if(ludef_surf)then + + height = 0.E0 + largest_sep = abs( term%arr(surf(1))%hmin - & + term%arr(surf(2))%ladder(term%nstep) - & + term%arr(surf(2))%hmax + 1._real32 ) + if(largest_sep.lt.0._real32) largest_sep = 1._real32 + largest_sep + ! check for all terminations that a certain step is sufficiently large to reproduce thickness + cell_loop1: do icell = 0, ceiling(thickness/slab_thickness), 1 + layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol + success = .false. + step_loop1: do istep = 1, term%nstep, 1 + if(surf(2).lt.surf(1))then + if(istep.eq.term%nstep)then + layer_thickness = & + term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - & + 2.E0 * term%tol + ( & + 1.E0 + term%arr(surf(2))%ladder(1) - & + term%arr(surf(1))%ladder(term%nstep) & + ) + else + layer_thickness = & + term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - & + 2.E0 * term%tol + ( & + term%arr(surf(2))%ladder(istep+1) - & + term%arr(surf(1))%ladder(istep) & + ) + end if + end if + rtmp1 = & + ( & + icell + layer_thickness + & + term%arr(surf(2))%ladder(istep) - & + term%arr(surf(1))%ladder(1) & + ) * slab_thickness + if(rtmp1.ge.thickness)then + success = .true. + height = rtmp1 + 2.E0 * term%tol * slab_thickness + exit step_loop1 + end if + end do step_loop1 + if(.not.success) cycle cell_loop1 + ncells = icell + 1 + exit cell_loop1 + end do cell_loop1 + + else + largest_sep = abs( term%arr(1)%hmin - & + term%arr(1)%ladder(term%nstep) - & + term%arr(1)%hmax + 1._real32 ) + if(largest_sep.lt.0._real32) largest_sep = 1._real32 + largest_sep + ! check for all terminations that a certain step is sufficiently large to reproduce thickness + cell_loop2: do icell = 0, ceiling(thickness/slab_thickness), 1 + term_loop: do iterm = 1, term%nterm, 1 + layer_thickness = term%arr(iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol + success = .false. + step_loop: do istep = 1, term%nstep, 1 + rtmp1 = ( icell + layer_thickness + term%arr(iterm)%ladder(istep) ) * slab_thickness + if(rtmp1.ge.thickness)then + success = .true. + exit step_loop + end if + end do step_loop + if(.not.success) cycle cell_loop2 + end do term_loop + ncells = icell + 1 + exit cell_loop2 + end do cell_loop2 + + end if + height = height/real(ncells * slab_thickness,real32) + end if + tfmat(:,:) = 0._real32 + tfmat(1,1) = 1._real32 + tfmat(2,2) = 1._real32 + tfmat(3,3) = ncells + call transformer(basis,tfmat,map) + + + !!----------------------------------------------------------------------- + !! Readjust termination plane locations + !! ... i.e. divide all termination values by the number of cells + !!----------------------------------------------------------------------- + term%arr(:)%hmin = term%arr(:)%hmin/real(ncells,real32) + term%arr(:)%hmax = term%arr(:)%hmax/real(ncells,real32) + term%tol = term%tol/real(ncells,real32) + + + end subroutine set_slab_height +!############################################################################### + + + +!############################################################################### + subroutine build_slab( & + basis, map, term, surf, thickness, ncells, num_layers, & + height, lwup_in, lcycle, & + orthogonalise, vacuum & + ) + !! Build a slab of the specified terminations + !! + !! This procedure builds a slab of the specified terminations from a + !! supplied supercell. The supercell must be large enough to be able to + !! be cut down to the required slab size. The supercell is built by + !! set_slab_height. + implicit none + + ! Arguments + type(basis_type), intent(inout) :: basis + !! Basis to be extended + integer, allocatable, dimension(:,:,:), intent(inout) :: map + !! Map from the original basis to the extended basis + type(term_arr_type), intent(in) :: term + !! Termination info + integer, dimension(2), intent(in) :: surf + !! Surface termination indices (for a single slab with both surface indices) + + integer, intent(in) :: num_layers, ncells + real(real32), intent(in) :: height, thickness + character(2), intent(in) :: lwup_in + logical, intent(out) :: lcycle + + logical, optional, intent(in) :: orthogonalise + real(real32), optional, intent(in) :: vacuum + + + ! Local variables + integer :: term_btm_idx, term_top_idx + !! Indices of the bottom and top terminations + logical :: equivalent_surfaces + !! Boolean whether the two surfaces are equivalent + real(real32) :: vacuum_ + integer :: j, j_start, istep, natom_check + real(real32) :: rtmp1, slab_thickness, shift_val + character(2) :: lwup + character(5) :: lowerupper + character(1024) :: msg + logical :: orthogonalise_ + integer, dimension(3) :: abc=(/1,2,3/) + real(real32), dimension(3) :: surface_normal_vec + real(real32), dimension(3,3) :: tfmat + integer, allocatable, dimension(:) :: iterm_list + + + integer :: icell, num_cells + real(real32) :: layer_thickness, ladder_adjust + + !!-------------------------------------------------------------------- + !! Initialise variables + !!-------------------------------------------------------------------- + lwup=to_lower(lwup_in) + if(lwup.eq."lw") lowerupper="LOWER" + if(lwup.eq."up") lowerupper="UPPER" + lcycle = .false. + rtmp1=0._real32 + tfmat=0._real32 + term_btm_idx = surf(1) + if(surf(2).gt.0)then + term_top_idx = surf(2) + else + term_top_idx = surf(1) + end if + equivalent_surfaces = .false. + if(term_btm_idx.eq.term_top_idx) equivalent_surfaces = .true. + select case(term%axis) + case(1) + surface_normal_vec = uvec(cross( [ basis%lat(2,:) ], [ basis%lat(3,:) ])) + slab_thickness = abs( dot_product(surface_normal_vec, [ basis%lat(1,:) ]) ) + case(2) + surface_normal_vec = uvec(cross( [ basis%lat(1,:) ], [ basis%lat(3,:) ])) + slab_thickness = abs( dot_product(surface_normal_vec, [ basis%lat(2,:) ]) ) + case(3) + surface_normal_vec = uvec(cross( [ basis%lat(1,:) ], [ basis%lat(2,:)] )) + slab_thickness = abs( dot_product(surface_normal_vec, [ basis%lat(3,:) ]) ) + end select + if(thickness.gt.0._real32)then + rtmp1 = slab_thickness / ncells * ( ncells - 1 ) + istep = term%nstep + num_cells = ncells - 1 + cell_loop: do icell = 0, ncells, 1 + layer_thickness = term%arr(term_top_idx)%hmax - term%arr(term_btm_idx)%hmin - 2.E0 * term%tol + ladder_adjust = 0._real32 + step_loop: do j = 1, term%nstep + if(term_top_idx.lt.term_btm_idx)then + if(j.eq.term%nstep)then + layer_thickness = term%arr(term_top_idx)%hmax - term%arr(term_btm_idx)%hmin - 2.E0 * term%tol + ladder_adjust = 1.E0 + term%arr(term_top_idx)%ladder(1) - term%arr(term_btm_idx)%ladder(term%nstep) + else + layer_thickness = term%arr(term_top_idx)%hmax - term%arr(term_btm_idx)%hmin - 2.E0 * term%tol + ladder_adjust = term%arr(term_top_idx)%ladder(j+1) - term%arr(term_btm_idx)%ladder(j) + end if + end if + rtmp1 = ( icell / real(ncells,real32) + layer_thickness ) * slab_thickness + & + ( ladder_adjust + term%arr(term_top_idx)%ladder(j) - term%arr(term_btm_idx)%ladder(1) ) * slab_thickness / real(ncells,real32) + if(rtmp1.ge.thickness)then + istep = j + num_cells = icell + exit cell_loop + end if + end do step_loop + end do cell_loop + else + istep = num_layers - (ncells-1)*term%nstep + num_cells = ncells - 1 + end if + natom_check = basis%natom + + orthogonalise_ = .true. + if(present(orthogonalise)) orthogonalise_ = orthogonalise + + vacuum_ = 10._real32 + if(present(vacuum)) vacuum_ = vacuum + + + !!-------------------------------------------------------------------- + !! Set up list for checking expected number of atoms + !!-------------------------------------------------------------------- + allocate(iterm_list(term%nterm)) + do j = 1, term%nterm + iterm_list(j) = j + end do + iterm_list = cshift( iterm_list, term_btm_idx - 1 ) + if(equivalent_surfaces)then + j_start = term_top_idx - term_btm_idx + 1 + if(j_start.le.0) j_start = j_start + term%nterm + j_start = j_start + 1 !+ (istep-1)*term%nterm/term%nstep + else + !! handle ladder steps that are equivalent + j_start = 2 !+ (istep-1)*term%nterm/term%nstep + end if + + + !!-------------------------------------------------------------------- + !! Shift lower material to specified termination + !!-------------------------------------------------------------------- + call shifter(basis,term%axis,-term%arr(term_btm_idx)%hmin,.true.) + + + !!-------------------------------------------------------------------- + !! Determine cell reduction to specified termination + !!-------------------------------------------------------------------- + do j = 1, 3 + tfmat(j,j) = 1._real32 + if(j.eq.term%axis)then + if(equivalent_surfaces)then + tfmat(j,j) = height + else!if(term%lmirror)then + if(istep.ne.0)then + rtmp1 = num_cells + term%arr(term_btm_idx)%ladder(istep) + rtmp1 = rtmp1/(ncells) + tfmat(j,j) = rtmp1 + tfmat(j,j) = tfmat(j,j) + & + (term%arr(term_btm_idx)%hmax - term%arr(term_btm_idx)%hmin) + end if + !else + ! tfmat(j,j) = tfmat(j,j) + (& + ! term%arr(term_btm_idx)%hmax - & + ! term%arr(term_btm_idx)%hmin) + term%tol*2._real32 + end if + end if + end do + + + !!-------------------------------------------------------------------- + !! Check number of atoms is expected + !!-------------------------------------------------------------------- + if(num_cells.ne.ncells-1)then + do icell = num_cells + 2, ncells, 1 + natom_check = natom_check - nint( basis%natom / real(ncells) ) + end do + end if + + + !!-------------------------------------------------------------------- + !! Apply transformation and shift cell back to bottom of layer + !! ... i.e. account for the tolerance that has been added to layer ... + !! ... hmin and hmax + !!-------------------------------------------------------------------- + shift_val = term%tol * slab_thickness / modu(basis%lat(term%axis,:)) + call transformer(basis,tfmat,map) + call shifter(basis,term%axis,-shift_val/tfmat(term%axis,term%axis),.true.) + + + !!-------------------------------------------------------------------- + !! Check number of atoms is expected + !!-------------------------------------------------------------------- + if(term%nterm.gt.1.or.term%nstep.gt.1)then + do j = 1, max(0,term%nstep-istep), 1 + natom_check = natom_check - sum(term%arr(:)%natom) + end do + do j = j_start, term%nterm, 1 + natom_check = natom_check - term%arr(iterm_list(j))%natom + end do + end if + if(basis%natom.ne.natom_check)then + write(msg, '("NUMBER OF ATOMS IN '//to_upper(lowerupper)//' SLAB! & + &Expected ",I0," but generated ",I0," instead")') & + natom_check,basis%natom + if(tfmat(term%axis,term%axis).gt.1._real32)then + write(0,'("THE TRANSFORMATION IS GREATER THAN ONE ",F0.9)') & + tfmat(term%axis,term%axis) + end if + !call err_abort(trim(msg),fmtd=.true.) + call err_abort_print_struc(basis,lwup//"_term.vasp",& + trim(msg),.true.) + lcycle = .true. + end if + + + !!-------------------------------------------------------------------- + !! Apply slab_cuber to orthogonalise lower material + !!-------------------------------------------------------------------- + call set_vacuum(basis,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum_) + !call err_abort_print_struc(basis,"check.vasp","stop") + abc=cshift(abc,3-term%axis) + if(orthogonalise_)then + ortho_check: do j=1,2 + if(abs(dot_product(basis%lat(abc(j),:),basis%lat(term%axis,:))).gt.1.D-5)then + call ortho_axis(basis%lat,basis,term%axis) + exit ortho_check + end if + end do ortho_check + end if + call basis%normalise(ceil_val=0.9999_real32,floor_coords=.true.,zero_round=0._real32) + + + end subroutine build_slab +!############################################################################### + +end module artemis__terminations diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 2f55b16..0449484 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -18,21 +18,16 @@ module artemis__generator use edit_geom, only: planecutter,primitive_lat,ortho_axis,& shift_region,set_vacuum,transformer,shifter,reducer,& get_min_bulk_bond,get_min_bond,get_shortest_bond,bond_type,& - share_strain, MATNORM, basis_stack - use mod_sym, only: term_arr_type,confine_type,gldfnd,& - get_terminations,get_primitive_cell + share_strain, MATNORM, basis_stack, compare_stoichiometry + use artemis__sym, only: confine_type,gldfnd,& + get_primitive_cell + use artemis__terminations, only: get_termination_info, term_arr_type, set_slab_height, set_layer_tol, build_slab use swapping, only: rand_swapper use shifting !!! CHANGE TO SHIFTER? implicit none integer, private :: intf=0 real(real32), private, parameter :: tmp_vac = 14._real32 - - type term_list_type - integer :: term - real(real32) :: loc - end type term_list_type - private :: term_list_type type(bulk_DON_type), dimension(2) :: bulk_DON @@ -198,7 +193,7 @@ subroutine generate_terminations( & ! Local variables integer :: itmp1, iterm, term_start, term_end, iterm_step, i !! Termination loop variables - integer :: old_natom, ncells, ntrans + integer :: ncells, ntrans !! Number of cells in the slab integer :: num_structures !! Number of structures to be generated @@ -206,8 +201,8 @@ subroutine generate_terminations( & !! Number of layers in the slab real(real32) :: height !! Height of the slab - logical :: ludef_surf, lignore - !! User-defined surface + logical :: lcycle + !! Boolean whether to cycle through the slab type(basis_type) :: tmp_bas1,tmp_bas2 !! Temporary basis structures type(confine_type) :: confine @@ -242,7 +237,6 @@ subroutine generate_terminations( & confine%axis = axis confine%laxis = .false. confine%laxis(axis) = .true. - old_natom = tmp_bas1%natom if(allocated(trans)) deallocate(trans) allocate(trans(minval(tmp_bas1%spec(:)%num+2),3)) call gldfnd(confine, tmp_bas1, tmp_bas1, trans, ntrans) @@ -258,10 +252,20 @@ subroutine generate_terminations( & end if if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 call transformer(tmp_bas1,tfmat,bas_map) + if(.not.compare_stoichiometry(tmp_bas1,basis))then + write(0,'(1X,"ERROR: Internal error in generate_terminations")') + write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the material")') + if(ierror.eq.1)then + call err_abort_print_struc(tmp_bas1, "broken_primitive.vasp", & + "Code exiting due to IPRINT = 1") + end if + write(0,'(2X,"Skipping this lattice match")') + return + end if ! get the terminations - term = get_terminations( & - tmp_bas1%lat, tmp_bas1, axis, & + term = get_termination_info( & + tmp_bas1, axis, & lprint = .true., layer_sep = this%layer_separation_cutoff, & break_on_fail = lbreak_on_no_term & ) @@ -284,11 +288,10 @@ subroutine generate_terminations( & call set_layer_tol(term) ! determine required extension and perform that - call set_slab_height(tmp_bas1%lat,tmp_bas1,bas_map,term,lw_surf,old_natom,& + call set_slab_height(tmp_bas1,bas_map,term,lw_surf,& height,num_layers_, thickness, ncells,& - term_start,term_end,iterm_step,ludef_surf,& - "lw",lignore) - + term_start,term_end,iterm_step & + ) !--------------------------------------------------------------------------- ! Normalise lattice @@ -309,9 +312,10 @@ subroutine generate_terminations( & call output(i)%copy(tmp_bas1) if(allocated(t1bas_map)) deallocate(t1bas_map) allocate(t1bas_map,source=bas_map) - call prepare_slab(output(i)%lat,output(i),bas_map,term,iterm,& - num_layers_,ncells, thickness, height,ludef_surf,lw_surf(2),& - "lw",lignore,lortho,vacuum) + call build_slab(output(i),bas_map,term,[iterm,lw_surf(2)],& + thickness, ncells, num_layers_, height,& + "lw",lcycle,lortho,vacuum & + ) end do if(.not.allocated(this%structures))then call move_alloc(output,this%structures) @@ -481,37 +485,54 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! Upper bulk structure ! Local variables + real(real32) :: avg_min_bond + !! Average minimum bond length + type(basis_type) :: basis_lw_, basis_up_ !! Temporary basis structures + type(basis_type) :: supercell_lw, supercell_up + !! Copy of the basis structures + type(basis_type) :: slab_lw, slab_up + !! Slab structures + type(basis_type) :: interface + !! Interface structure + character(len=256) :: err_msg + !! Error message + + integer :: j + !! Loop index + integer :: ifit, intf_start, intf_end + !! Interface loop indices + integer :: iterm_lw, term_lw_start_idx, term_lw_end_idx, term_lw_step + !! Lower bulk termination loop indices + integer :: iterm_up, term_up_start_idx, term_up_end_idx, term_up_step + !! Upper bulk termination loop indices + + ! slab thickness variables + integer :: ncells_lw, ncells_up + !! Number of cells in the slab + real(real32) :: height_lw, height_up + !! Height of the slab + + - integer :: j,iterm,jterm,ntrans,ifit,iunique,old_natom,itmp1,old_intf - integer :: iterm_step,jterm_step - integer :: lw_ncells,up_ncells + integer :: ntrans,iunique,itmp1,old_intf integer :: lw_layered_axis,up_layered_axis - integer :: intf_start,intf_end - integer :: lw_term_start,lw_term_end,up_term_start,up_term_end - real(real32) :: avg_min_bond - real(real32) :: lw_height,up_height real(real32) :: dtmp1,bondlength character(3) :: abc character(1024) :: pwd,intf_dir,dirpath,msg, filename logical :: ludef_lw_surf,ludef_up_surf,lcycle - type(basis_type) :: sbas - type(basis_type) :: lw_bas,up_bas,tlw_bas,tup_bas - type(tol_type) :: tolerance type(confine_type) :: confine type(latmatch_type) :: SAV type(term_arr_type) :: lw_term,up_term integer, dimension(3) :: ivtmp1 real(real32), dimension(2) :: intf_loc - real(real32), dimension(3) :: init_offset=[0._real32,0._real32,2._real32] - !real(real32), dimension(3,3) :: mtmp1,DONup_lat - real(real32), dimension(3,3) :: tfmat,slat - real(real32), dimension(3,3) :: lw_lat,up_lat,tlw_lat,tup_lat + real(real32), dimension(3) :: init_offset = [0._real32,0._real32,2._real32] + !real(real32), dimension(3,3) :: mtmp1,DONsupercell_up%lat + real(real32), dimension(3,3) :: tfmat integer, allocatable, dimension(:,:,:) :: lw_map,t1lw_map,t2lw_map integer, allocatable, dimension(:,:,:) :: up_map,t1up_map,t2up_map real(real32), allocatable, dimension(:,:) :: trans - character(len=256) :: err_msg !!!----------------------------------------------------------------------------- @@ -537,6 +558,12 @@ subroutine generate_interfaces(this, basis_lw, basis_up) basis_up_%lat=primitive_lat(basis_up_%lat) end if write(6,*) + + + ludef_lw_surf = .false. + if(all(lw_surf.gt.0)) ludef_lw_surf = .true. + ludef_up_surf = .false. + if(all(up_surf.gt.0)) ludef_up_surf = .true. @@ -772,10 +799,10 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!!----------------------------------------------------------------------------- !!! Applies the best match transformations !!!----------------------------------------------------------------------------- - intf_loop: do ifit=intf_start,intf_end + intf_loop: do ifit = intf_start, intf_end write(6,'("Fit number: ",I0)') ifit - call lw_bas%copy(basis_lw_) - call up_bas%copy(basis_up_) + call supercell_lw%copy(basis_lw_) + call supercell_up%copy(basis_up_) if(allocated(t1lw_map)) deallocate(t1lw_map) if(allocated(t1up_map)) deallocate(t1up_map) allocate(t1lw_map,source=lw_map) @@ -785,8 +812,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Applies the best match transformations !!----------------------------------------------------------------------- - call transformer(lw_bas,real(SAV%tf1(ifit,:,:),real32),t1lw_map) - call transformer(up_bas,real(SAV%tf2(ifit,:,:),real32),t1up_map) + call transformer(supercell_lw,real(SAV%tf1(ifit,:,:),real32),t1lw_map) + call transformer(supercell_up,real(SAV%tf2(ifit,:,:),real32),t1up_map) !!----------------------------------------------------------------------- @@ -799,10 +826,10 @@ subroutine generate_interfaces(this, basis_lw, basis_up) t1up_map=0 !TEMPORARY TO USE SUPERCELL DONS. !do i=1,2 ! mtmp1(i,:) = & - ! ( modu(lw_lat(i,:)) )*uvec(up_lat(i,:)) + ! ( modu(lw_lat(i,:)) )*uvec(supercell_up%lat(i,:)) !end do - !mtmp1(3,:) = up_lat(3,:) - !DONup_lat = matmul(mtmp1,inverse(real(SAV%tf2(ifit,:,:),real32))) + !mtmp1(3,:) = supercell_up%lat(3,:) + !DONsupercell_up%lat = matmul(mtmp1,inverse(real(SAV%tf2(ifit,:,:),real32))) !if(ierror.eq.1)then ! write(0,*) "#####################################" ! write(0,*) "ifit", ifit @@ -810,11 +837,11 @@ subroutine generate_interfaces(this, basis_lw, basis_up) ! write(0,'(3(2X,F6.2))') (mtmp1(i,:),i=1,3) ! write(0,*) ! write(0,*) "deformed lattice" - ! write(0,'(3(2X,F8.4))') (DONup_lat(i,:),i=1,3) + ! write(0,'(3(2X,F8.4))') (DONsupercell_up%lat(i,:),i=1,3) ! write(0,*) !end if deallocate(bulk_DON(2)%spec) - bulk_DON(2)%spec=gen_DON(up_lat,up_bas,& + bulk_DON(2)%spec=gen_DON(supercell_up%lat,supercell_up,& dist_max=max_bondlength,& scale_dist=.false.,& norm=.true.) @@ -832,10 +859,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) confine%axis=axis confine%laxis=.false. confine%laxis(axis)=.true. - old_natom=lw_bas%natom if(allocated(trans)) deallocate(trans) - allocate(trans(minval(lw_bas%spec(:)%num+2),3)) - call gldfnd(confine,lw_bas,lw_bas,trans,ntrans) + allocate(trans(minval(supercell_lw%spec(:)%num+2),3)) + call gldfnd(confine,supercell_lw,supercell_lw,trans,ntrans) tfmat(:,:)=0._real32 tfmat(1,1)=1._real32 tfmat(2,2)=1._real32 @@ -843,19 +869,29 @@ subroutine generate_interfaces(this, basis_lw, basis_up) tfmat(3,3)=1._real32 else itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& - mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(lw_lat(axis,:))) + mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(supercell_lw%lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 - call transformer(lw_bas,tfmat,t1lw_map) + call transformer(supercell_lw,tfmat,t1lw_map) + if(.not.compare_stoichiometry(basis_lw_,supercell_lw))then + write(0,'(1X,"ERROR: Internal error in generate_interfaces")') + write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the lower material on match ",I0)') ifit + if(ierror.eq.1)then + call err_abort_print_struc(supercell_lw, "broken_primitive.vasp", & + "Code exiting due to IPRINT = 1") + end if + write(0,'(2X,"Skipping this lattice match")') + cycle intf_loop + end if !!----------------------------------------------------------------------- !! Finds all terminations parallel to the surface plane !!----------------------------------------------------------------------- if(allocated(lw_term%arr)) deallocate(lw_term%arr) - lw_term = get_terminations( & - lw_lat, lw_bas, axis, & + lw_term = get_termination_info( & + supercell_lw, axis, & lprint = lprint_terms, layer_sep = lw_layer_sep, & break_on_fail = lbreak_on_no_term & ) @@ -866,15 +902,23 @@ subroutine generate_interfaces(this, basis_lw, basis_up) ) SAV%tf1(ifit,3,1:3) cycle intf_loop end if + if(any(lw_surf.gt.lw_term%nterm))then + write(msg, '("LW_SURFACE VALUES INVALID!\nOne or more value & + &exceeds the maximum number of terminations in the & + structure.\n& + & Supplied values: ",I0,1X,I0,"\n& + & Maximum allowed: ",I0)') lw_surf, lw_term%nterm + call err_abort(trim(msg),fmtd=.true.) + end if !!----------------------------------------------------------------------- !! Sort out ladder rungs (checks whether the material is centrosymmetric) !!----------------------------------------------------------------------- - !call setup_ladder(lw_lat,lw_bas,axis,lw_term) - if(sum(lw_term%arr(:)%natom)*lw_term%nstep.ne.lw_bas%natom)then + !call setup_ladder(supercell_lw%lat,supercell_lw,axis,lw_term) + if(sum(lw_term%arr(:)%natom)*lw_term%nstep.ne.supercell_lw%natom)then write(msg, '("ERROR: Number of atoms in lower layers not correct: "& - &I0,2X,I0)') sum(lw_term%arr(:)%natom)*lw_term%nstep,lw_bas%natom + &I0,2X,I0)') sum(lw_term%arr(:)%natom)*lw_term%nstep,supercell_lw%natom call err_abort(trim(msg),fmtd=.true.) end if call set_layer_tol(lw_term) @@ -883,11 +927,11 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Defines height of lower slab from user-defined values !!----------------------------------------------------------------------- - call set_slab_height(lw_lat,lw_bas,t1lw_map,lw_term,lw_surf, old_natom,& - lw_height,lw_num_layers, lw_thickness,lw_ncells,& - lw_term_start,lw_term_end,iterm_step,ludef_lw_surf,& - "lw",lcycle) - if(lcycle) cycle intf_loop + call set_slab_height(supercell_lw,t1lw_map,lw_term,lw_surf,& + height_lw,lw_num_layers, lw_thickness,ncells_lw,& + term_lw_start_idx,term_lw_end_idx,term_lw_step & + ) + if(term_lw_end_idx.gt.this%max_num_term) term_lw_end_idx = this%max_num_term !!----------------------------------------------------------------------- @@ -895,10 +939,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! ... user-defined thickness !! SHOULD MAKE IT LATER MAKE DIFFERENT SETS OF THICKNESSES !!----------------------------------------------------------------------- - old_natom=up_bas%natom deallocate(trans) - allocate(trans(minval(up_bas%spec(:)%num+2),3)) - call gldfnd(confine,up_bas,up_bas,trans,ntrans) + allocate(trans(minval(supercell_up%spec(:)%num+2),3)) + call gldfnd(confine,supercell_up,supercell_up,trans,ntrans) tfmat(:,:)=0._real32 tfmat(1,1)=1._real32 tfmat(2,2)=1._real32 @@ -906,19 +949,30 @@ subroutine generate_interfaces(this, basis_lw, basis_up) tfmat(3,3)=1._real32 else itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& - mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(lw_lat(axis,:))) + mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(supercell_lw%lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 - call transformer(up_bas,tfmat,t1up_map) + call transformer(supercell_up,tfmat,t1up_map) + ! check the stoichiometry ratios are still maintained + if(.not.compare_stoichiometry(basis_up_,supercell_up))then + write(0,'(1X,"ERROR: Internal error in generate_interfaces")') + write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the upper material on match ",I0)') ifit + if(ierror.eq.1)then + call err_abort_print_struc(supercell_up, "broken_primitive.vasp", & + "Code exiting due to IPRINT = 1") + end if + write(0,'(2X,"Skipping this lattice match")') + cycle intf_loop + end if !!----------------------------------------------------------------------- - !! Finds all up_lat unique terminations parallel to the surface plane + !! Finds all supercell_up%lat unique terminations parallel to the surface plane !!----------------------------------------------------------------------- if(allocated(up_term%arr)) deallocate(up_term%arr) - up_term = get_terminations( & - up_lat, up_bas, axis, & + up_term = get_termination_info( & + supercell_up, axis, & lprint = lprint_terms, layer_sep = up_layer_sep, & break_on_fail = lbreak_on_no_term & ) @@ -929,15 +983,23 @@ subroutine generate_interfaces(this, basis_lw, basis_up) ) SAV%tf2(ifit,3,1:3) cycle intf_loop end if + if(any(up_surf.gt.up_term%nterm))then + write(msg, '("UP_SURFACE VALUES INVALID!\nOne or more value & + &exceeds the maximum number of terminations in the & + structure.\n& + & Supplied values: ",I0,1X,I0,"\n& + & Maximum allowed: ",I0)') up_surf, up_term%nterm + call err_abort(trim(msg),fmtd=.true.) + end if !!----------------------------------------------------------------------- !! Sort out ladder rungs (checks whether the material is centrosymmetric) !!----------------------------------------------------------------------- - !call setup_ladder(up_lat,up_bas,axis,up_term) - if(sum(up_term%arr(:)%natom)*up_term%nstep.ne.up_bas%natom)then + !call setup_ladder(supercell_up%lat,supercell_up,axis,up_term) + if(sum(up_term%arr(:)%natom)*up_term%nstep.ne.supercell_up%natom)then write(msg, '("ERROR: Number of atoms in upper layers not correct: "& - &I0,2X,I0)') sum(up_term%arr(:)%natom)*up_term%nstep,up_bas%natom + &I0,2X,I0)') sum(up_term%arr(:)%natom)*up_term%nstep,supercell_up%natom call err_abort(trim(msg),fmtd=.true.) end if call set_layer_tol(up_term) @@ -946,11 +1008,11 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Defines height of upper slab from user-defined values !!----------------------------------------------------------------------- - call set_slab_height(up_lat,up_bas,t1up_map,up_term,up_surf,old_natom,& - up_height,up_num_layers, up_thickness, up_ncells,& - up_term_start,up_term_end,jterm_step,ludef_up_surf,& - "up",lcycle) - if(lcycle) cycle intf_loop + call set_slab_height(supercell_up,t1up_map,up_term,up_surf,& + height_up,up_num_layers, up_thickness, ncells_up,& + term_up_start_idx,term_up_end_idx,term_up_step & + ) + if(term_up_end_idx.gt.this%max_num_term) term_up_end_idx = this%max_num_term !!----------------------------------------------------------------------- @@ -963,15 +1025,15 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! Cycle over terminations of both materials and generates interfaces ... !! ... composed of all of the possible combinations of the two !!----------------------------------------------------------------------- - lw_term_loop: do iterm=lw_term_start,lw_term_end,iterm_step - call tlw_bas%copy(lw_bas) + lw_term_loop: do iterm_lw = term_lw_start_idx, term_lw_end_idx, term_lw_step + call slab_lw%copy(supercell_lw) if(allocated(t2lw_map)) deallocate(t2lw_map) allocate(t2lw_map,source=t1lw_map) !!-------------------------------------------------------------------- !! Shifts lower material to specified termination !!-------------------------------------------------------------------- - call prepare_slab(tlw_lat,tlw_bas,t2lw_map,lw_term,iterm,& - lw_num_layers,lw_ncells, lw_thickness,lw_height,ludef_lw_surf,lw_surf(2),& + call build_slab(slab_lw,t2lw_map,lw_term,[iterm_lw,lw_surf(2)],& + lw_thickness, ncells_lw, lw_num_layers, height_lw,& "lw",lcycle) if(lcycle) cycle lw_term_loop @@ -979,12 +1041,12 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!-------------------------------------------------------------------- !! Cycles over terminations of upper material !!-------------------------------------------------------------------- - up_term_loop: do jterm=up_term_start,up_term_end,jterm_step - call tup_bas%copy(up_bas) + up_term_loop: do iterm_up = term_up_start_idx, term_up_end_idx, term_up_step + call slab_up%copy(supercell_up) if(allocated(t2up_map)) deallocate(t2up_map) allocate(t2up_map,source=t1up_map) - call prepare_slab(tup_lat,tup_bas,t2up_map,up_term,jterm,& - up_num_layers,up_ncells, up_thickness, up_height,ludef_up_surf,up_surf(2),& + call build_slab(slab_up,t2up_map,up_term,[iterm_up,up_surf(2)],& + up_thickness, ncells_up, up_num_layers, height_up,& "up",lcycle) if(lcycle) cycle up_term_loop @@ -992,9 +1054,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- !! Checks stoichiometry !!----------------------------------------------------------------- - if(tlw_bas%nspec.ne.basis_lw_%nspec.or.any(& - (basis_lw_%spec(1)%num*tlw_bas%spec(:)%num)& - /tlw_bas%spec(1)%num.ne.basis_lw_%spec(:)%num))then + if(slab_lw%nspec.ne.basis_lw_%nspec.or.any(& + (basis_lw_%spec(1)%num*slab_lw%spec(:)%num)& + /slab_lw%spec(1)%num.ne.basis_lw_%spec(:)%num))then write(6,'("WARNING: This lower surface termination is not & &stoichiometric")') if(lw_layered)then @@ -1004,9 +1066,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) cycle lw_term_loop end if end if - if(tup_bas%nspec.ne.basis_up_%nspec.or.any(& - (basis_up_%spec(1)%num*tup_bas%spec(:)%num)& - /tup_bas%spec(1)%num.ne.basis_up_%spec(:)%num))then + if(slab_up%nspec.ne.basis_up_%nspec.or.any(& + (basis_up_%spec(1)%num*slab_up%spec(:)%num)& + /slab_up%spec(1)%num.ne.basis_up_%spec(:)%num))then write(6,'("WARNING: This upper surface termination is not & &stoichiometric")') if(up_layered)then @@ -1022,7 +1084,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! Use the bulk moduli to determine the strain sharing !!----------------------------------------------------------------- if(lw_bulk_modulus.ne.0.E0.and.up_bulk_modulus.ne.0.E0)then - call share_strain(tlw_lat,tup_lat,& + call share_strain(slab_lw%lat,slab_up%lat,& lw_bulk_modulus,up_bulk_modulus,lcompensate=.not.lc_fix) end if @@ -1030,27 +1092,27 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- !! Merge the two bases and lattices and define the interface loc !!----------------------------------------------------------------- - sbas = basis_stack(& - basis1 = tlw_bas, basis2 = tup_bas, & + interface = basis_stack(& + basis1 = slab_lw, basis2 = slab_up, & axis = axis, offset = init_offset(:), & map1 = t2lw_map, map2 = t2up_map & ) - intf_loc(1) = ( modu(tlw_lat(axis,:)) + 0.5_real32*init_offset(axis) - & - tmp_vac)/modu(slat(axis,:)) - intf_loc(2) = ( modu(tlw_lat(axis,:)) + modu(tup_lat(axis,:)) + & - 1.5_real32*init_offset(axis) - 2._real32*tmp_vac )/modu(slat(axis,:)) + intf_loc(1) = ( modu(slab_lw%lat(axis,:)) + 0.5_real32*init_offset(axis) - & + tmp_vac)/modu(interface%lat(axis,:)) + intf_loc(2) = ( modu(slab_lw%lat(axis,:)) + modu(slab_up%lat(axis,:)) + & + 1.5_real32*init_offset(axis) - 2._real32*tmp_vac )/modu(interface%lat(axis,:)) if(ierror.ge.1)then write(0,*) "interface:",intf_loc if(ierror.eq.1.and.iunique.eq.icheck_intf-1)then call chdir(intf_dir) - call err_abort_print_struc(tlw_bas,"lw_term.vasp",& + call err_abort_print_struc(slab_lw,"lw_term.vasp",& "",.false.) - call err_abort_print_struc(tup_bas,"up_term.vasp",& + call err_abort_print_struc(slab_up,"up_term.vasp",& "As IPRINT = 1 and ICHECK has been set, & &code is now exiting...") elseif(ierror.eq.2.and.iunique.eq.icheck_intf-1)then call chdir(intf_dir) - call err_abort_print_struc(sbas,"test_intf.vasp",& + call err_abort_print_struc(interface,"test_intf.vasp",& "As IPRINT = 2 and ICHECK has been set, & &code is now exiting...") end if @@ -1077,14 +1139,14 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- !! Writes information of current match to file in save directory !!----------------------------------------------------------------- - call output_intf_data(SAV, ifit, lw_term, iterm, up_term, jterm,& + call output_intf_data(SAV, ifit, lw_term, iterm_lw, up_term, iterm_up,& lw_use_pricel,up_use_pricel) !!----------------------------------------------------------------- !! Generates shifts and swaps and prints the subsequent structures !!----------------------------------------------------------------- - call gen_shifts_and_swaps(sbas,axis,intf_loc,avg_min_bond,& + call gen_shifts_and_swaps(interface,axis,intf_loc,avg_min_bond,& ishift,nshift,& iswap,swap_den,nswap,t2lw_map) @@ -1350,559 +1412,14 @@ end subroutine gen_shifts_and_swaps !!!############################################################################# -!!!############################################################################# -!!! changes terminations to one long list of the top surfaces of the crystal -!!!############################################################################# - function get_term_list(term) result(list) - implicit none - integer :: i,j,itmp1,nlist,loc - type(term_arr_type), intent(in) :: term - - type(term_list_type) :: tmp_element - type(term_list_type), allocatable, dimension(:) :: list - - - if(.not.allocated(term%arr(1)%ladder))then - nlist=term%nterm - allocate(list(nlist)) - list(:)%loc = term%arr(:)%hmin - do i=1,term%nterm - list(i)%term = i - end do - else - nlist = term%nstep*term%nterm - allocate(list(nlist)) - itmp1=0 - do i=1,term%nterm - do j=1,term%nstep - itmp1=itmp1+1 - list(itmp1)%loc = term%arr(i)%hmin+term%arr(i)%ladder(j) - list(itmp1)%loc = list(itmp1)%loc - & - ceiling( list(itmp1)%loc - 1._real32 ) - list(itmp1)%term=i - end do - end do - end if - - !! sort the list now - do i=1,nlist - loc=minloc(list(i:nlist)%loc,dim=1)+i-1 - tmp_element=list(i) - list(i)=list(loc) - list(loc)=tmp_element - end do - - - - end function get_term_list -!!!############################################################################# - - -!!!############################################################################# -!!! sets the maximum height of the slab -!!!############################################################################# - subroutine set_slab_height(lat, bas, map, term, surf, old_natom,& - height, num_layers, thickness, ncells,& - term_start, term_end, term_step, ludef_surf,& - lwup_in, lcycle) - implicit none - integer :: i,itmp1 - real(real32) :: dtmp1, slab_thickness, largest_sep - character(2) :: lwup - character(5) :: lowerupper - character(1024) :: msg - real(real32), dimension(3,3) :: tfmat - real(real32), allocatable, dimension(:) :: vtmp1 - type(term_list_type), allocatable, dimension(:) :: list - - integer, intent(in) :: num_layers, old_natom - integer, intent(inout) :: term_start, term_end, ncells - integer, intent(out) :: term_step - real(real32), intent(in) :: thickness - real(real32), intent(out) :: height - character(2), intent(in) :: lwup_in - logical, intent(inout) :: ludef_surf - logical, intent(out) :: lcycle - type(basis_type), intent(inout) :: bas - type(term_arr_type), intent(inout) :: term - integer, dimension(2), intent(in) :: surf - real(real32), dimension(3,3), intent(inout) :: lat - - integer, allocatable, dimension(:,:,:), intent(inout) :: map - - integer :: icell, istep, iterm - real(real32) :: layer_thickness - logical :: success - - - !!-------------------------------------------------------------------- - !! Initialise variables - !!-------------------------------------------------------------------- - lwup=to_lower(lwup_in) - if(lwup.eq."lw") lowerupper="LOWER" - if(lwup.eq."up") lowerupper="UPPER" - - lcycle = .false. - height = 0._real32 - - - !!----------------------------------------------------------------------- - !! Defines height of slab from user-defined values - !!----------------------------------------------------------------------- - ludef_surf = .false. - term_start = 1 - term_end = min(term%nterm,nterm) - if(all(surf.ne.0))then - if(any(surf.gt.term%nterm))then - write(msg, '(A2,"_SURFACE VALUES INVALID!\nOne or more value & - &exceeds the maximum number of terminations in the & - structure.\n& - & Supplied values: ",I0,1X,I0,"\n& - & Maximum allowed: ",I0)') lwup, surf, term%nterm - call err_abort(trim(msg),fmtd=.true.) - end if - ludef_surf = .true. - list = get_term_list(term) - !! set term_start to first surface value - term_start = surf(1) - !! set term_end to first surface value as a user-defined surface ... - !! ... should not be cycled over. - !! it is just one, potentially assymetric, slab to be explored. - term_end = surf(1) - - !! determines the maximum number of cells required - allocate(vtmp1(size(list))) - height = term%arr(term_start)%hmin - do i=num_layers,2,-1 - vtmp1 = list(:)%loc - height - vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) - itmp1 = minloc( vtmp1(:), dim=1,& - mask=& - vtmp1(:).gt.0.and.& - list(:)%term.eq.surf(1)) - height = height + vtmp1(itmp1) - end do - vtmp1 = list(:)%loc - height - !vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) - where(vtmp1.lt.-1.D-5) - vtmp1 = vtmp1 - ceiling( vtmp1 + 1.D-5 - 1._real32 ) - end where - itmp1 = minloc( vtmp1(:), dim=1,& - mask=& - vtmp1(:).ge.-1.D-5.and.& - list(:)%term.eq.surf(2)) - height = height + vtmp1(itmp1) - term%arr(term_start)%hmin - - !if(.not.term%lmirror)then - ! get thickness of top/surface layer - dtmp1 = term%arr(surf(2))%hmax - term%arr(surf(2))%hmin - if(dtmp1.lt.-1.D-5) dtmp1 = dtmp1 + 1._real32 - height = height + dtmp1 !(1._real32 - dtmp1) - !end if - - ncells = ceiling(height) - height = height/real(ncells,real32) - end if - - - !!----------------------------------------------------------------------- - !! Define termination iteration counter - !!----------------------------------------------------------------------- - if(term_end.lt.term_start)then - term_step = -1 - else - term_step = 1 - end if - - - !!----------------------------------------------------------------------- - !! Extend slab to user-defined thickness - !!----------------------------------------------------------------------- - if(.not.ludef_surf) ncells = int((num_layers-1)/term%nstep)+1 - !! convert thickness, in angstroms to number of cells - if(thickness.gt.0._real32)then - select case(term%axis) - case(1) - slab_thickness = dot_product(uvec(cross(lat(2,:),lat(3,:))), lat(1,:)) - case(2) - slab_thickness = dot_product(uvec(cross(lat(1,:),lat(3,:))), lat(2,:)) - case(3) - slab_thickness = dot_product(uvec(cross(lat(1,:),lat(2,:))), lat(3,:)) - end select - ! get the largest separation between two terminations - if(ludef_surf)then - - height = 0.E0 - largest_sep = abs( term%arr(surf(1))%hmin - & - term%arr(surf(2))%ladder(term%nstep) - & - term%arr(surf(2))%hmax + 1._real32 ) - if(largest_sep.lt.0._real32) largest_sep = 1._real32 + largest_sep - ! check for all terminations that a certain step is sufficiently large to reproduce thickness - cell_loop1: do icell = 0, ceiling(thickness/slab_thickness), 1 - layer_thickness = term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - 2.E0 * term%tol - success = .false. - step_loop1: do istep = 1, term%nstep, 1 - if(surf(2).lt.surf(1))then - if(istep.eq.term%nstep)then - layer_thickness = & - term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - & - 2.E0 * term%tol + ( & - 1.E0 + term%arr(surf(2))%ladder(1) - & - term%arr(surf(1))%ladder(term%nstep) & - ) - else - layer_thickness = & - term%arr(surf(2))%hmax - term%arr(surf(1))%hmin - & - 2.E0 * term%tol + ( & - term%arr(surf(2))%ladder(istep+1) - & - term%arr(surf(1))%ladder(istep) & - ) - end if - end if - dtmp1 = & - ( & - icell + layer_thickness + & - term%arr(surf(2))%ladder(istep) - & - term%arr(surf(1))%ladder(1) & - ) * slab_thickness - if(dtmp1.ge.thickness)then - success = .true. - height = dtmp1 + 2.E0 * term%tol * slab_thickness - exit step_loop1 - end if - end do step_loop1 - if(.not.success) cycle cell_loop1 - ncells = icell + 1 - exit cell_loop1 - end do cell_loop1 - - else - largest_sep = abs( term%arr(1)%hmin - & - term%arr(1)%ladder(term%nstep) - & - term%arr(1)%hmax + 1._real32 ) - if(largest_sep.lt.0._real32) largest_sep = 1._real32 + largest_sep - ! check for all terminations that a certain step is sufficiently large to reproduce thickness - cell_loop2: do icell = 0, ceiling(thickness/slab_thickness), 1 - term_loop: do iterm = 1, term%nterm, 1 - layer_thickness = term%arr(iterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol - success = .false. - step_loop: do istep = 1, term%nstep, 1 - dtmp1 = ( icell + layer_thickness + term%arr(iterm)%ladder(istep) ) * slab_thickness - if(dtmp1.ge.thickness)then - success = .true. - exit step_loop - end if - end do step_loop - if(.not.success) cycle cell_loop2 - end do term_loop - ncells = icell + 1 - exit cell_loop2 - end do cell_loop2 - - end if - height = height/real(ncells * slab_thickness,real32) - end if - tfmat(:,:) = 0._real32 - tfmat(1,1) = 1._real32 - tfmat(2,2) = 1._real32 - tfmat(3,3) = ncells - call transformer(bas,tfmat,map) - if(mod(real(old_natom*ncells)/real(bas%natom),1.0).gt.1.D-5)then - write(0,'(1X,"ERROR: Internal error in interfaces subroutine")') - write(0,'(2X,"gldfnd subroutine did not reproduce a sensible & - &primitive cell for ",A5," crystal")') lowerupper - write(0,'(2X,"Generated ",I0," atoms, from the original ",& - &I0," atoms")') & - bas%natom/itmp1,old_natom - if(ierror.eq.1)then - call err_abort_print_struc(bas,& - "broken_primitive.vasp",& - "As IPRINT = 1, code is now exiting...") - end if - write(0,'(2X,"Skipping this lattice match...")') - lcycle=.true. - end if - - - !!----------------------------------------------------------------------- - !! Readjust termination plane locations - !! ... i.e. divide all termination values by the number of cells - !!----------------------------------------------------------------------- - term%arr(:)%hmin = term%arr(:)%hmin/real(ncells,real32) - term%arr(:)%hmax = term%arr(:)%hmax/real(ncells,real32) - term%tol = term%tol/real(ncells,real32) - - - end subroutine set_slab_height -!!!############################################################################# - - -!!!############################################################################# -!!! Set the tolerance for layer definitions -!!!############################################################################# - subroutine set_layer_tol(term) - implicit none - integer :: i - real(real32) :: dtmp1 - - type(term_arr_type), intent(inout) :: term - - - do i=1,term%nterm - if(i.eq.1)then - dtmp1 = abs(term%arr(i)%hmin - & - (term%arr(term%nterm)%hmax+term%arr(i)%ladder(term%nstep)-1._real32)& - )/4._real32 - else - dtmp1 = abs(term%arr(i)%hmin-term%arr(i-1)%hmax)/4._real32 - end if - if(dtmp1.lt.term%tol)then - term%tol = dtmp1 - end if - end do - - !! add the tolerances to the edges of the layers - !! this ensures that all atoms in the layers are captured - term%arr(:)%hmin = term%arr(:)%hmin - term%tol - term%arr(:)%hmax = term%arr(:)%hmax + term%tol - - - end subroutine set_layer_tol -!!!############################################################################# - - -!!!############################################################################# -!!! Prepares lattice and basis to specified termination -!!!############################################################################# -!!! Supply a supercell that can be cut down to the size of the slab ... -!!! ... i.e. the input structure must be larger or equal to the desired output - subroutine prepare_slab(lat, bas, map, term, iterm, num_layers, ncells, thickness, & - height, ludef_surf, udef_top_iterm, lwup_in, lcycle, & - ludef_ortho, udef_vacuum) - implicit none - integer :: j, j_start, istep, natom_check - real(real32) :: vacuum, dtmp1, slab_thickness, shift_val - character(2) :: lwup - character(5) :: lowerupper - character(1024) :: msg - logical :: lortho - integer, dimension(3) :: abc=(/1,2,3/) - real(real32), dimension(3) :: surface_normal_vec - real(real32), dimension(3,3) :: tfmat - integer, allocatable, dimension(:) :: iterm_list - - integer, intent(in) :: iterm, udef_top_iterm, num_layers, ncells - real(real32), intent(in) :: height, thickness - character(2), intent(in) :: lwup_in - logical, intent(in) :: ludef_surf - logical, intent(out) :: lcycle - type(basis_type), intent(inout) :: bas - type(term_arr_type), intent(in) :: term - real(real32), dimension(3,3), intent(inout) :: lat - - integer, allocatable, dimension(:,:,:), intent(inout) :: map - logical, optional, intent(in) :: ludef_ortho - real(real32), optional, intent(in) :: udef_vacuum - - integer :: icell, num_cells, jterm - real(real32) :: layer_thickness, ladder_adjust - - !!-------------------------------------------------------------------- - !! Initialise variables - !!-------------------------------------------------------------------- - lwup=to_lower(lwup_in) - if(lwup.eq."lw") lowerupper="LOWER" - if(lwup.eq."up") lowerupper="UPPER" - lcycle = .false. - dtmp1=0._real32 - tfmat=0._real32 - if(ludef_surf)then - jterm = udef_top_iterm - else - jterm = iterm - end if - select case(term%axis) - case(1) - surface_normal_vec = uvec(cross( [ lat(2,:) ], [ lat(3,:) ])) - slab_thickness = abs( dot_product(surface_normal_vec, [ lat(1,:) ]) ) - case(2) - surface_normal_vec = uvec(cross( [ lat(1,:) ], [ lat(3,:) ])) - slab_thickness = abs( dot_product(surface_normal_vec, [ lat(2,:) ]) ) - case(3) - surface_normal_vec = uvec(cross( [ lat(1,:) ], [ lat(2,:)] )) - slab_thickness = abs( dot_product(surface_normal_vec, [ lat(3,:) ]) ) - end select - if(thickness.gt.0._real32)then - dtmp1 = slab_thickness / ncells * ( ncells - 1 ) - istep = term%nstep - num_cells = ncells - 1 - cell_loop: do icell = 0, ncells, 1 - layer_thickness = term%arr(jterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol - ladder_adjust = 0._real32 - step_loop: do j = 1, term%nstep - if(jterm.lt.iterm)then - if(j.eq.term%nstep)then - layer_thickness = term%arr(jterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol - ladder_adjust = 1.E0 + term%arr(jterm)%ladder(1) - term%arr(iterm)%ladder(term%nstep) - else - layer_thickness = term%arr(jterm)%hmax - term%arr(iterm)%hmin - 2.E0 * term%tol - ladder_adjust = term%arr(jterm)%ladder(j+1) - term%arr(iterm)%ladder(j) - end if - end if - dtmp1 = ( icell / real(ncells,real32) + layer_thickness ) * slab_thickness + & - ( ladder_adjust + term%arr(jterm)%ladder(j) - term%arr(iterm)%ladder(1) ) * slab_thickness / real(ncells,real32) - if(dtmp1.ge.thickness)then - istep = j - num_cells = icell - exit cell_loop - end if - end do step_loop - end do cell_loop - else - istep = num_layers - (ncells-1)*term%nstep - num_cells = ncells - 1 - end if - natom_check = bas%natom - - if(present(ludef_ortho))then - lortho = ludef_ortho - else - lortho = .true. - end if - - if(present(udef_vacuum))then - vacuum = udef_vacuum - else - vacuum = tmp_vac - end if - - - !!-------------------------------------------------------------------- - !! Set up list for checking expected number of atoms - !!-------------------------------------------------------------------- - allocate(iterm_list(term%nterm)) - do j=1,term%nterm - iterm_list(j) = j - end do - iterm_list=cshift(iterm_list,iterm-1) - if(ludef_surf)then - j_start = jterm - iterm + 1 - if(j_start.le.0) j_start = j_start + term%nterm - j_start = j_start + 1 !+ (istep-1)*term%nterm/term%nstep - else - !! handle ladder steps that are equivalent - j_start = 2 !+ (istep-1)*term%nterm/term%nstep - end if - - - !!-------------------------------------------------------------------- - !! Shift lower material to specified termination - !!-------------------------------------------------------------------- - call shifter(bas,term%axis,-term%arr(iterm)%hmin,.true.) - - - !!-------------------------------------------------------------------- - !! Determine cell reduction to specified termination - !!-------------------------------------------------------------------- - !write(0,*) "LUDEF_SURF?", ludef_surf - do j=1,3 - tfmat(j,j)=1._real32 - if(j.eq.term%axis)then - if(ludef_surf)then - tfmat(j,j) = height - else!if(term%lmirror)then - if(istep.ne.0)then - dtmp1 = num_cells + term%arr(iterm)%ladder(istep) - dtmp1 = dtmp1/(ncells) - tfmat(j,j) = dtmp1 - tfmat(j,j) = tfmat(j,j) + & - (term%arr(iterm)%hmax - term%arr(iterm)%hmin) - end if - !else - ! tfmat(j,j) = tfmat(j,j) + (& - ! term%arr(iterm)%hmax - & - ! term%arr(iterm)%hmin) + term%tol*2._real32 - end if - end if - end do - - - !!-------------------------------------------------------------------- - !! Check number of atoms is expected - !!-------------------------------------------------------------------- - if(num_cells.ne.ncells-1)then - do icell = num_cells + 2, ncells, 1 - natom_check = natom_check - nint( bas%natom / real(ncells) ) - end do - end if - - - !!-------------------------------------------------------------------- - !! Apply transformation and shift cell back to bottom of layer - !! ... i.e. account for the tolerance that has been added to layer ... - !! ... hmin and hmax - !!-------------------------------------------------------------------- - shift_val = term%tol * slab_thickness / modu(lat(term%axis,:)) - call transformer(bas,tfmat,map) - call shifter(bas,term%axis,-shift_val/tfmat(term%axis,term%axis),.true.) - - - !!-------------------------------------------------------------------- - !! Check number of atoms is expected - !!-------------------------------------------------------------------- - if(term%nterm.gt.1.or.term%nstep.gt.1)then - do j = 1, max(0,term%nstep-istep), 1 - natom_check = natom_check - sum(term%arr(:)%natom) - end do - do j = j_start, term%nterm, 1 - natom_check = natom_check - term%arr(iterm_list(j))%natom - end do - end if - if(bas%natom.ne.natom_check)then - write(msg, '("NUMBER OF ATOMS IN '//to_upper(lowerupper)//' SLAB! & - &Expected ",I0," but generated ",I0," instead")') & - natom_check,bas%natom - if(tfmat(term%axis,term%axis).gt.1._real32)then - write(0,'("THE TRANSFORMATION IS GREATER THAN ONE ",F0.9)') & - tfmat(term%axis,term%axis) - end if - !call err_abort(trim(msg),fmtd=.true.) - call err_abort_print_struc(bas,lwup//"_term.vasp",& - trim(msg),.true.) - lcycle = .true. - end if - - - !!-------------------------------------------------------------------- - !! Apply slab_cuber to orthogonalise lower material - !!-------------------------------------------------------------------- - call normalise_basis(bas,dtmp=0._real32,lfloor=.true.,zero_round=0._real32) - call set_vacuum(bas,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum) - !call err_abort_print_struc(bas,"check.vasp","stop") - abc=cshift(abc,3-term%axis) - if(lortho)then - ortho_check: do j=1,2 - if(abs(dot_product(lat(abc(j),:),lat(axis,:))).gt.1.D-5)then - call ortho_axis(lat,bas,term%axis) - exit ortho_check - end if - end do ortho_check - end if - call bas%normalise(ceil_val=0.9999_real32,floor_coords=.true.,zero_round=0._real32) - - - end subroutine prepare_slab -!!!############################################################################# - - !!!############################################################################# !!! write structure data in each structure directory !!!############################################################################# - subroutine output_intf_data(SAV, ifit, lw_term, ilw_term, up_term, iup_term, lw_pricel,up_pricel) + subroutine output_intf_data(SAV, ifit, lw_term, term_lw_idx, up_term, term_up_idx, lw_pricel,up_pricel) implicit none integer :: unit - integer, intent(in) :: ifit, ilw_term, iup_term + integer, intent(in) :: ifit, term_lw_idx, term_up_idx logical, intent(in) :: lw_pricel,up_pricel type(term_arr_type), intent(in) :: lw_term, up_term type(latmatch_type), intent(in) :: SAV @@ -1928,13 +1445,13 @@ subroutine output_intf_data(SAV, ifit, lw_term, ilw_term, up_term, iup_term, lw_ write(unit,'(" Lower termination")') write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - ilw_term,lw_term%arr(ilw_term)%hmin,lw_term%arr(ilw_term)%hmax,lw_term%arr(ilw_term)%natom + term_lw_idx,lw_term%arr(term_lw_idx)%hmin,lw_term%arr(term_lw_idx)%hmax,lw_term%arr(term_lw_idx)%natom write(unit,*) write(unit,'(" Upper crystal Miller plane: ",3(I3," "))') SAV%tf2(ifit,3,1:3) write(unit,'(" Upper termination")') write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - iup_term,up_term%arr(iup_term)%hmin,up_term%arr(iup_term)%hmax,up_term%arr(iup_term)%natom + term_up_idx,up_term%arr(term_up_idx)%hmin,up_term%arr(term_up_idx)%hmax,up_term%arr(term_up_idx)%natom write(unit,*) close(unit) diff --git a/src/fortran/mod_lat_compare.f90 b/src/fortran/mod_lat_compare.f90 index bcdc6c2..4b76267 100644 --- a/src/fortran/mod_lat_compare.f90 +++ b/src/fortran/mod_lat_compare.f90 @@ -945,7 +945,7 @@ end function vec_comp !!! Program to match lattices of two position cards. !!!############################################################################# subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) - use mod_sym + use artemis__sym use plane_matching implicit none diff --git a/src/fortran/mod_shifting.f90 b/src/fortran/mod_shifting.f90 index 396707a..2c1c00c 100644 --- a/src/fortran/mod_shifting.f90 +++ b/src/fortran/mod_shifting.f90 @@ -742,7 +742,7 @@ end function get_descriptive_ab_shifts !!!############################################################################# function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& bulk_DON,bulk_map,lprint,max_bondlength) result(res_shifts) - use mod_sym, only: gldfnd,confine_type + use artemis__sym, only: gldfnd,confine_type use edit_geom, only: get_bulk,wyck_spec_type,get_wyckoff use interface_identifier, only: gen_single_DON,nstep_default,den_of_neigh_type implicit none diff --git a/src/fortran/mod_swapping.f90 b/src/fortran/mod_swapping.f90 index 1d6a639..28d34e8 100644 --- a/src/fortran/mod_swapping.f90 +++ b/src/fortran/mod_swapping.f90 @@ -9,7 +9,7 @@ module swapping use misc_maths, only: gauss use misc_linalg, only: modu use artemis__geom_rw, only: basis_type - use mod_sym, only: sym_setup,check_sym,sym_type,basmap_type,basis_map + use artemis__sym, only: sym_setup,check_sym,sym_type,basmap_type,basis_map use artemis__io_utils, only: err_abort implicit none real(real32) :: tiny=5.0D-5 From 2fdd06b9ccf56a6f442c71734851dc3680ce4b7d Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 16:58:58 +0100 Subject: [PATCH 031/137] Fix logical statements --- src/fortran/lib/mod_terminations.f90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index aff5b98..76bd1bc 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -934,7 +934,7 @@ subroutine build_slab( & iterm_list(j) = j end do iterm_list = cshift( iterm_list, term_btm_idx - 1 ) - if(equivalent_surfaces)then + if(.not.equivalent_surfaces)then j_start = term_top_idx - term_btm_idx + 1 if(j_start.le.0) j_start = j_start + term%nterm j_start = j_start + 1 !+ (istep-1)*term%nterm/term%nstep @@ -956,14 +956,13 @@ subroutine build_slab( & do j = 1, 3 tfmat(j,j) = 1._real32 if(j.eq.term%axis)then - if(equivalent_surfaces)then + if(.not.equivalent_surfaces)then tfmat(j,j) = height else!if(term%lmirror)then if(istep.ne.0)then rtmp1 = num_cells + term%arr(term_btm_idx)%ladder(istep) - rtmp1 = rtmp1/(ncells) - tfmat(j,j) = rtmp1 - tfmat(j,j) = tfmat(j,j) + & + rtmp1 = rtmp1/real(ncells, real32) + tfmat(j,j) = rtmp1 + & (term%arr(term_btm_idx)%hmax - term%arr(term_btm_idx)%hmin) end if !else @@ -1014,7 +1013,6 @@ subroutine build_slab( & write(0,'("THE TRANSFORMATION IS GREATER THAN ONE ",F0.9)') & tfmat(term%axis,term%axis) end if - !call err_abort(trim(msg),fmtd=.true.) call err_abort_print_struc(basis,lwup//"_term.vasp",& trim(msg),.true.) lcycle = .true. From fe3f173362c6e3c4d8650349691d9dd65543f69d Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 17:05:57 +0100 Subject: [PATCH 032/137] Remove files --- .../DTERMINATIONS/POSCAR_term1 | 17 ----------------- .../DTERMINATIONS/POSCAR_term1 | 17 ----------------- .../DTERMINATIONS/lw_term.vasp | 5 ----- 3 files changed, 39 deletions(-) delete mode 100644 test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 delete mode 100644 test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 delete mode 100644 test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp diff --git a/test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 b/test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 deleted file mode 100644 index 42b829c..0000000 --- a/test/cell_edits_identify_terminations_TMDC-H/DTERMINATIONS/POSCAR_term1 +++ /dev/null @@ -1,17 +0,0 @@ -Mo2 S4 - 1.000000000 - 3.190316000 0.000000000 0.000000000 - -1.595158000 2.762894000 0.000000000 - 0.000000000 0.000000000 32.008772733 -Mo S -3 6 -Direct - 0.333333000 0.666667000 0.048889234 - 0.333333000 0.666667000 0.513730673 - 0.666667000 0.333333000 0.281309953 - 0.666667000 0.333333000 0.097778467 - 0.666667000 0.333333000 0.562619907 - 0.333333000 0.666667000 0.330199187 - 0.666667000 0.333333000 0.000000000 - 0.666667000 0.333333000 0.464841440 - 0.333333000 0.666667000 0.232420720 diff --git a/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 b/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 deleted file mode 100644 index 5482f34..0000000 --- a/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/POSCAR_term1 +++ /dev/null @@ -1,17 +0,0 @@ -Hf1 S2 - 1.000000000 - 3.643366000 0.000000000 0.000000000 - -1.821683000 3.155247000 0.000000000 - 0.000000000 0.000000000 30.058821447 -Hf S -3 6 -Direct - 0.000000000 0.000000000 0.486175706 - 0.000000000 0.000000000 0.048070838 - 0.000000000 0.000000000 0.267123272 - 0.666667000 0.333333000 0.000000000 - 0.666667000 0.333333000 0.219052434 - 0.666667000 0.333333000 0.438104868 - 0.333333000 0.666667000 0.534246543 - 0.333333000 0.666667000 0.096141675 - 0.333333000 0.666667000 0.315194109 diff --git a/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp b/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp deleted file mode 100644 index 1c7e7f0..0000000 --- a/test/cell_edits_identify_terminations_TMDC-T/DTERMINATIONS/lw_term.vasp +++ /dev/null @@ -1,5 +0,0 @@ -Hf1 S2 - 1.000000000 - 3.643366000 0.000000000 0.000000000 - -1.821683000 3.155247000 0.000000000 - 0.000000000 0.000000000*************** From e6d32549230f5edd7b53cd817d42ab0c6ac1b984 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 17:06:10 +0100 Subject: [PATCH 033/137] Fix commenting --- src/fortran/lib/mod_terminations.f90 | 1 - src/fortran/mod_generator.f90 | 12 ++++-------- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 76bd1bc..9216c3c 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -1023,7 +1023,6 @@ subroutine build_slab( & !! Apply slab_cuber to orthogonalise lower material !!-------------------------------------------------------------------- call set_vacuum(basis,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum_) - !call err_abort_print_struc(basis,"check.vasp","stop") abc=cshift(abc,3-term%axis) if(orthogonalise_)then ortho_check: do j=1,2 diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 0449484..a4a8ca8 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -381,9 +381,7 @@ end subroutine write_structures !############################################################################### -!!!############################################################################# -!!! generate interfaces -!!!############################################################################# +!############################################################################### subroutine generate_intefaces_from_existing(this, basis) !! Generate interfaces for the given basis implicit none @@ -466,12 +464,10 @@ subroutine generate_intefaces_from_existing(this, basis) end subroutine generate_intefaces_from_existing -!!!############################################################################# +!############################################################################### -!!!############################################################################# -!!! generate interfaces -!!!############################################################################# +!############################################################################### subroutine generate_interfaces(this, basis_lw, basis_up) !! Generate interfaces from two bulk structures implicit none @@ -1170,7 +1166,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) return end subroutine generate_interfaces -!!!############################################################################# +!############################################################################### !!!############################################################################# From 7ff5995b2ff9cf86e0f88c39678c0f38848cbf48 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 17:13:14 +0100 Subject: [PATCH 034/137] Update procedures --- src/fortran/lib/mod_sym.f90 | 56 +++++++++++++++++------------------ src/fortran/mod_generator.f90 | 4 +-- 2 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index eb3c651..2968978 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -1007,8 +1007,10 @@ end subroutine clone_grp !!!############################################################################# !!! returns the primitive cell from a supercell !!!############################################################################# - subroutine get_primitive_cell(lat,bas) + subroutine get_primitive_cell(basis) implicit none + type(basis_type), intent(inout) :: basis + integer :: is,ia,ja,i,j,k,itmp1 integer :: ntrans,len real(real32) :: scale,proj,dtmp1 @@ -1016,8 +1018,6 @@ subroutine get_primitive_cell(lat,bas) real(real32), dimension(3,3) :: dmat1,invlat real(real32), allocatable, dimension(:,:) :: trans,atom_store - type(basis_type) :: bas - real(real32), dimension(3,3) :: lat !!----------------------------------------------------------------------- @@ -1025,14 +1025,14 @@ subroutine get_primitive_cell(lat,bas) !!----------------------------------------------------------------------- ntrans = 0 dmat1=0._real32 - allocate(trans(minval(bas%spec(:)%num+2),3)); trans=0._real32 + allocate(trans(minval(basis%spec(:)%num+2),3)); trans=0._real32 !!----------------------------------------------------------------------- !! Find the translation vectors in the cell !!----------------------------------------------------------------------- - call gldfnd(confine,bas,bas,trans,ntrans,.false.) - len=size(bas%spec(1)%atom,dim=2) + call gldfnd(confine,basis,basis,trans,ntrans,.false.) + len=size(basis%spec(1)%atom,dim=2) !!----------------------------------------------------------------------- @@ -1043,7 +1043,7 @@ subroutine get_primitive_cell(lat,bas) trans(i,:)=0._real32 trans(i,i-ntrans)=1._real32 end do - ! trans=matmul(trans(1:ntrans,1:3),lat) + ! trans=matmul(trans(1:ntrans,1:3),basis%lat) call sort2D(trans(1:ntrans+3,:),ntrans+3) !! for each lattice vector, determine the shortest translation ... !! ... vector that has a non-zero projection along that lattice vector. @@ -1067,34 +1067,34 @@ subroutine get_primitive_cell(lat,bas) end do !dmat1=trans(1:3,1:3) scale=det(dmat1) - dmat1=matmul(dmat1,lat) + dmat1=matmul(dmat1,basis%lat) invlat=inverse_3x3(dmat1) - do is=1,bas%nspec + do is=1,basis%nspec itmp1=0 - allocate(atom_store(nint(scale*bas%spec(is)%num),len)) - atcheck: do ia=1,bas%spec(is)%num + allocate(atom_store(nint(scale*basis%spec(is)%num),len)) + atcheck: do ia=1,basis%spec(is)%num !!----------------------------------------------------------------- !! Reduce the basis !!----------------------------------------------------------------- - bas%spec(is)%atom(ia,1:3)=& - matmul(bas%spec(is)%atom(ia,1:3),lat(1:3,1:3)) - bas%spec(is)%atom(ia,1:3)=& - matmul(transpose(invlat(1:3,1:3)),bas%spec(is)%atom(ia,1:3)) + basis%spec(is)%atom(ia,1:3)=& + matmul(basis%spec(is)%atom(ia,1:3),basis%lat(1:3,1:3)) + basis%spec(is)%atom(ia,1:3)=& + matmul(transpose(invlat(1:3,1:3)),basis%spec(is)%atom(ia,1:3)) do j=1,3 - bas%spec(is)%atom(ia,j)=& - bas%spec(is)%atom(ia,j)-floor(bas%spec(is)%atom(ia,j)) - if(bas%spec(is)%atom(ia,j).gt.1._real32-tol_sym) & - bas%spec(is)%atom(ia,j)=0._real32 + basis%spec(is)%atom(ia,j)=& + basis%spec(is)%atom(ia,j)-floor(basis%spec(is)%atom(ia,j)) + if(basis%spec(is)%atom(ia,j).gt.1._real32-tol_sym) & + basis%spec(is)%atom(ia,j)=0._real32 end do !!----------------------------------------------------------------- !! Check for duplicates in the cell !!----------------------------------------------------------------- do ja=1, itmp1 - if(all(abs(bas%spec(is)%atom(ia,1:3)-atom_store(ja,1:3)).lt.& + if(all(abs(basis%spec(is)%atom(ia,1:3)-atom_store(ja,1:3)).lt.& (/tol_sym,tol_sym,tol_sym/))) cycle atcheck end do itmp1=itmp1+1 - atom_store(itmp1,:)=bas%spec(is)%atom(ia,:) + atom_store(itmp1,:)=basis%spec(is)%atom(ia,:) !!----------------------------------------------------------------- !! Check to ensure correct number of atoms remain after reduction !!----------------------------------------------------------------- @@ -1105,26 +1105,26 @@ subroutine get_primitive_cell(lat,bas) end if !!----------------------------------------------------------------- end do atcheck - deallocate(bas%spec(is)%atom) - call move_alloc(atom_store,bas%spec(is)%atom) - bas%spec(is)%num=size(bas%spec(is)%atom,dim=1) + deallocate(basis%spec(is)%atom) + call move_alloc(atom_store,basis%spec(is)%atom) + basis%spec(is)%num=size(basis%spec(is)%atom,dim=1) !deallocate(atom_store) end do !!----------------------------------------------------------------------- !! Reduce the lattice !!----------------------------------------------------------------------- - bas%natom=sum(bas%spec(:)%num) - lat=dmat1 + basis%natom=sum(basis%spec(:)%num) + basis%lat=dmat1 end if !!----------------------------------------------------------------------- !! Reduce the lattice to symmetry definition !!----------------------------------------------------------------------- - call reducer(bas) + call reducer(basis) !! next line necessary as FCC and BCC do not conform to Niggli reduced ... !! ... cell definitions. - lat = primitive_lat(lat) + basis%lat = primitive_lat(basis%lat) diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index a4a8ca8..4afafcf 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -539,7 +539,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) write(6,*) if(lw_use_pricel)then write(6,'(1X,"Using primitive cell for lower material")') - call get_primitive_cell(basis_lw_%lat,basis_lw_) + call get_primitive_cell(basis_lw_) else write(6,'(1X,"Using supplied cell for lower material")') call reducer(basis_lw_) @@ -547,7 +547,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) end if if(up_use_pricel)then write(6,'(1X,"Using primitive cell for upper material")') - call get_primitive_cell(basis_up_%lat,basis_up_) + call get_primitive_cell(basis_up_) else write(6,'(1X,"Using supplied cell for upper material")') call reducer(basis_up_) From fccb8d9a66229696f6279e35a23e9e8c8dcaf79b Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 16 Apr 2025 17:26:23 +0100 Subject: [PATCH 035/137] Improve tolerance handling --- app/main.f90 | 3 +++ src/fortran/lib/mod_misc_linalg.f90 | 4 ++-- src/fortran/lib/mod_misc_types.f90 | 4 +++- src/fortran/mod_generator.f90 | 5 +++++ 4 files changed, 13 insertions(+), 3 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 7c4c8e9..740107e 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -90,6 +90,9 @@ program artemis_executable !! interface generator !!------------------------------------------------------------------------- if(irestart.eq.0)then + call intf_gen%set_tolerance( & + tolerance = tolerance & + ) call intf_gen%generate(struc1_bas, struc2_bas) else call intf_gen%restart(struc1_bas) diff --git a/src/fortran/lib/mod_misc_linalg.f90 b/src/fortran/lib/mod_misc_linalg.f90 index 889952d..be8b740 100644 --- a/src/fortran/lib/mod_misc_linalg.f90 +++ b/src/fortran/lib/mod_misc_linalg.f90 @@ -411,9 +411,9 @@ pure function inverse(mat) real(real32), dimension(:,:), intent(in) :: mat real(real32), dimension(size(mat(:,1),dim=1),size(mat(1,:),dim=1)) :: inverse - if(size(mat(1,:),dim=1).eq.2)then + if(size(mat,dim=2).eq.2)then inverse = inverse_2x2(mat) - elseif(size(mat(1,:),dim=1).eq.3)then + elseif(size(mat,dim=2).eq.3)then inverse = inverse_3x3(mat) end if diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index fab5f04..6d4b9c4 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -25,7 +25,9 @@ module artemis__misc_types integer :: maxsize,maxfit,nstore real(real32) :: maxlen=20._real32 real(real32) :: maxarea=400._real32 - real(real32) :: vec,ang,area + real(real32) :: vec = 5._real32 + real(real32) :: ang = 1._real32 + real(real32) :: area = 10._real32 real(real32) :: ang_weight = 10._real32 real(real32) :: area_weight = 100._real32 end type tol_type diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 4afafcf..1791416 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -79,6 +79,7 @@ module artemis__generator !############################################################################### subroutine set_tolerance( & this, & + tolerance, & vector_mismatch, angle_mismatch, area_mismatch, & max_length, max_area, max_fit, max_extension, & angle_weight, area_weight & @@ -89,6 +90,8 @@ subroutine set_tolerance( & ! Arguments class(artemis_interface_generator_type), intent(inout) :: this !! Instance of artemis generator type + type(tol_type), intent(in), optional :: tolerance + !! Tolerance structure real(real32), intent(in), optional :: vector_mismatch !! Tolerance for the vector mismatch real(real32), intent(in), optional :: angle_mismatch @@ -108,6 +111,8 @@ subroutine set_tolerance( & real(real32), intent(in), optional :: area_weight !! Importance weighting of area mismatch + if(present(tolerance)) this%tolerance = tolerance + if(present(vector_mismatch)) then this%tolerance%vec = vector_mismatch else From 7ae5c45337533d3b652b97a3732dd7bdcd45b89f Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 06:13:52 +0100 Subject: [PATCH 036/137] Uniform floating point precision --- src/fortran/inputs.f90 | 2 +- src/fortran/lib/mod_misc.f90 | 4 +- src/fortran/lib/mod_misc_maths.f90 | 38 ++++---- src/fortran/lib/mod_terminations.f90 | 10 +-- src/fortran/mod_generator.f90 | 6 +- src/fortran/mod_intf_identifier.f90 | 126 +++++++++++++-------------- src/fortran/mod_lat_compare.f90 | 4 +- src/fortran/mod_plane_matching.f90 | 6 +- src/fortran/mod_shifting.f90 | 36 ++++---- src/fortran/mod_swapping.f90 | 50 +++++------ 10 files changed, 141 insertions(+), 141 deletions(-) diff --git a/src/fortran/inputs.f90 b/src/fortran/inputs.f90 index c094b84..5aac529 100644 --- a/src/fortran/inputs.f90 +++ b/src/fortran/inputs.f90 @@ -26,7 +26,7 @@ module inputs integer :: irestart,idepth,imatch,ishift,iswap integer :: lw_num_layers,up_num_layers integer :: nshift,nterm,nintf,nswap,nmiller - real :: max_bondlength,swap_sigma,swap_depth + real(real32) :: max_bondlength,swap_sigma,swap_depth real(real32) :: lw_thickness, up_thickness real(real32) :: lw_bulk_modulus, up_bulk_modulus real(real32) :: c_scale,intf_depth,vacuum diff --git a/src/fortran/lib/mod_misc.f90 b/src/fortran/lib/mod_misc.f90 index 99e4f4f..c595122 100644 --- a/src/fortran/lib/mod_misc.f90 +++ b/src/fortran/lib/mod_misc.f90 @@ -136,7 +136,7 @@ subroutine sort2D(arr,dim) istart=1 do j=1,3 do i=j,dim - loc=minloc(abs(arr(i:dim,a123(1))),dim=1,mask=(abs(arr(i:dim,a123(1))).gt.1.D-5))+i-1 + loc=minloc(abs(arr(i:dim,a123(1))),dim=1,mask=(abs(arr(i:dim,a123(1))).gt.1.E-5_real32))+i-1 buff(:)=arr(i,:) arr(i,:)=arr(loc,:) arr(loc,:)=buff(:) @@ -395,7 +395,7 @@ end subroutine flagmaker subroutine loadbar(count,div,loaded) implicit none integer :: count,div !div=10 - real :: tiny=1.E-5 + real(real32) :: tiny=1.E-5 character(1) :: yn,creturn = achar(13) character(1), optional :: loaded diff --git a/src/fortran/lib/mod_misc_maths.f90 b/src/fortran/lib/mod_misc_maths.f90 index 7f7ef58..6ddd103 100644 --- a/src/fortran/lib/mod_misc_maths.f90 +++ b/src/fortran/lib/mod_misc_maths.f90 @@ -45,8 +45,8 @@ module misc_maths function times(in_array) implicit none integer :: i - real :: times - real, dimension(:),intent(in) :: in_array + real(real32) :: times + real(real32), dimension(:),intent(in) :: in_array times=1.0 do i=1,size(in_array) @@ -144,8 +144,8 @@ function overlap_indiv_points(f,g) result(overlap) implicit none integer :: n integer :: datsize_f, datsize_g - real, dimension(:) :: f, g - real, dimension(:), allocatable :: overlap, y + real(real32), dimension(:) :: f, g + real(real32), dimension(:), allocatable :: overlap, y datsize_f = size(f) datsize_g = size(g) @@ -172,9 +172,9 @@ function overlap(f,g) implicit none integer :: n integer :: datsize_f, datsize_g - real :: overlap - real, dimension(:) :: f, g - real, dimension(:), allocatable :: y + real(real32) :: overlap + real(real32), dimension(:) :: f, g + real(real32), dimension(:), allocatable :: y datsize_f = size(f) datsize_g = size(g) @@ -200,8 +200,8 @@ function convolve(f,g) !f is the signal array !g is the noise/impulse array - real, dimension(:), allocatable :: convolve, y - real, dimension(:) :: f, g + real(real32), dimension(:), allocatable :: convolve, y + real(real32), dimension(:) :: f, g integer :: datsize_f, datsize_g integer :: i,j,k @@ -247,8 +247,8 @@ function cross_correl(f,g) !f is the signal array !g is the noise/impulse array - real, dimension(:), allocatable :: cross_correl, y - real, dimension(:) :: f, g + real(real32), dimension(:), allocatable :: cross_correl, y + real(real32), dimension(:) :: f, g integer :: datsize_f, datsize_g integer :: m,n @@ -329,8 +329,8 @@ end function running_avg !!!##################################################### function mean(in_array) implicit none - real :: mean - real, dimension(:), intent(in) :: in_array + real(real32) :: mean + real(real32), dimension(:), intent(in) :: in_array mean=sum(in_array)/size(in_array) @@ -344,9 +344,9 @@ end function mean function median(in_array) implicit none integer :: i,loc - real :: median,oddeven,rtmp1 - real, allocatable, dimension(:) :: cp_array - real, dimension(:), intent(in) :: in_array + real(real32) :: median,oddeven,rtmp1 + real(real32), allocatable, dimension(:) :: cp_array + real(real32), dimension(:), intent(in) :: in_array allocate(cp_array(size(in_array))) cp_array=in_array @@ -375,8 +375,8 @@ end function median function mode(in_array) implicit none integer :: i,itmp1,maxcount - real :: mode - real, dimension(:), intent(in) :: in_array + real(real32) :: mode + real(real32), dimension(:), intent(in) :: in_array maxcount=0 do i=1,size(in_array) @@ -463,7 +463,7 @@ function get_turn_points(invec,lperiodic,window) result(resvec) l_grad=r_grad r_grad=invec(i+1)-invec(i) if(sign(1._real32,l_grad).ne.sign(1._real32,r_grad).or.& - (r_grad.eq.0._real32.and.abs(l_grad-r_grad).gt.1.D-5))then + (r_grad.eq.0._real32.and.abs(l_grad-r_grad).gt.1.E-5_real32))then nturn=nturn+1 tvec1(nturn)=i end if diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 9216c3c..878b365 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -666,19 +666,19 @@ subroutine set_slab_height( basis, map, term, surf,& end do vtmp1 = list(:)%loc - height !vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) - where(vtmp1.lt.-1.D-5) - vtmp1 = vtmp1 - ceiling( vtmp1 + 1.D-5 - 1._real32 ) + where(vtmp1.lt.-1.E-5_real32) + vtmp1 = vtmp1 - ceiling( vtmp1 + 1.E-5_real32 - 1._real32 ) end where itmp1 = minloc( vtmp1(:), dim=1,& mask=& - vtmp1(:).ge.-1.D-5.and.& + vtmp1(:).ge.-1.E-5_real32.and.& list(:)%term.eq.surf(2)) height = height + vtmp1(itmp1) - term%arr(term_start)%hmin !if(.not.term%lmirror)then ! get thickness of top/surface layer rtmp1 = term%arr(surf(2))%hmax - term%arr(surf(2))%hmin - if(rtmp1.lt.-1.D-5) rtmp1 = rtmp1 + 1._real32 + if(rtmp1.lt.-1.E-5_real32) rtmp1 = rtmp1 + 1._real32 height = height + rtmp1 !(1._real32 - rtmp1) !end if @@ -1026,7 +1026,7 @@ subroutine build_slab( & abc=cshift(abc,3-term%axis) if(orthogonalise_)then ortho_check: do j=1,2 - if(abs(dot_product(basis%lat(abc(j),:),basis%lat(term%axis,:))).gt.1.D-5)then + if(abs(dot_product(basis%lat(abc(j),:),basis%lat(term%axis,:))).gt.1.E-5_real32)then call ortho_axis(basis%lat,basis,term%axis) exit ortho_check end if diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 1791416..97a217b 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -255,7 +255,7 @@ subroutine generate_terminations( & mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(tmp_bas1%lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if - if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 + if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 call transformer(tmp_bas1,tfmat,bas_map) if(.not.compare_stoichiometry(tmp_bas1,basis))then write(0,'(1X,"ERROR: Internal error in generate_terminations")') @@ -873,7 +873,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(supercell_lw%lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if - if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 + if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 call transformer(supercell_lw,tfmat,t1lw_map) if(.not.compare_stoichiometry(basis_lw_,supercell_lw))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') @@ -953,7 +953,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(supercell_lw%lat(axis,:))) tfmat(3,:)=trans(itmp1,:) end if - if(all(abs(tfmat(3,:)).lt.1.D-5)) tfmat(3,3) = 1._real32 + if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 call transformer(supercell_up,tfmat,t1up_map) ! check the stoichiometry ratios are still maintained if(.not.compare_stoichiometry(basis_up_,supercell_up))then diff --git a/src/fortran/mod_intf_identifier.f90 b/src/fortran/mod_intf_identifier.f90 index 6621ff2..05c5719 100644 --- a/src/fortran/mod_intf_identifier.f90 +++ b/src/fortran/mod_intf_identifier.f90 @@ -47,7 +47,7 @@ module interface_identifier function get_interface(lat,bas,axis) result(intf) implicit none integer :: nstep - real :: dist_max + real(real32) :: dist_max type(basis_type) :: bas type(intf_info_type) :: intf real(real32), dimension(3,3) :: lat @@ -82,21 +82,21 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) implicit none integer :: i,j,k,is,ia,js,ja,count1 integer :: nstep,nsize - real :: rdist_max,rtmp1,rtmp2 + real(real32) :: rdist_max,rtmp1,rtmp2 logical :: lscale_dist,lnorm - real :: gauss_tol,DON_sigma,dist + real(real32) :: gauss_tol,DON_sigma,dist integer, dimension(3) :: ncell - real, dimension(3) :: vrtmp1,vrtmp2 - real, dimension(3) :: vtmp1,vtmp2,vtmp3 - real, allocatable, dimension(:) :: distance + real(real32), dimension(3) :: vrtmp1,vrtmp2 + real(real32), dimension(3) :: vtmp1,vtmp2,vtmp3 + real(real32), allocatable, dimension(:) :: distance type(den_of_spec_type), allocatable, dimension(:) :: DOS - real, optional, intent(in) :: dist_max + real(real32), optional, intent(in) :: dist_max logical, optional, intent(in) :: scale_dist,norm type(basis_type), intent(in) :: bas real(real32), dimension(3,3), intent(in) :: lat - real, allocatable, dimension(:) :: dist_list + real(real32), allocatable, dimension(:) :: dist_list if(present(scale_dist))then @@ -120,7 +120,7 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) rdist_max=12._real32 if(present(dist_max)) rdist_max=dist_max do i=1,nstep - distance(i)=real(i)*rdist_max/real(nstep) + distance(i)=real(i,real32)*rdist_max/real(nstep,real32) end do !! should now consider lattice vector addition for obtuse cells. @@ -155,27 +155,27 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) ncell = 0 ncell_loop1: do i=1,3 - rtmp1 = real(modu(lat(i,:))) + rtmp1 = modu(lat(i,:)) ncell(i) = max(ncell(i),ceiling(rdist_max/modu(lat(i,:))))!maxval(ceiling( rdist_max/abs(lat(i,:)) )) do j=1,3 if(i.eq.j) cycle - rtmp2 = real(dot_product(lat(i,:),lat(j,:))) - if(sign(1.0,rtmp1).eq.sign(1.0,rtmp2)) cycle + rtmp2 = dot_product(lat(i,:),lat(j,:)) + if(sign(1._real32,rtmp1).eq.sign(1._real32,rtmp2)) cycle !vrtmp1 = uvec(lat(i,:)) * dot_product(uvec(lat(i,:)),lat(j,:)) !vrtmp1 = uvec(lat(i,:)) * lat(j,:) - vrtmp1 = merge(real(lat(j,:)), (/0.E0, 0.E0, 0.E0/), mask = abs(lat(i,:))>1.D-5) + vrtmp1 = merge(lat(j,:), (/0._real32, 0._real32, 0._real32/), mask = abs(lat(i,:)).gt.1.E-5_real32) rtmp1 = modu(vrtmp1) - if(abs(rtmp1).lt.1.D-5) cycle + if(abs(rtmp1).lt.1.E-5_real32) cycle k = 0 - vrtmp2 = real(lat(i,:)) + vrtmp2 = lat(i,:) rtmp2 = modu(vrtmp2) - do while ( rtmp2 <= rtmp1) + do while ( rtmp2 .le. rtmp1) k = k + 1 rtmp1 = rtmp2 - vrtmp2 = real(lat(i,:)) + real(k)*vrtmp1 + vrtmp2 = lat(i,:) + real(k,real32)*vrtmp1 rtmp2 = modu(vrtmp2) end do - if(abs(rtmp1).lt.1.D-5) cycle + if(abs(rtmp1).lt.1.E-5_real32) cycle ncell(i) = max(ncell(i), ceiling(rdist_max/rtmp1)) ncell(j) = max(ncell(j), (k-1)*ceiling(rdist_max/rtmp1)) end do @@ -203,11 +203,11 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) count1=0 dist_list = 0.0 atomloop2: do ja=1,bas%spec(js)%num - vtmp1(:3) = real(bas%spec(is)%atom(ia,:3) - bas%spec(js)%atom(ja,:3)) + vtmp1(:3) = bas%spec(is)%atom(ia,:3) - bas%spec(js)%atom(ja,:3) do i=-ncell(1),ncell(1),1 - vtmp2(1) = vtmp1(1) + real(i) + vtmp2(1) = vtmp1(1) + real(i,real32) do j=-ncell(2),ncell(2),1 - vtmp2(2) = vtmp1(2) + real(j) + vtmp2(2) = vtmp1(2) + real(j,real32) kloop1: do k=-ncell(3),ncell(3),1 if(is.eq.js.and.ia.eq.ja)then if(i.eq.0.and.j.eq.0.and.k.eq.0)then @@ -221,8 +221,8 @@ function gen_DOS(lat,bas,dist_max,scale_dist,norm) result(DOS) ! write(0,'(2X,"dist_list size allocated too small")') ! stop !end if - vtmp2(3) = vtmp1(3) + real(k) - vtmp3 = matmul(vtmp2,real(lat)) + vtmp2(3) = vtmp1(3) + real(k,real32) + vtmp3 = matmul(vtmp2,lat) dist_list(count1) = modu(vtmp3) @@ -264,7 +264,7 @@ function gen_DON(lat,bas,dist_max,scale_dist,norm) result(DON) type(den_of_spec_type), allocatable, dimension(:) :: DOS type(den_of_neigh_type), allocatable, dimension(:) :: DON - real, optional, intent(in) :: dist_max + real(real32), optional, intent(in) :: dist_max logical, optional, intent(in) :: scale_dist,norm type(basis_type), intent(in) :: bas real(real32), dimension(3,3), intent(in) :: lat @@ -313,10 +313,10 @@ function gen_DONsim(DON,dist_max,cutoff,avg_mthd) result(intf_atoms) type(den_of_neigh_type), dimension(:), intent(in) :: DON integer :: i,is,ia,ja,cutloc,itmp1,udef_avg_mthd integer :: nspec,natom,nstep - real :: avg,rdist_max,rcutoff,maxjump - real, optional, intent(in) :: dist_max,cutoff + real(real32) :: avg,rdist_max,rcutoff,maxjump + real(real32), optional, intent(in) :: dist_max,cutoff integer, allocatable, dimension(:) :: intf_list,sumspec - real, allocatable, dimension(:) :: newf,simi,distance + real(real32), allocatable, dimension(:) :: newf,simi,distance integer, allocatable, dimension(:,:) :: intf_atoms integer, optional, intent(in) :: avg_mthd @@ -332,7 +332,7 @@ function gen_DONsim(DON,dist_max,cutoff,avg_mthd) result(intf_atoms) rdist_max=12._real32 if(present(dist_max)) rdist_max=dist_max do i=1,nstep - distance(i)=real(i)*rdist_max/real(nstep) + distance(i)=real(i,real32)*rdist_max/real(nstep,real32) end do rcutoff=4._real32 if(present(cutoff)) rcutoff=min(rcutoff,cutoff) @@ -369,9 +369,9 @@ function gen_DONsim(DON,dist_max,cutoff,avg_mthd) result(intf_atoms) atomloop2: do ja=1,size(DON(is)%atom(:,1)) newf = & overlap_indiv_points(& - (real(DON(is)%atom(ia,:))),& - (real(DON(is)%atom(ja,:)))) - similarity(is)%atom(ia,ja,:)=real(newf) + [DON(is)%atom(ia,:)],& + [DON(is)%atom(ja,:)]) + similarity(is)%atom(ia,ja,:)=real(newf,real32) deallocate(newf) end do atomloop2 do i=1,nstep @@ -470,14 +470,14 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) implicit none integer :: axis integer :: i,is,ia,ja,l,m,n,ks,cutloc,nstep,itmp1 - real :: rdist_max,rcutoff,power,rtmp1 - real, optional, intent(in) :: dist_max,cutoff + real(real32) :: rdist_max,rcutoff,power,rtmp1 + real(real32), optional, intent(in) :: dist_max,cutoff logical, optional :: lprint type(basis_type) :: bas real(real32), dimension(3) :: dir_disim - real, dimension(3) :: vtmp1,vtmp2,vtmp3 + real(real32), dimension(3) :: vtmp1,vtmp2,vtmp3 real(real32), dimension(3,3) :: lat - real, allocatable, dimension(:) :: sim_dist,distance + real(real32), allocatable, dimension(:) :: sim_dist,distance type(den_of_spec_type), allocatable, dimension(:) :: DOS @@ -496,7 +496,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) if(present(dist_max)) rdist_max=dist_max allocate(distance(nstep)) do i=1,nstep - distance(i)=real(i)*rdist_max/real(nstep) + distance(i)=real(i,real32)*rdist_max/real(nstep,real32) end do rcutoff=4.0 if(present(cutoff)) rcutoff=min(rcutoff,cutoff) @@ -525,15 +525,15 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) !! This shows how similar an atom is to its local environment !!----------------------------------------------------------------- do ja=1,bas%spec(is)%num - vtmp1(:3) = real(bas%spec(is)%atom(ia,:3) - & - bas%spec(is)%atom(ja,:3)) + vtmp1(:3) = bas%spec(is)%atom(ia,:3) - & + bas%spec(is)%atom(ja,:3) do l=-1,1,1 - vtmp2(1) = vtmp1(1) + real(l) + vtmp2(1) = vtmp1(1) + real(l,real32) do m=-1,1,1 - vtmp2(2) = vtmp1(2) + real(m) + vtmp2(2) = vtmp1(2) + real(m,real32) nloop3: do n=-1,1,1 - vtmp2(3) = vtmp1(3) + real(n) - vtmp3 = matmul(vtmp2,real(lat)) + vtmp2(3) = vtmp1(3) + real(n,real32) + vtmp3 = matmul(vtmp2,lat) !rtmp1=table_func(vtmp3(i),0.8_real32) !rtmp1=exp(-abs(vtmp3(i))*power) rtmp1=exp(-modu(vtmp3)*power) @@ -543,8 +543,8 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) do ks=1,bas%nspec sim_dist = sim_dist + & sqrt(overlap_indiv_points(& - (real(DOS(is)%atom(ia,ks,:))),& - (real(DOS(is)%atom(ja,ks,:)))))*rtmp1 + [DOS(is)%atom(ia,ks,:)],& + [DOS(is)%atom(ja,ks,:)]))*rtmp1 end do end do nloop3 end do @@ -553,7 +553,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) !!----------------------------------------------------------------- !! saves similarity up to the cutoff for each atom and its location !!----------------------------------------------------------------- - intf_func(i,is)%atom(ia,1)=real(bas%spec(is)%atom(ia,i)*modu(lat(i,:))) + intf_func(i,is)%atom(ia,1)=bas%spec(is)%atom(ia,i)*modu(lat(i,:)) intf_func(i,is)%atom(ia,2)=sum(sim_dist(:cutloc))!/bas%spec(is)%num!/itmp1 @@ -608,7 +608,7 @@ function get_intf_axis_CAD(lat,bas) result(axis) real(real32) :: sigma,gauss_tol,area integer, dimension(3) :: abc real(real32), dimension(3) :: vtmp1,vtmp2,axis_vec - real, allocatable, dimension(:) :: rangevec + real(real32), allocatable, dimension(:) :: rangevec real(real32), allocatable, dimension(:) :: dist,multiCADD real(real32), allocatable, dimension(:,:) :: CAD,deriv real(real32), allocatable, dimension(:,:,:) :: CADD @@ -736,7 +736,7 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) real(real32), dimension(3) :: vtmp1,vtmp2 real(real32), dimension(3,3) :: lat integer, allocatable, dimension(:) :: ivec1 - real, allocatable, dimension(:) :: rangevec + real(real32), allocatable, dimension(:) :: rangevec real(real32), allocatable, dimension(:) :: dist,multiCADD real(real32), allocatable, dimension(:,:) :: CAD,deriv real(real32), allocatable, dimension(:,:,:) :: CADD @@ -853,7 +853,7 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) !!! finds the turning points of the multiCADD and attributes them to ... !!! ... the two interfaces !!!----------------------------------------------------------------------------- - ivec1=get_turn_points(real(multiCADD(:),real32),window=8,lperiodic=.true.) + ivec1=get_turn_points([multiCADD(:)],window=8,lperiodic=.true.) intf_loc(1)=dist(ivec1(size(ivec1))) intf_loc(2)=dist(ivec1(size(ivec1)-1)) @@ -968,11 +968,11 @@ end function get_layered_axis ! function locate_two_intfs(func,ivec1,lmax) result(intf_loc) ! implicit none ! integer :: loc,i -! real :: rtmp1 +! real(real32) :: rtmp1 ! logical :: luse_max ! integer, dimension (:) :: ivec1 ! integer, dimension(2) :: intf_loc -! real, dimension(:) :: func +! real(real32), dimension(:) :: func ! logical, optional :: lmax ! ! @@ -1012,20 +1012,20 @@ function gen_single_DOS(lat,bas,ispec,iatom,dist_max,weight_dist) result(DOS) implicit none integer :: i,j,k,js,ja,count1 integer :: nstep - real :: rdist_max - real :: gauss_tol,DON_sigma,dist,dist_cutoff,rtmp1 + real(real32) :: rdist_max + real(real32) :: gauss_tol,DON_sigma,dist,dist_cutoff,rtmp1 type(basis_type) :: bas logical :: lweight - real, dimension(3) :: vtmp1,vtmp2,vtmp3 - real, allocatable, dimension(:) :: distance + real(real32), dimension(3) :: vtmp1,vtmp2,vtmp3 + real(real32), allocatable, dimension(:) :: distance integer, intent(in) :: ispec,iatom real(real32), dimension(3,3), intent(in) :: lat - real, optional, intent(in) :: dist_max + real(real32), optional, intent(in) :: dist_max logical, optional, intent(in) :: weight_dist real(real32), allocatable, dimension(:,:) :: DOS - real, allocatable, dimension(:) :: dist_list + real(real32), allocatable, dimension(:) :: dist_list nstep=nstep_default @@ -1036,7 +1036,7 @@ function gen_single_DOS(lat,bas,ispec,iatom,dist_max,weight_dist) result(DOS) rdist_max=12._real32 if(present(dist_max)) rdist_max=dist_max do i=1,nstep - distance(i)=real(i)*rdist_max/real(nstep) + distance(i)=real(i,real32)*rdist_max/real(nstep,real32) end do gauss_tol=16.E0!38._real32 @@ -1048,19 +1048,19 @@ function gen_single_DOS(lat,bas,ispec,iatom,dist_max,weight_dist) result(DOS) count1=0 dist_list = 0.0 atomloop1: do ja=1,bas%spec(js)%num - vtmp1(:3) = real(bas%spec(ispec)%atom(iatom,:3) - bas%spec(js)%atom(ja,:3)) + vtmp1(:3) = bas%spec(ispec)%atom(iatom,:3) - bas%spec(js)%atom(ja,:3) do i=-1,1,1 - vtmp2(1) = vtmp1(1) + real(i) + vtmp2(1) = vtmp1(1) + real(i,real32) do j=-1,1,1 - vtmp2(2) = vtmp1(2) + real(j) + vtmp2(2) = vtmp1(2) + real(j,real32) kloop1: do k=-1,1,1 if(ispec.eq.js.and.iatom.eq.ja)then if(i.eq.0.and.j.eq.0.and.k.eq.0)then cycle kloop1 end if end if - vtmp2(3) = vtmp1(3) + real(k) - vtmp3 = matmul(vtmp2,real(lat)) + vtmp2(3) = vtmp1(3) + real(k,real32) + vtmp3 = matmul(vtmp2,lat) rtmp1=modu(vtmp3) if(rtmp1.gt.dist_cutoff) cycle kloop1 count1=count1+1 @@ -1107,7 +1107,7 @@ function gen_single_DON(lat,bas,ispec,iatom,dist_max) result(DON) real(real32), allocatable, dimension(:) :: DON real(real32), allocatable, dimension(:,:) :: DOS integer, intent(in) :: ispec,iatom - real, optional, intent(in) :: dist_max + real(real32), optional, intent(in) :: dist_max if(present(dist_max))then diff --git a/src/fortran/mod_lat_compare.f90 b/src/fortran/mod_lat_compare.f90 index 4b76267..d2cdb8d 100644 --- a/src/fortran/mod_lat_compare.f90 +++ b/src/fortran/mod_lat_compare.f90 @@ -966,8 +966,8 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) integer, dimension(3,3) :: tmat1,tmat2 integer, dimension(3,3) :: transform1,transform2 !The transformations output by planecutter. - real, dimension(3) :: rvec1, rvec2 - real, dimension(3,3) :: rmat1 + real(real32), dimension(3) :: rvec1, rvec2 + real(real32), dimension(3,3) :: rmat1 real(real32), allocatable, dimension(:,:,:) :: tmpsym1,tmpsym2,tmpsym real(real32), allocatable, dimension(:,:,:) :: transform1_saved,transform2_saved !The transformations output by plane cutter diff --git a/src/fortran/mod_plane_matching.f90 b/src/fortran/mod_plane_matching.f90 index be928b3..f6e998d 100644 --- a/src/fortran/mod_plane_matching.f90 +++ b/src/fortran/mod_plane_matching.f90 @@ -410,7 +410,7 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list !!!------------------------------------------------------------------------ !!! initialises tolerance and output !!!------------------------------------------------------------------------ - tol=1.D-5 + tol=1.E-5_real32 lunique = .true. @@ -570,7 +570,7 @@ subroutine cell_match(& ntransforms,matched_tols,sym1,sym2) implicit none integer :: i,j,l,m,total_list_count,nvec1,nvec2 - real :: tol_up_ang,tol_dw_ang,tol_up_vec,tol_dw_vec + real(real32) :: tol_up_ang,tol_dw_ang,tol_up_vec,tol_dw_vec real(real32) :: tiny real(real32) :: reference_mag,considered_mag real(real32) :: reference_angle,considered_angle @@ -627,7 +627,7 @@ subroutine cell_match(& !!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! Setting up tolerances !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!! - tiny = 1.D-5 + tiny = 1.E-5_real32 tol_up_ang = 1.E0 + real(tol%ang)/(2.E0*pi) tol_dw_ang = 1.E0 - real(tol%ang)/(2.E0*pi) tol_up_vec = 1.E0 + real(tol%vec)!/100._real32 diff --git a/src/fortran/mod_shifting.f90 b/src/fortran/mod_shifting.f90 index 2c1c00c..7960072 100644 --- a/src/fortran/mod_shifting.f90 +++ b/src/fortran/mod_shifting.f90 @@ -14,8 +14,8 @@ module shifting use interface_identifier implicit none - real :: f_scale = 0.5 - real :: g_scale = 8.0/3.0 + real(real32) :: f_scale = 0.5 + real(real32) :: g_scale = 8.0/3.0 private @@ -126,7 +126,7 @@ subroutine get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) !!----------------------------------------------------------------------- !! Finds lower interfacial atoms near interface defined by intf_loc(1) !!----------------------------------------------------------------------- - intf_list=gen_DONsim(gen_DON(lat,splitbas(1)),cutoff=4.0) + intf_list=gen_DONsim(gen_DON(lat,splitbas(1)),cutoff=4._real32) 101 do is=1,bas%nspec bas_bot%sysname=splitbas(1)%sysname bas_bot%spec(is)%name=splitbas(1)%spec(is)%name @@ -156,7 +156,7 @@ subroutine get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) !! ... method 2 !!----------------------------------------------------------------------- if(bas_bot%natom.eq.0)then - intf_list=gen_DONsim(gen_DON(lat,splitbas(1)),cutoff=4.0,avg_mthd=2) + intf_list=gen_DONsim(gen_DON(lat,splitbas(1)),cutoff=4._real32,avg_mthd=2) do is=1,bas%nspec deallocate(bas_bot%spec(is)%atom) end do @@ -167,7 +167,7 @@ subroutine get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) !!----------------------------------------------------------------------- !! Finds upper interfacial atoms near interface defined by intf_loc(1) !!----------------------------------------------------------------------- - intf_list=gen_DONsim(gen_DON(lat,splitbas(2)),cutoff=4.0) + intf_list=gen_DONsim(gen_DON(lat,splitbas(2)),cutoff=4._real32) 102 do is=1,bas%nspec bas_top%sysname=splitbas(2)%sysname bas_top%spec(is)%name=splitbas(2)%spec(is)%name @@ -197,7 +197,7 @@ subroutine get_top_bot_basis(lat,bas,bas_top,bas_bot,axis,intf_loc,depth) !! ... method 2 !!----------------------------------------------------------------------- if(bas_top%natom.eq.0)then - intf_list=gen_DONsim(gen_DON(lat,splitbas(2)),cutoff=4.0,avg_mthd=2) + intf_list=gen_DONsim(gen_DON(lat,splitbas(2)),cutoff=4._real32,avg_mthd=2) do is=1,bas%nspec deallocate(bas_top%spec(is)%atom) end do @@ -748,26 +748,26 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& implicit none integer :: i,j,k,l,is,ia,ja,jb,jc,count1,itmp1 integer :: ntrans,iatom,nneigh,ncheck - real :: stepsize,max_sep,dist_max - real :: rtmp1,rtmp2,rtmp3 + real(real32) :: stepsize,max_sep,dist_max + real(real32) :: rtmp1,rtmp2,rtmp3 real(real32) :: val,dtmp1,dtmp2 logical :: lbulk, lpresent type(confine_type) :: confine integer, dimension(2) :: plane_loc integer, dimension(3) :: ngrid,nstep,ivtmp1 - real, dimension(2) :: min_trans,lowest_atom,highest_atom - real, dimension(3) :: pos,vtmp1,vtmp2,vtmp3,gridsize,add + real(real32), dimension(2) :: min_trans,lowest_atom,highest_atom + real(real32), dimension(3) :: pos,vtmp1,vtmp2,vtmp3,gridsize,add logical, dimension(2) :: lwyckoff type(map_type), dimension(2) :: map type(wyck_spec_type), dimension(2) :: wyckoff - real, allocatable, dimension(:) :: fit_store,tmp_neigh + real(real32), allocatable, dimension(:) :: fit_store,tmp_neigh type(basis_type), allocatable, dimension(:) :: splitbas type(den_of_neigh_type), allocatable, dimension(:,:) :: DON_missing integer, allocatable, dimension(:,:) :: shift_store real(real32), allocatable, dimension(:,:) :: res_shifts,trans,regions integer, intent(in) :: axis,nstore - real, intent(in), optional :: max_bondlength + real(real32), intent(in), optional :: max_bondlength type(basis_type), intent(in) :: bas real(real32), dimension(:), intent(in) :: intf_loc real(real32), dimension(3,3), intent(in) :: lat @@ -786,8 +786,8 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& type neighbour_type integer :: num - real :: bond - real, dimension(3) :: pos + real(real32) :: bond + real(real32), dimension(3) :: pos end type neighbour_type type(neighbour_type), allocatable, dimension(:,:) :: neighbour type intf_type @@ -797,7 +797,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& type grid_type - real, allocatable, dimension(:) :: neigh + real(real32), allocatable, dimension(:) :: neigh end type grid_type type(grid_type), allocatable, dimension(:,:,:,:) :: course_grid @@ -857,7 +857,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& end do end do min_trans=abs(min_trans) - where(abs(min_trans).lt.1.D-5) + where(abs(min_trans).lt.1.E-5_real32) min_trans=1._real32 end where if(ierror.eq.1) write(6,*) "repeated_trans:",min_trans @@ -1301,10 +1301,10 @@ end function get_shifts_DON subroutine sort_shifts(fits,shifts) implicit none integer :: i,loc,num - real :: dbuff + real(real32) :: dbuff integer, dimension(3) :: ivtmp1 integer, dimension(:,:), intent(inout) :: shifts - real, dimension(:), intent(inout) :: fits + real(real32), dimension(:), intent(inout) :: fits num = size(fits,dim=1) diff --git a/src/fortran/mod_swapping.f90 b/src/fortran/mod_swapping.f90 index 28d34e8..2c66dcc 100644 --- a/src/fortran/mod_swapping.f90 +++ b/src/fortran/mod_swapping.f90 @@ -34,23 +34,23 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& integer :: i,j,is,iout,itmp,count1 integer :: axis,nswap integer :: nabove,nbelow,nswaps_per_cell,nfail !,nperm - real :: udef_sigma,small_sigma + real(real32) :: udef_sigma,small_sigma real(real32) :: dintf,dist type(basis_type) :: tmpbas,store_bas type(sym_type) :: grp !real(real32), dimension(4,4) :: intf_sym integer, allocatable, dimension(:) :: spec_list integer, allocatable, dimension(:) :: lw_close_list,up_close_list - real, allocatable, dimension(:) :: lw_dist_list,up_dist_list - real, allocatable, dimension(:) :: lw_weight_list,up_weight_list + real(real32), allocatable, dimension(:) :: lw_dist_list,up_dist_list + real(real32), allocatable, dimension(:) :: lw_weight_list,up_weight_list integer, allocatable, dimension(:,:) :: pos_list,up_list,lw_list real(real32), allocatable, dimension(:,:) :: bas_list real(real32), dimension(4,4) :: intf_sym integer, intent(in) :: iswap - real, intent(in) :: width - real, optional, intent(in) :: sigma + real(real32), intent(in) :: width + real(real32), optional, intent(in) :: sigma logical, optional, intent(in) :: require_mirror type(basis_type), intent(in) :: bas integer, allocatable, dimension(:), intent(in) :: seed @@ -332,7 +332,7 @@ subroutine rand_swap(bas,swap_bas,nabove,nbelow,nswaps_per_cell,up_list,lw_list) integer :: itmp1,itmp2,old_itmp1 integer :: lw_mirror,up_mirror integer :: lw_remove,up_remove,nabove,nbelow,nswaps_per_cell - real :: r_rand + real(real32) :: r_rand integer, allocatable, dimension(:,:) :: swap_list,up_list,lw_list type(basis_type) :: bas,swap_bas @@ -432,21 +432,21 @@ subroutine check_intf_depth(lat,bas,axis,intf_loc,sigma,& implicit none integer :: i,is,ia integer :: nbelow,nabove - real :: rtol + real(real32) :: rtol real(real32), dimension(2) :: midpoint integer, allocatable, dimension(:) :: tmp_list1,tmp_list2 - real, allocatable, dimension(:) :: tmp_dist_list1,tmp_dist_list2 + real(real32), allocatable, dimension(:) :: tmp_dist_list1,tmp_dist_list2 integer, intent(in) :: axis - real, intent(in) :: sigma + real(real32), intent(in) :: sigma type(basis_type), intent(in) :: bas real(real32), dimension(2), intent(in) :: intf_loc real(real32), dimension(3,3), intent(in) :: lat integer, allocatable, dimension(:), intent(out) :: spec_list integer, allocatable, dimension(:), intent(out) :: lw_close_list,up_close_list - real, allocatable, dimension(:), intent(out) :: lw_dist_list,up_dist_list - real, allocatable, dimension(:), intent(out) :: lw_weight_list,up_weight_list + real(real32), allocatable, dimension(:), intent(out) :: lw_dist_list,up_dist_list + real(real32), allocatable, dimension(:), intent(out) :: lw_weight_list,up_weight_list integer, allocatable, dimension(:,:), intent(out) :: lw_list,up_list @@ -540,11 +540,11 @@ subroutine check_intf_depth(lat,bas,axis,intf_loc,sigma,& !!!----------------------------------------------------------------------------- allocate(lw_weight_list(nbelow)) allocate(lw_close_list(nbelow)) - lw_weight_list(1) = gauss(pos=lw_dist_list(1),centre=0.0,sigma=sigma) + lw_weight_list(1) = gauss(pos=lw_dist_list(1),centre=0._real32,sigma=sigma) lw_close_list(1) = count(abs(lw_dist_list(1) - lw_dist_list(:nbelow)).le.rtol) do i=2,nbelow - lw_weight_list(i) = lw_weight_list(i-1) + gauss(pos=lw_dist_list(i),centre=0.0,sigma=sigma) + lw_weight_list(i) = lw_weight_list(i-1) + gauss(pos=lw_dist_list(i),centre=0._real32,sigma=sigma) lw_close_list(i) = count(abs(lw_dist_list(i) - lw_dist_list(:nbelow)).le.rtol) end do @@ -552,11 +552,11 @@ subroutine check_intf_depth(lat,bas,axis,intf_loc,sigma,& allocate(up_weight_list(nabove)) allocate(up_close_list(nabove)) - up_weight_list(1) = gauss(pos=up_dist_list(1),centre=0.0,sigma=sigma) + up_weight_list(1) = gauss(pos=up_dist_list(1),centre=0._real32,sigma=sigma) up_close_list(1) = count(abs(up_dist_list(1) - up_dist_list(:nabove)).le.rtol) do i=2,nabove - up_weight_list(i) = up_weight_list(i-1) + gauss(pos=up_dist_list(i),centre=0.0,sigma=sigma) + up_weight_list(i) = up_weight_list(i-1) + gauss(pos=up_dist_list(i),centre=0._real32,sigma=sigma) up_close_list(i) = count(abs(up_dist_list(i) - up_dist_list(:nabove)).le.rtol) end do @@ -582,18 +582,18 @@ subroutine rand_swap_depth(bas,swap_bas,& integer :: i,loc1,loc2 integer :: nbelow,nabove integer :: lw_mirror,up_mirror - real :: r_rand1,r_rand2 + real(real32) :: r_rand1,r_rand2 integer, allocatable, dimension(:) :: lw_convert,up_convert integer, allocatable, dimension(:,:) :: swap_list - real, allocatable, dimension(:) :: tlw_weight_list,tup_weight_list + real(real32), allocatable, dimension(:) :: tlw_weight_list,tup_weight_list integer, dimension(:), intent(in) :: spec_list integer, dimension(:), intent(in) :: lw_close_list,up_close_list - real, dimension(:), intent(in) :: lw_dist_list,up_dist_list - real, dimension(:), intent(in) :: lw_weight_list,up_weight_list + real(real32), dimension(:), intent(in) :: lw_dist_list,up_dist_list + real(real32), dimension(:), intent(in) :: lw_weight_list,up_weight_list integer, dimension(:,:), intent(in) :: lw_list,up_list - real, intent(in) :: sigma,small_sigma + real(real32), intent(in) :: sigma,small_sigma type(basis_type), intent(inout) :: swap_bas integer, intent(in) :: nswaps_per_cell type(basis_type), intent(in) :: bas @@ -763,12 +763,12 @@ function recalc_rand_distrib(dist_list,conversion,close_list,swap_list,sigma,sma implicit none integer :: i,j integer :: nswaps,num - real :: small_sigma + real(real32) :: small_sigma - real, intent(in) :: sigma + real(real32), intent(in) :: sigma integer, dimension(:),intent(in) :: close_list,swap_list,conversion - real, dimension(:),intent(in) :: dist_list - real, allocatable, dimension(:) :: new_list + real(real32), dimension(:),intent(in) :: dist_list + real(real32), allocatable, dimension(:) :: new_list num = size(conversion) @@ -777,7 +777,7 @@ function recalc_rand_distrib(dist_list,conversion,close_list,swap_list,sigma,sma allocate(new_list(num)) do i=1,num - new_list(i) = gauss(pos=dist_list(conversion(i)),centre=0.0,sigma=sigma) + new_list(i) = gauss(pos=dist_list(conversion(i)),centre=0._real32,sigma=sigma) do j=1,nswaps From 36ea17340ac1071fc981f85a0280d8b1c59d226c Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 06:22:34 +0100 Subject: [PATCH 037/137] Move abstract generator type --- CMakeLists.txt | 2 +- src/fortran/lib/mod_misc_types.f90 | 72 +++++++++++++++++++++++++++++- src/fortran/mod_generator.f90 | 67 +-------------------------- 3 files changed, 74 insertions(+), 67 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 30c0284..4932afb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -55,7 +55,6 @@ set(LIB_DIR ${FORTRAN_SRC_DIR}/lib) set(LIB_FILES mod_constants.f90 mod_misc.f90 - mod_misc_types.f90 mod_io_utils.F90 mod_help.f90 mod_misc_maths.f90 @@ -66,6 +65,7 @@ set(LIB_FILES mod_sym.f90 mod_tools_infile.f90 mod_terminations.f90 + mod_misc_types.f90 ) # Main source files diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 6d4b9c4..c09664b 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -1,6 +1,8 @@ module artemis__misc_types !! Module containing custom derived types for ARTEMIS use artemis__constants, only: real32 + use artemis__misc, only: to_lower + use artemis__geom_rw, only: basis_type, geom_write implicit none @@ -8,6 +10,7 @@ module artemis__misc_types public :: latmatch_type public :: tol_type + public :: abstract_artemis_generator_type type latmatch_type @@ -32,4 +35,71 @@ module artemis__misc_types real(real32) :: area_weight = 100._real32 end type tol_type -end module artemis__misc_types \ No newline at end of file + type :: abstract_artemis_generator_type + integer :: max_num_structures = 100 + + real(real32) :: tol_cart + real(real32), dimension(3) :: tol_crys + + type(basis_type), dimension(:), allocatable :: structures + contains + procedure, pass(this) :: write_structures + end type abstract_artemis_generator_type + + +contains + +!############################################################################### + subroutine write_structures( & + this, directory, prefix & + ) + !! Write the generated terminations to file + implicit none + + ! Arguments + class(abstract_artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + character(len=*), intent(in) :: directory + !! Directory to write the files to + character(len=*), intent(in), optional :: prefix + !! Prefix for the output files + + ! Local variables + integer :: i + !! Loop variable + integer :: unit + !! File unit number + character(len=256) :: filename, filename_template + !! File name for the output files + character(len=:), allocatable :: prefix_ + !! Prefix for the output files + + + + if(trim(directory).ne."") then + call system('mkdir -p '//trim(adjustl(directory))) + end if + + filename_template = "POSCAR" + if(present(prefix)) then + prefix_ = trim(to_lower(prefix)) + filename_template = trim(filename_template) // "_" // trim(prefix_) + end if + if(allocated(this%structures))then + do i = 1, size(this%structures) + write(filename,'(A,I0)') trim(filename_template), i + if(trim(directory).ne."") then + filename = trim(directory) // "/" // trim(filename) + end if + open(newunit=unit,file=filename) + call geom_write(unit, this%structures(i)) + close(unit) + end do + else + write(0,'(1X,"No structures to write.")') + end if + + end subroutine write_structures +!############################################################################### + +end module artemis__misc_types diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 97a217b..1dfae36 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -7,8 +7,9 @@ module artemis__generator use artemis__constants, only: real32, ierror, pi use artemis__misc, only: to_lower,to_upper + use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type use artemis__geom_rw, only: basis_type,geom_write - use lat_compare, only: get_best_match,latmatch_type,tol_type + use lat_compare, only: get_best_match use artemis__io_utils, only: err_abort use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: uvec,modu,get_area,inverse,cross @@ -31,16 +32,6 @@ module artemis__generator type(bulk_DON_type), dimension(2) :: bulk_DON - type :: abstract_artemis_generator_type - integer :: max_num_structures = 100 - - real(real32) :: tol_cart - real(real32), dimension(3) :: tol_crys - - type(basis_type), dimension(:), allocatable :: structures - contains - procedure, pass(this) :: write_structures - end type abstract_artemis_generator_type @@ -332,60 +323,6 @@ end subroutine generate_terminations !############################################################################### -!############################################################################### - subroutine write_structures( & - this, directory, prefix & - ) - !! Write the generated terminations to file - implicit none - - ! Arguments - class(abstract_artemis_generator_type), intent(in) :: this - !! Instance of artemis generator type - character(len=*), intent(in) :: directory - !! Directory to write the files to - character(len=*), intent(in), optional :: prefix - !! Prefix for the output files - - ! Local variables - integer :: i - !! Loop variable - integer :: unit - !! File unit number - character(len=256) :: filename, filename_template - !! File name for the output files - character(len=:), allocatable :: prefix_ - !! Prefix for the output files - - - - if(trim(directory).ne."") then - call system('mkdir -p '//trim(adjustl(directory))) - end if - - filename_template = "POSCAR" - if(present(prefix)) then - prefix_ = trim(to_lower(prefix)) - filename_template = trim(filename_template) // "_" // trim(prefix_) - end if - if(allocated(this%structures))then - do i = 1, size(this%structures) - write(filename,'(A,I0)') trim(filename_template), i - if(trim(directory).ne."") then - filename = trim(directory) // "/" // trim(filename) - end if - open(newunit=unit,file=filename) - call geom_write(unit, this%structures(i)) - close(unit) - end do - else - write(0,'(1X,"No structures to write.")') - end if - - end subroutine write_structures -!############################################################################### - - !############################################################################### subroutine generate_intefaces_from_existing(this, basis) !! Generate interfaces for the given basis From bf8d9cd51b1e33694d1cc87a657e9bf4f3b9d0f4 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 08:16:46 +0100 Subject: [PATCH 038/137] Optimise lattice matching --- src/fortran/lib/mod_edit_geom.f90 | 61 ++++++++-------- src/fortran/lib/mod_misc_linalg.f90 | 103 ++++++++++++++++------------ src/fortran/lib/mod_misc_types.f90 | 4 +- src/fortran/mod_generator.f90 | 70 ++++--------------- src/fortran/mod_lat_compare.f90 | 75 ++++++++++---------- src/fortran/mod_plane_matching.f90 | 8 +-- 6 files changed, 148 insertions(+), 173 deletions(-) diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 index b95cf48..90ef04c 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_edit_geom.f90 @@ -1379,54 +1379,55 @@ end function reduced_check !!!############################################################################# !!! planecutter !!!############################################################################# - function planecutter(inlat,invec) result(tfmat) + function planecutter(lat, plane) result(tfmat) implicit none + real(real32), dimension(3,3), intent(in) :: lat + real(real32), dimension(3), intent(in) :: plane + integer :: i,j,itmp1 real(real32) :: tol integer, dimension(3) :: order - real(real32), dimension(3) :: vec,tvec1 - real(real32), dimension(3,3) :: lat,b,tfmat,invlat,reclat - real(real32), dimension(3), intent(in) :: invec - real(real32), dimension(3,3), intent(in) :: inlat + real(real32), dimension(3) :: plane_,tvec1 + real(real32), dimension(3,3) :: lat_,b,tfmat,invlat,reclat !!!----------------------------------------------------------------------------- !!! Initialise variables and matrices !!!----------------------------------------------------------------------------- - tol = 1.E-4_real32 - vec=invec - lat=inlat - invlat=inverse(lat) - reclat=transpose(invlat) - vec=reduce_vec_gcd(vec) - order=(/1,2,3/) + tol = 1.E-4_real32 + plane_ = plane + lat_ = lat + invlat = inverse(lat_) + reclat = transpose(invlat) + plane_ = reduce_vec_gcd(plane_) + order = [ 1, 2, 3 ] !!!----------------------------------------------------------------------------- !!! Align the normal vector such that all non-zero values are left of all zeros !!!----------------------------------------------------------------------------- do i=1,2 - if(vec(i).eq.0)then - if(all(vec(i:).eq.0._real32)) exit - itmp1=maxloc(vec(i+1:),mask=vec(i+1:).ne.0,dim=1)+i + if(plane_(i).eq.0)then + if(all(plane_(i:).eq.0._real32)) exit + itmp1=maxloc(plane_(i+1:),mask=plane_(i+1:).ne.0,dim=1)+i call swap(order(i),order(itmp1)) - call swap(vec(i),vec(itmp1)) - call swap(lat(:,i),lat(:,itmp1)) - call swap(lat(i,:),lat(itmp1,:)) + call swap(plane_(i),plane_(itmp1)) + call swap(lat_(:,i),lat_(:,itmp1)) + call swap(lat_(i,:),lat_(itmp1,:)) call swap(reclat(:,i),reclat(:,itmp1)) call swap(reclat(i,:),reclat(itmp1,:)) end if end do - !vec=matmul(vec,reclat) + !plane_=matmul(plane_,reclat) !!!----------------------------------------------------------------------------- !!! Perform Lenstra-Lenstra-Lovász reduction !!!----------------------------------------------------------------------------- - b(1,:) = (/-vec(2),vec(1),0._real32/) - b(2,:) = (/-vec(3),0._real32,vec(1)/) - b(3,:) = vec + b(1,:) = [ -plane_(2),plane_(1),0._real32 ] + b(2,:) = [ -plane_(3),0._real32,plane_(1) ] + b(3,:) = plane_ tfmat = b b(:2,:) = LLL_reduce(b(:2,:)) @@ -1473,7 +1474,7 @@ function planecutter(inlat,invec) result(tfmat) stop end if - !b = matmul(b,lat) + !b = matmul(b,lat_) !!!----------------------------------------------------------------------------- @@ -1481,8 +1482,8 @@ function planecutter(inlat,invec) result(tfmat) !!!----------------------------------------------------------------------------- do i=1,3 if(i.eq.order(i)) cycle - call swap(lat(i,:),lat(order(i),:)) - call swap(lat(:,i),lat(:,order(i))) + call swap(lat_(i,:),lat_(order(i),:)) + call swap(lat_(:,i),lat_(:,order(i))) call swap(b(:,i),b(:,order(i))) call swap(order(order(i)),order(i)) end do @@ -1501,8 +1502,8 @@ function planecutter(inlat,invec) result(tfmat) reduce_loop: do i=1,3 b(i,:)=reduce_vec_gcd(b(i,:)) if(any(abs(b(i,:)-nint(b(i,:))).gt.tol))then - write(0,'("Issue with plane ",3(1X,I0))') nint(invec) - write(0,*) vec + write(0,'("Issue with plane ",3(1X,I0))') nint(plane) + write(0,*) plane_ write(0,'("row ",I0," of the following matrix")') i write(0,'(3(2X,F9.3))') (b(j,:),j=1,3) write(0,'(1X,"ERROR: Internal error in planecutter function")') @@ -1513,9 +1514,9 @@ function planecutter(inlat,invec) result(tfmat) end if end do reduce_loop if(det(b).lt.0._real32)then - tvec1=b(2,:) - b(2,:)=b(1,:) - b(1,:)=tvec1 + tvec1 = b(2,:) + b(2,:) = b(1,:) + b(1,:) = tvec1 end if if(abs(det(b)).lt.tol)then write(0,'(1X,"ERROR: Internal error in planecutter function")') diff --git a/src/fortran/lib/mod_misc_linalg.f90 b/src/fortran/lib/mod_misc_linalg.f90 index be8b740..1dc28c0 100644 --- a/src/fortran/lib/mod_misc_linalg.f90 +++ b/src/fortran/lib/mod_misc_linalg.f90 @@ -409,13 +409,14 @@ end function ddet !!!##################################################### pure function inverse(mat) real(real32), dimension(:,:), intent(in) :: mat - real(real32), dimension(size(mat(:,1),dim=1),size(mat(1,:),dim=1)) :: inverse + real(real32), dimension(size(mat,dim=1),size(mat,dim=2)) :: inverse - if(size(mat,dim=2).eq.2)then + select case(size(mat,dim=2)) + case(2) inverse = inverse_2x2(mat) - elseif(size(mat,dim=2).eq.3)then + case(3) inverse = inverse_3x3(mat) - end if + end select end function inverse !!!##################################################### @@ -425,22 +426,19 @@ end function inverse !!! returns inverse of 2 x 2 matrix !!!##################################################### pure function inverse_2x2(mat) result(output) - real(real32) :: det - real(real32), dimension(2,2) :: output + implicit none real(real32), dimension(2,2), intent(in) :: mat + real(real32), dimension(2,2) :: output + real(real32) :: inv_det - det = mat(1,1)*mat(2,2)-mat(1,2)*mat(2,1) - !if(det.eq.0._real32)then - ! write(0,'("ERROR: Internal error in inverse_2x2")') - ! write(0,'(2X,"inverse_2x2 in mod_misc_linalg found determinant of 0")') - ! write(0,'(2X,"Exiting...")') - ! stop - !end if + associate(a => mat(1,1), b => mat(1,2), c => mat(2,1), d => mat(2,2)) + inv_det = 1._real32 / (a * d - b * c) - output(1,1) = +1._real32 / det * ( mat(2,2) ) - output(2,1) = -1._real32 / det * ( mat(1,2) ) - output(1,2) = -1._real32 / det * ( mat(2,1) ) - output(2,2) = +1._real32 / det * ( mat(1,1) ) + output(1,1) = d * inv_det + output(1,2) = -b * inv_det + output(2,1) = -c * inv_det + output(2,2) = a * inv_det + end associate end function inverse_2x2 !!!##################################################### @@ -450,32 +448,47 @@ end function inverse_2x2 !!! returns inverse of 3 x 3 matrix !!!##################################################### pure function inverse_3x3(mat) result(output) - real(real32) :: det - real(real32), dimension(3,3) :: output - real(real32), dimension(3,3), intent(in) :: mat + implicit none + real(real32), dimension(3,3), intent(in) :: mat + real(real32), dimension(3,3) :: output + real(real32) :: inv_det + real(real32) :: c00, c01, c02, c10, c11, c12, c20, c21, c22 - 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) + associate( & + m11 => mat(1,1), m12 => mat(1,2), m13 => mat(1,3), & + m21 => mat(2,1), m22 => mat(2,2), m23 => mat(2,3), & + m31 => mat(3,1), m32 => mat(3,2), m33 => mat(3,3)) + + ! Cofactors + c00 = m22 * m33 - m23 * m32 + c01 = -m21 * m33 + m23 * m31 + c02 = m21 * m32 - m22 * m31 - !if(det.eq.0._real32)then - ! write(0,'("ERROR: Internal error in inverse_3x3")') - ! write(0,'(2X,"inverse_3x3 in mod_misc_linalg found determinant of 0")') - ! write(0,'(2X,"Exiting...")') - ! stop - !end if + c10 = -m12 * m33 + m13 * m32 + c11 = m11 * m33 - m13 * m31 + c12 = -m11 * m32 + m12 * m31 - 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) ) + c20 = m12 * m23 - m13 * m22 + c21 = -m11 * m23 + m13 * m21 + c22 = m11 * m22 - m12 * m21 - end function inverse_3x3 + inv_det = 1._real32 / (m11 * c00 + m12 * c01 + m13 * c02) + + ! Transpose cofactors into the inverse + output(1,1) = c00 * inv_det + output(2,1) = c01 * inv_det + output(3,1) = c02 * inv_det + + output(1,2) = c10 * inv_det + output(2,2) = c11 * inv_det + output(3,2) = c12 * inv_det + + output(1,3) = c20 * inv_det + output(2,3) = c21 * inv_det + output(3,3) = c22 * inv_det + + end associate +end function inverse_3x3 !!!##################################################### @@ -650,13 +663,19 @@ end subroutine LUdecompose function find_tf(mat1,mat2) result(tf) implicit none real(real32), dimension(:,:) :: mat1,mat2 - real(real32), allocatable, dimension(:,:) :: tf + real(real32), dimension(size(mat1,dim=1),size(mat1,dim=2)) :: tf - allocate(tf(size(mat2(:,1),dim=1),size(mat1(1,:),dim=1))) tf=matmul(inverse(mat1),mat2) - end function find_tf + function find_tf_2x2(mat1,mat2) result(tf) + implicit none + real(real32), dimension(2,2) :: mat1,mat2 + real(real32), dimension(2,2) :: tf + + tf=matmul(inverse_2x2(mat1),mat2) + + end function find_tf_2x2 !!!##################################################### diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index c09664b..0a2c3da 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -25,7 +25,9 @@ module artemis__misc_types end type latmatch_type type tol_type - integer :: maxsize,maxfit,nstore + integer :: nstore = 5 + integer :: maxfit = 100 + integer :: maxsize = 10 real(real32) :: maxlen=20._real32 real(real32) :: maxarea=400._real32 real(real32) :: vec = 5._real32 diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index 1dfae36..adb1d18 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -102,60 +102,19 @@ subroutine set_tolerance( & real(real32), intent(in), optional :: area_weight !! Importance weighting of area mismatch - if(present(tolerance)) this%tolerance = tolerance - - if(present(vector_mismatch)) then - this%tolerance%vec = vector_mismatch - else - this%tolerance%vec = 5._real32 - end if - - if(present(angle_mismatch)) then - this%tolerance%ang = angle_mismatch - else - this%tolerance%ang = 5._real32 - end if - - if(present(area_mismatch)) then - this%tolerance%area = area_mismatch - else - this%tolerance%area = 10._real32 - end if - - if(present(max_length)) then - this%tolerance%maxlen = max_length - else - this%tolerance%maxlen = 20._real32 - end if - - if(present(max_area)) then - this%tolerance%maxarea = max_area - else - this%tolerance%maxarea = 400._real32 - end if - - if(present(max_fit)) then - this%tolerance%maxfit = max_fit - else - this%tolerance%maxfit = 5 - end if - - if(present(max_extension)) then - this%tolerance%maxsize = max_extension - else - this%tolerance%maxsize = 5 - end if - - if(present(angle_weight)) then - this%tolerance%ang_weight = angle_weight - else - this%tolerance%ang_weight = 1._real32 - end if - - if(present(area_weight)) then - this%tolerance%area_weight = area_weight + if(present(tolerance))then + this%tolerance = tolerance else - this%tolerance%area_weight = 1._real32 + if(present(vector_mismatch)) this%tolerance%vec = vector_mismatch + if(present(angle_mismatch)) this%tolerance%ang = angle_mismatch + if(present(area_mismatch)) this%tolerance%area = area_mismatch + if(present(max_length)) this%tolerance%maxlen = max_length + if(present(max_area)) this%tolerance%maxarea = max_area + if(present(max_fit)) this%tolerance%maxfit = max_fit + ! if(present(nstore)) this%tolerance%nstore = nstore + if(present(max_extension)) this%tolerance%maxsize = max_extension + if(present(angle_weight)) this%tolerance%ang_weight = angle_weight + if(present(area_weight)) this%tolerance%area_weight = area_weight end if end subroutine set_tolerance @@ -668,20 +627,17 @@ subroutine generate_interfaces(this, basis_lw, basis_up) call transformer(basis_lw_,tfmat,lw_map) SAV=get_best_match(& this%tolerance,& - basis_lw_%lat,basis_up_%lat,& basis_lw_,basis_up_,& trim(abc),"abc",lprint_matches,ierror,imatch=imatch) elseif(any(up_mplane.ne.0))then SAV=get_best_match(& this%tolerance,& - basis_lw_%lat,basis_up_%lat,& basis_lw_,basis_up_,& trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& plane1=lw_mplane,plane2=up_mplane,nmiller=nmiller) else SAV=get_best_match(& this%tolerance,& - basis_lw_%lat,basis_up_%lat,& basis_lw_,basis_up_,& trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& plane1=lw_mplane,nmiller=nmiller) @@ -689,14 +645,12 @@ subroutine generate_interfaces(this, basis_lw, basis_up) elseif(any(up_mplane.ne.0))then SAV=get_best_match(& this%tolerance,& - basis_lw_%lat,basis_up_%lat,& basis_lw_,basis_up_,& trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& plane2=up_mplane,nmiller=nmiller) else SAV=get_best_match(& this%tolerance,& - basis_lw_%lat,basis_up_%lat,& basis_lw_,basis_up_,& trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& nmiller=nmiller) diff --git a/src/fortran/mod_lat_compare.f90 b/src/fortran/mod_lat_compare.f90 index d2cdb8d..94c961d 100644 --- a/src/fortran/mod_lat_compare.f90 +++ b/src/fortran/mod_lat_compare.f90 @@ -35,15 +35,14 @@ module lat_compare !!!############################################################################# !!! !!!############################################################################# - function get_best_match(tol,lat1,lat2,bas1,bas2,str1,str2,lprint,ierr,plane1,plane2,nmiller,imatch) result(SAV) + function get_best_match(tol,basis1,basis2,str1,str2,lprint,ierr,plane1,plane2,nmiller,imatch) result(SAV) implicit none integer :: num_miller character(3) :: str1,str2 logical :: lprint type(tol_type) :: tol - type(basis_type) :: bas1,bas2 + type(basis_type) :: basis1,basis2 type(latmatch_type) :: SAV - real(real32), dimension(3,3) :: lat1,lat2 integer, optional :: ierr,imatch,nmiller integer, dimension(3), optional :: plane1,plane2 @@ -61,30 +60,30 @@ function get_best_match(tol,lat1,lat2,bas1,bas2,str1,str2,lprint,ierr,plane1,pla allocate(SAV%tol(tol%nstore,3)) SAV%tol(:,:)=10000 - SAV%lat1=MATNORM(lat1) - SAV%lat2=MATNORM(lat2) - + SAV%lat1=MATNORM(basis1%lat) + SAV%lat2=MATNORM(basis2%lat) + if(match_method.eq.0)then if(present(plane1))then if(present(plane2))then call lattice_matching(& - SAV,tol,bas1,bas2,& + SAV,tol,basis1,basis2,& plane1=plane1,plane2=plane2,nmiller=num_miller,& lprint=lprint) else call lattice_matching(& - SAV,tol,bas1,bas2,& + SAV,tol,basis1,basis2,& plane1=plane1,nmiller=num_miller,& lprint=lprint) end if elseif(present(plane2))then call lattice_matching(& - SAV,tol,bas1,bas2,& + SAV,tol,basis1,basis2,& plane2=plane2,nmiller=num_miller,& lprint=lprint) else call lattice_matching(& - SAV,tol,bas1,bas2,& + SAV,tol,basis1,basis2,& plane2=plane2,nmiller=num_miller,& lprint=lprint) end if @@ -1056,34 +1055,34 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) m2=floor((i2)/2.0)*(-1)**i2 mloop3: do i3=1,loopsize m3=floor((i3)/2.0)*(-1)**i3 - if ( .not.is_unique( (/m1,m2,m3/), grp1%sym(:,:3,:3) ) ) & + if ( .not.is_unique( [ m1, m2, m3 ], grp1%sym(:,:3,:3) ) ) & cycle mloop3 - itmp1=itmp1+1 - ivtmp1(itmp1,:)=(/m1,m2,m3/) + itmp1 = itmp1 + 1 + ivtmp1(itmp1,:) = [ m1, m2, m3 ] !if(itmp1.eq.nmiller) exit mloop1 end do mloop3 end do mloop2 end do mloop1 do i=1,itmp1 - loc=minloc(& - abs(ivtmp1(i:itmp1,1))+& - abs(ivtmp1(i:itmp1,2))+& - abs(ivtmp1(i:itmp1,3)),dim=1)+i-1 - ivtmp2(:)=ivtmp1(i,:) - ivtmp1(i,:)=ivtmp1(loc,:) - ivtmp1(loc,:)=ivtmp2(:) + loc = minloc(& + abs(ivtmp1(i:itmp1,1)) + & + abs(ivtmp1(i:itmp1,2)) + & + abs(ivtmp1(i:itmp1,3)),dim=1) + i - 1 + ivtmp2(:) = ivtmp1(i,:) + ivtmp1(i,:) = ivtmp1(loc,:) + ivtmp1(loc,:) = ivtmp2(:) end do - itmp1=min(itmp1,nmiller) + itmp1 = min(itmp1,nmiller) allocate(miller1(itmp1,3)) - miller1(:,:)=ivtmp1(:itmp1,:) + miller1(:,:) = ivtmp1(:itmp1,:) end if !!-------------------------------------------------------------------------- !! generate all unique planes for lattice 2 !!-------------------------------------------------------------------------- - itmp1=0 - ivtmp1=0 + itmp1 = 0 + ivtmp1 = 0 if(present(plane2))then allocate(miller2(1,size(plane2))) miller2(1,:3)=plane2(:3) @@ -1103,17 +1102,17 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) end do mloop5 end do mloop4 do i=1,itmp1 - loc=minloc(& - abs(ivtmp1(i:itmp1,1))+& - abs(ivtmp1(i:itmp1,2))+& - abs(ivtmp1(i:itmp1,3)),dim=1)+i-1 - ivtmp2(:)=ivtmp1(i,:) - ivtmp1(i,:)=ivtmp1(loc,:) - ivtmp1(loc,:)=ivtmp2(:) + loc = minloc(& + abs(ivtmp1(i:itmp1,1)) + & + abs(ivtmp1(i:itmp1,2)) + & + abs(ivtmp1(i:itmp1,3)),dim=1) + i - 1 + ivtmp2(:) = ivtmp1(i,:) + ivtmp1(i,:) = ivtmp1(loc,:) + ivtmp1(loc,:) = ivtmp2(:) end do - itmp1=min(itmp1,nmiller) + itmp1 = min(itmp1,nmiller) allocate(miller2(itmp1,3)) - miller2(:,:)=ivtmp1(:itmp1,:) + miller2(:,:) = ivtmp1(:itmp1,:) end if if(present(lprint))then if(lprint)then @@ -1138,11 +1137,11 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !! cycles through the unique miller planes to find matches !!-------------------------------------------------------------------------- allocate(tmpsym(max(grp1%nsym,grp2%nsym),3,3)) - MAINLOOP1: do m1=1,size(miller1(:,1),dim=1) + MAINLOOP1: do m1 = 1, size( miller1, dim = 1 ) transform1 = nint(planecutter(lat1,real(miller1(m1,:),real32))) if (all(transform1 .eq. 0)) cycle MAINLOOP1 templat1 = matmul(transform1,lat1) - tmpsym=0._real32 + tmpsym = 0._real32 do i=1,grp1%nsym tmpsym(i,:3,:3) = & matmul(grp1%sym(i,:3,:3),inverse_3x3(real(transform1,real32))) @@ -1155,13 +1154,13 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) tmpsym1=0._real32 !!! IS THIS REASONABLE TO DO IT THIS WAY? OR DO WE NEED TO CHANGE sym TO BE IN THE NEW LAT? !!! Wait, should it be instead that the cross product of the a-b plane is always consistent? - rvec1=real(cross([templat1(1,:)],[templat1(2,:)])) + rvec1=cross([templat1(1,:)],[templat1(2,:)]) do i=1,grp1%nsym - rmat1=real(matmul(tmpsym(i,:3,:3),templat1(:,:))) + rmat1=matmul(tmpsym(i,:3,:3),templat1(:,:)) rvec2=cross([rmat1(1,:)],[rmat1(2,:)]) if(all(abs( rvec1(:) - rvec2(:) ).lt.1.E-8_real32).or.& all(abs( rvec1(:) + rvec2(:) ).lt.1.E-8_real32))then - nsym1=nsym1+1 + nsym1 = nsym1 + 1 tmpsym1(nsym1,:3,:3) = tmpsym(i,:3,:3) else cycle diff --git a/src/fortran/mod_plane_matching.f90 b/src/fortran/mod_plane_matching.f90 index f6e998d..e22580a 100644 --- a/src/fortran/mod_plane_matching.f90 +++ b/src/fortran/mod_plane_matching.f90 @@ -6,7 +6,7 @@ module plane_matching use artemis__constants, only: real32, INF, pi use misc_linalg, only: cross,modu,get_angle,get_area,find_tf,& - reduce_vec_gcd,gcd + reduce_vec_gcd,gcd, inverse_2x2, find_tf_2x2 implicit none !! importance of vector, angle, and area real(real32), dimension(3) :: vaa_weighting=(/1._real32,5._real32,2.5_real32/) @@ -452,7 +452,7 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list !!!------------------------------------------------------------------------ allocate(tf_testlist(nlist,2,2)) do i=1,nlist - tf_testlist(i,:2,:2) = find_tf(& + tf_testlist(i,:2,:2) = find_tf_2x2(& mat_testlist(i,:2,:2),& transpose(mat_testlist(i,:2,3:4))) end do @@ -468,8 +468,8 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list mat1 = matmul(inmat(:2,:2),(sym1(isym,:2,:2))) do jsym=1,size(sym2(:,1,1)) !mat2 = matmul(inmat(:2,3:4),transpose(sym2(jsym,:2,:2))) - mat2 = matmul(inmat(:2,3:4),(sym2(jsym,:2,:2))) - tf = find_tf(mat1,transpose(mat2)) + mat2 = transpose(matmul(inmat(:2,3:4),(sym2(jsym,:2,:2)))) + tf = find_tf_2x2(mat1,mat2) !if(ltest_print)then !!if(any(ISNAN(tf)))then !!if(all(abs(inmat(:2,:2)-test1).lt.tol))then From 5d7081269a3570c01ae6cf5846fe63dd1e978009 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 09:20:27 +0100 Subject: [PATCH 039/137] Fix lattice --- src/fortran/lib/mod_edit_geom.f90 | 19 +++++++++++-------- src/fortran/lib/mod_terminations.f90 | 2 +- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 index 90ef04c..b6bd8e9 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_edit_geom.f90 @@ -641,8 +641,8 @@ subroutine ortho_axis(lat,bas,axis) order = [ 1, 2, 3 ] order = cshift( order, 3 - axis ) - ortho_vec=cross(lat(order(1),:),lat(order(2),:)) - ortho_comp=dot_product(lat(3,:),ortho_vec)/modu(ortho_vec)**2._real32 + ortho_vec=cross( [ lat(order(1),:) ] , [ lat(order(2),:) ] ) + ortho_comp=dot_product([ lat(3,:) ],ortho_vec)/modu(ortho_vec)**2._real32 ortho_vec=ortho_vec*ortho_comp lat(3,:)=ortho_vec @@ -1639,6 +1639,7 @@ function basis_merge(basis1,basis2,length,map1,map2) result(output) end if end do output%natom=sum(output%spec(:)%num) + output%lat = basis1%lat if(lmap) call move_alloc(new_map,map1) @@ -1683,6 +1684,8 @@ function basis_stack(basis1,basis2,axis,offset,length,map1,map2) result(output) !! Offset for the merged basis. integer, allocatable, dimension(:) :: match !! Array to match species. + real(real32), dimension(3,3) :: output_lat + !! Output lattice. !--------------------------------------------------------------------------- @@ -1763,12 +1766,12 @@ function basis_stack(basis1,basis2,axis,offset,length,map1,map2) result(output) !--------------------------------------------------------------------------- ! makes supercell !--------------------------------------------------------------------------- - output%lat(order(1),:) = basis1_%lat(order(1),:) - output%lat(order(2),:) = basis1_%lat(order(2),:) + output_lat(order(1),:) = basis1_%lat(order(1),:) + output_lat(order(2),:) = basis1_%lat(order(2),:) unit_vec = uvec(basis1_%lat(axis,:)) - output%lat(axis,:) = basis1_%lat(axis,:) + modu(basis2_%lat(axis,:)) * unit_vec - c1_ratio = modu(basis1_%lat(axis,:)) / modu(output%lat(axis,:)) - c2_ratio = modu(basis2_%lat(axis,:)) / modu(output%lat(axis,:)) + output_lat(axis,:) = basis1_%lat(axis,:) + modu(basis2_%lat(axis,:)) * unit_vec + c1_ratio = modu(basis1_%lat(axis,:)) / modu(output_lat(axis,:)) + c2_ratio = modu(basis2_%lat(axis,:)) / modu(output_lat(axis,:)) !!!----------------------------------------------------------------------------- @@ -1789,9 +1792,9 @@ function basis_stack(basis1,basis2,axis,offset,length,map1,map2) result(output) else output = basis_merge(basis1_,basis2_) end if + output%lat = output_lat call output%normalise(ceil_val = 1._real32, floor_coords = .true.) - return end function basis_stack !############################################################################### diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 878b365..ca5ad4b 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -276,7 +276,7 @@ function get_termination_info( & write(err_msg,*) "No inversion symmetry found!" call err_abort(err_msg) end if - do i=1,grp_store%nsymop + do i = 1, grp_store%nsym if(all(abs(grp_store%sym(i,:3,:3)-inv_mat).lt.tolerance)) & grp_store%sym(itmp1,4,:3) = grp_store%sym(i,4,:3) end do From 2d008dd18d52f777119c73012c02c93a454ead44 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 13:22:45 +0100 Subject: [PATCH 040/137] Move method integers to type --- src/fortran/lib/mod_misc_types.f90 | 3 + src/fortran/mod_generator.f90 | 144 +++++++++++++++-------------- 2 files changed, 78 insertions(+), 69 deletions(-) diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 0a2c3da..535a3a8 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -39,6 +39,9 @@ module artemis__misc_types type :: abstract_artemis_generator_type integer :: max_num_structures = 100 + + integer :: axis = 3 + !! Axis along which to align the slab/interface normal vector real(real32) :: tol_cart real(real32), dimension(3) :: tol_crys diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_generator.f90 index adb1d18..8254659 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_generator.f90 @@ -36,7 +36,7 @@ module artemis__generator type, extends(abstract_artemis_generator_type) :: artemis_termination_generator_type - + real(real32) :: layer_separation_cutoff = 1._real32 contains @@ -45,13 +45,20 @@ module artemis__generator type, extends(abstract_artemis_generator_type) :: artemis_interface_generator_type + integer :: shift_method = 4 + !! Shift method + integer :: swap_method = 0 + !! Swap method + integer :: num_shifts = 5 + !! Number of shifts per lattice match + integer :: num_swaps = 0 + !! Number of swaps per shifted interface + integer :: match_method = 0 integer :: max_num_matches = 5 integer :: max_num_term = 5 integer :: num_miller_planes = 10 - integer :: num_shifts = 5 - integer :: shift_method = 4 real(real32) :: bondlength_cutoff = 6._real32 real(real32), dimension(2) :: layer_separation_cutoff = 1._real32 @@ -63,6 +70,7 @@ module artemis__generator procedure, pass(this) :: set_tolerance procedure, pass(this) :: generate => generate_interfaces procedure, pass(this) :: restart => generate_intefaces_from_existing + procedure, pass(this) :: generate_perturbations => generate_shifts_and_swaps end type artemis_interface_generator_type contains @@ -189,9 +197,9 @@ subroutine generate_terminations( & ! ... user-defined thickness !--------------------------------------------------------------------------- confine%l = .false. - confine%axis = axis + confine%axis = this%axis confine%laxis = .false. - confine%laxis(axis) = .true. + confine%laxis(this%axis) = .true. if(allocated(trans)) deallocate(trans) allocate(trans(minval(tmp_bas1%spec(:)%num+2),3)) call gldfnd(confine, tmp_bas1, tmp_bas1, trans, ntrans) @@ -201,8 +209,8 @@ subroutine generate_terminations( & if(ntrans.eq.0)then tfmat(3,3)=1._real32 else - itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& - mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(tmp_bas1%lat(axis,:))) + itmp1=minloc(abs(trans(:ntrans,this%axis)),dim=1,& + mask=abs(trans(:ntrans,this%axis)).gt.1.D-3/modu(tmp_bas1%lat(this%axis,:))) tfmat(3,:)=trans(itmp1,:) end if if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 @@ -220,7 +228,7 @@ subroutine generate_terminations( & ! get the terminations term = get_termination_info( & - tmp_bas1, axis, & + tmp_bas1, this%axis, & lprint = .true., layer_sep = this%layer_separation_cutoff, & break_on_fail = lbreak_on_no_term & ) @@ -308,7 +316,7 @@ subroutine generate_intefaces_from_existing(this, basis) min_bond2=huge(0._real32) if(any(udef_intf_loc.lt.0._real32))then if(ludef_axis)then - intf=get_interface(basis%lat,basis,axis) + intf=get_interface(basis%lat,basis,this%axis) else intf=get_interface(basis%lat,basis) end if @@ -321,7 +329,7 @@ subroutine generate_intefaces_from_existing(this, basis) write(10,'(1X,"INTF_LOC = ",2(2X,F9.6))') intf%loc close(10) else - intf%axis = axis + intf%axis = this%axis intf%loc = udef_intf_loc end if specloop1: do is=1,basis%nspec @@ -359,9 +367,10 @@ subroutine generate_intefaces_from_existing(this, basis) min_bond = ( min_bond1 + min_bond2 )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond write(6,'(1X,"Trans-interfacial scaling factor:",F0.3)') c_scale - call gen_shifts_and_swaps(basis,intf%axis,intf%loc,min_bond,& - ishift,nshift,& - iswap,swap_den,nswap) + this%axis = intf%axis + call this%generate_perturbations(basis,intf%loc,min_bond,& + nshift,& + swap_den,nswap) end subroutine generate_intefaces_from_existing @@ -471,15 +480,15 @@ subroutine generate_interfaces(this, basis_lw, basis_up) ( get_min_bulk_bond(basis_lw_) + get_min_bulk_bond(basis_up_) )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond write(6,'(1X,"Trans-interfacial scaling factor: ",F0.3)') c_scale - if(ishift.eq.-1) nshift=1 + if(this%shift_method.eq.-1) nshift=1 !!!----------------------------------------------------------------------------- -!!! gets bulk DONs, if ISHIFT = 4 +!!! gets bulk DONs, if shift_method = 4 !!!----------------------------------------------------------------------------- allocate(lw_map(basis_lw_%nspec,maxval(basis_lw_%spec(:)%num,dim=1),2)) allocate(up_map(basis_up_%nspec,maxval(basis_up_%spec(:)%num,dim=1),2)) - if(ishift.eq.4.or.ishift.eq.0)then + if(this%shift_method.eq.4.or.this%shift_method.eq.0)then lw_map=0 bulk_DON(1)%spec=gen_DON(basis_lw_%lat,basis_lw_,& dist_max=max_bondlength,& @@ -711,7 +720,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Determines the cell change for the upper lattice to get the new DON !!----------------------------------------------------------------------- - if(ishift.eq.4)then + if(this%shift_method.eq.4)then !! Issue with using this method when large deformations result in large !! angle changes. REMOVING IT FOR NOW AND RETURNING TO CALCULATING DONS !! FOR THE SUPERCELL. @@ -748,9 +757,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! SHOULD MAKE IT LATER MAKE DIFFERENT SETS OF THICKNESSES !!----------------------------------------------------------------------- confine%l=.false. - confine%axis=axis + confine%axis=this%axis confine%laxis=.false. - confine%laxis(axis)=.true. + confine%laxis(this%axis)=.true. if(allocated(trans)) deallocate(trans) allocate(trans(minval(supercell_lw%spec(:)%num+2),3)) call gldfnd(confine,supercell_lw,supercell_lw,trans,ntrans) @@ -760,8 +769,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) if(ntrans.eq.0)then tfmat(3,3)=1._real32 else - itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& - mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(supercell_lw%lat(axis,:))) + itmp1=minloc(abs(trans(:ntrans,this%axis)),dim=1,& + mask=abs(trans(:ntrans,this%axis)).gt.1.D-3/modu(supercell_lw%lat(this%axis,:))) tfmat(3,:)=trans(itmp1,:) end if if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 @@ -783,7 +792,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- if(allocated(lw_term%arr)) deallocate(lw_term%arr) lw_term = get_termination_info( & - supercell_lw, axis, & + supercell_lw, this%axis, & lprint = lprint_terms, layer_sep = lw_layer_sep, & break_on_fail = lbreak_on_no_term & ) @@ -807,7 +816,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Sort out ladder rungs (checks whether the material is centrosymmetric) !!----------------------------------------------------------------------- - !call setup_ladder(supercell_lw%lat,supercell_lw,axis,lw_term) + !call setup_ladder(supercell_lw%lat,supercell_lw,this%axis,lw_term) if(sum(lw_term%arr(:)%natom)*lw_term%nstep.ne.supercell_lw%natom)then write(msg, '("ERROR: Number of atoms in lower layers not correct: "& &I0,2X,I0)') sum(lw_term%arr(:)%natom)*lw_term%nstep,supercell_lw%natom @@ -840,8 +849,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) if(ntrans.eq.0)then tfmat(3,3)=1._real32 else - itmp1=minloc(abs(trans(:ntrans,axis)),dim=1,& - mask=abs(trans(:ntrans,axis)).gt.1.D-3/modu(supercell_lw%lat(axis,:))) + itmp1=minloc(abs(trans(:ntrans,this%axis)),dim=1,& + mask=abs(trans(:ntrans,this%axis)).gt.1.D-3/modu(supercell_lw%lat(this%axis,:))) tfmat(3,:)=trans(itmp1,:) end if if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 @@ -864,7 +873,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- if(allocated(up_term%arr)) deallocate(up_term%arr) up_term = get_termination_info( & - supercell_up, axis, & + supercell_up, this%axis, & lprint = lprint_terms, layer_sep = up_layer_sep, & break_on_fail = lbreak_on_no_term & ) @@ -888,7 +897,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Sort out ladder rungs (checks whether the material is centrosymmetric) !!----------------------------------------------------------------------- - !call setup_ladder(supercell_up%lat,supercell_up,axis,up_term) + !call setup_ladder(supercell_up%lat,supercell_up,this%axis,up_term) if(sum(up_term%arr(:)%natom)*up_term%nstep.ne.supercell_up%natom)then write(msg, '("ERROR: Number of atoms in upper layers not correct: "& &I0,2X,I0)') sum(up_term%arr(:)%natom)*up_term%nstep,supercell_up%natom @@ -986,13 +995,13 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- interface = basis_stack(& basis1 = slab_lw, basis2 = slab_up, & - axis = axis, offset = init_offset(:), & + axis = this%axis, offset = init_offset(:), & map1 = t2lw_map, map2 = t2up_map & ) - intf_loc(1) = ( modu(slab_lw%lat(axis,:)) + 0.5_real32*init_offset(axis) - & - tmp_vac)/modu(interface%lat(axis,:)) - intf_loc(2) = ( modu(slab_lw%lat(axis,:)) + modu(slab_up%lat(axis,:)) + & - 1.5_real32*init_offset(axis) - 2._real32*tmp_vac )/modu(interface%lat(axis,:)) + intf_loc(1) = ( modu(slab_lw%lat(this%axis,:)) + 0.5_real32*init_offset(this%axis) - & + tmp_vac)/modu(interface%lat(this%axis,:)) + intf_loc(2) = ( modu(slab_lw%lat(this%axis,:)) + modu(slab_up%lat(this%axis,:)) + & + 1.5_real32*init_offset(this%axis) - 2._real32*tmp_vac )/modu(interface%lat(this%axis,:)) if(ierror.ge.1)then write(0,*) "interface:",intf_loc if(ierror.eq.1.and.iunique.eq.icheck_intf-1)then @@ -1016,7 +1025,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- if(intf.gt.old_intf)then iunique=iunique+1 - if(ishift.gt.0.and.nshift.gt.1) & + if(this%shift_method.gt.0.and.nshift.gt.1) & write(6,'(1X,"Generating shifts for unique interface ",& &I0,":")') iunique write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique @@ -1038,9 +1047,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- !! Generates shifts and swaps and prints the subsequent structures !!----------------------------------------------------------------- - call gen_shifts_and_swaps(interface,axis,intf_loc,avg_min_bond,& - ishift,nshift,& - iswap,swap_den,nswap,t2lw_map) + call this%generate_perturbations(interface,intf_loc,avg_min_bond,& + nshift,& + swap_den,nswap,t2lw_map) if(intf.ge.nintf) exit intf_loop !call chdir(dirname) @@ -1070,13 +1079,14 @@ end subroutine generate_interfaces !!! Prints these new structures to POSCARs. !!!############################################################################# !!! ISWAP METHOD NOT YET SET UP - subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& - ishift,nshift,& - iswap,swap_den,nswap,& + subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& + nshift,& + swap_den,nswap,& map) implicit none + class(artemis_interface_generator_type), intent(inout) :: this type(basis_type), intent(in) :: basis - integer :: shift_unit=10 + integer :: shift_unit integer :: ounit,iaxis,k,l integer :: ngen_swaps,nswaps_per_cell real(real32) :: dtmp1 @@ -1086,13 +1096,10 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& integer, dimension(3) :: abc real(real32), dimension(2) :: intf_loc real(real32), dimension(3) :: toffset - real(real32), dimension(3,3) :: tlat type(basis_type), allocatable, dimension(:) :: bas_arr real(real32), allocatable, dimension(:,:) :: output_shifts - integer, intent(in) :: axis integer, intent(in) :: nshift,nswap - integer, intent(in) :: ishift,iswap real(real32), intent(in) :: bond,swap_den integer, dimension(:,:,:), optional, intent(in) :: map @@ -1102,19 +1109,19 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& !!! Sets up shift axis !!!----------------------------------------------------------------------------- abc = [ 1, 2, 3 ] - abc = cshift(abc,axis) + abc = cshift(abc,this%axis) !!!----------------------------------------------------------------------------- !!! Sets up and moves to appropriate directories !!!----------------------------------------------------------------------------- call getcwd(pwd1) - if(ishift.gt.0.or.nshift.gt.1)then + if(this%shift_method.gt.0.or.nshift.gt.1)then call system('mkdir -p '//trim(adjustl(shiftdir))) call chdir(shiftdir) end if call getcwd(pwd2) - open(unit=shift_unit,file="shift_vals.txt") + open(newunit=shift_unit,file="shift_vals.txt") write(shift_unit,& '("# interface_num shift (a,b,c) units=(direct,direct,Å)")') @@ -1122,8 +1129,8 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& !!!----------------------------------------------------------------------------- !!! Generates sets of shifts based on shift version !!!----------------------------------------------------------------------------- - if(ishift.eq.0.or.ishift.eq.1) allocate(output_shifts(nshift,3)) - select case(ishift) + if(this%shift_method.eq.0.or.this%shift_method.eq.1) allocate(output_shifts(nshift,3)) + select case(this%shift_method) case(1) output_shifts(1,:3)=0._real32 do k=2,nshift @@ -1135,7 +1142,7 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& output_shifts = get_fit_shifts(& lat=basis%lat,bas=basis,& bond=bond,& - axis=axis,& + axis=this%axis,& intf_loc=intf_loc,& depth=intf_depth,& nstore=nshift) @@ -1143,7 +1150,7 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& output_shifts = get_descriptive_shifts(& lat=basis%lat,bas=basis,& bond=bond,& - axis=axis,& + axis=this%axis,& intf_loc=intf_loc,& depth=intf_depth,c_scale=c_scale,& nstore=nshift,lprint=lprint_shifts) @@ -1151,7 +1158,7 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& if(present(map))then output_shifts = get_shifts_DON(& lat=basis%lat,bas=basis,& - axis=axis,& + axis=this%axis,& intf_loc=intf_loc,& nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& lprint=lprint_shifts,bulk_DON=bulk_DON,bulk_map=map,& @@ -1159,7 +1166,7 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& else output_shifts = get_shifts_DON(& lat=basis%lat,bas=basis,& - axis=axis,& + axis=this%axis,& intf_loc=intf_loc,& nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& lprint=lprint_shifts,& @@ -1172,15 +1179,14 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& return end if case default - ! nshift=1 !!! SORT THIS OUT !!! RESET NSHIFT DUE TO ISHIFT if(.not.allocated(output_shifts)) allocate(output_shifts(1,3)) output_shifts(:,:) = offset - do iaxis=1,2 + do iaxis = 1, 2 output_shifts(1,iaxis) = output_shifts(1,iaxis)!/modu(lat(iaxis,:)) end do end select - if(ishift.gt.0)then - output_shifts(:,axis) = output_shifts(:,axis)*modu(basis%lat(axis,:)) + if(this%shift_method.gt.0)then + output_shifts(:,this%axis) = output_shifts(:,this%axis)*modu(basis%lat(this%axis,:)) end if @@ -1194,7 +1200,7 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& !!! Determines number of swaps across the interface !!!----------------------------------------------------------------------------- nswaps_per_cell=nint(swap_den*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) - if(iswap.ne.0)then + if(this%swap_method.ne.0)then write(6,& '(" Generating ",I0," swaps per structure ")') nswaps_per_cell end if @@ -1207,20 +1213,20 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& call tbas%copy(basis) toffset=output_shifts(k,:3) do iaxis=1,2 - call shift_region(tbas,axis,& + call shift_region(tbas,this%axis,& intf_loc(1),intf_loc(2),& shift_axis=iaxis,shift=toffset(iaxis),renorm=.true.) end do - dtmp1=modu(tlat(axis,:)) + dtmp1=modu(tbas%lat(this%axis,:)) call set_vacuum(& basis=tbas,& - axis=axis,loc=maxval(intf_loc(:)),& - vac=toffset(axis)) - dtmp1=minval(intf_loc(:))*dtmp1/modu(tlat(axis,:)) + axis=this%axis,loc=maxval(intf_loc(:)),& + vac=toffset(this%axis)) + dtmp1=minval(intf_loc(:))*dtmp1/modu(tbas%lat(this%axis,:)) call set_vacuum(& basis=tbas,& - axis=axis,loc=dtmp1,& - vac=toffset(axis)) + axis=this%axis,loc=dtmp1,& + vac=toffset(this%axis)) min_bond = get_shortest_bond(tbas) if(min_bond%length.le.1.5_real32)then write(msg,'("Smallest bond in the interface structure is\nless than 1.5 Å.")') @@ -1244,7 +1250,7 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& !!----------------------------------------------------------------------- intf=intf+1 ounit=100+intf - if(ishift.gt.0.or.nshift.gt.1)then + if(this%shift_method.gt.0.or.nshift.gt.1)then write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),k call system('mkdir -p '//trim(adjustl(dirpath))) write(filename,'(A,"/",A)') trim(adjustl(dirpath)),trim(out_filename) @@ -1261,9 +1267,9 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& !!----------------------------------------------------------------------- !! Performs swaps within the shifted structures if requested !!----------------------------------------------------------------------- - if_swap: if(iswap.ne.0)then - bas_arr = rand_swapper(tlat,tbas,axis,swap_depth,& - nswaps_per_cell,nswap,intf_loc,iswap,seed,sigma=swap_sigma,& + if_swap: if(this%swap_method.ne.0)then + bas_arr = rand_swapper(tbas%lat,tbas,this%axis,swap_depth,& + nswaps_per_cell,nswap,intf_loc,this%swap_method,seed,sigma=swap_sigma,& require_mirror=lswap_mirror) ngen_swaps = nswap LOOPswaps: do l=1,nswap @@ -1300,7 +1306,7 @@ subroutine gen_shifts_and_swaps(basis,axis,intf_loc,bond,& close(unit=shift_unit) - end subroutine gen_shifts_and_swaps + end subroutine generate_shifts_and_swaps !!!############################################################################# From fec2d332b87c0d9b3cb0941aac2b9cfbe541c1c4 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 14:04:46 +0100 Subject: [PATCH 041/137] Split generator module --- src/fortran/artemis.f90 | 3 +- src/fortran/lib/mod_misc_types.f90 | 3 + ...d_generator.f90 => mod_intf_generator.f90} | 183 +------------- src/fortran/mod_term_generator.f90 | 232 ++++++++++++++++++ 4 files changed, 242 insertions(+), 179 deletions(-) rename src/fortran/{mod_generator.f90 => mod_intf_generator.f90} (88%) create mode 100644 src/fortran/mod_term_generator.f90 diff --git a/src/fortran/artemis.f90 b/src/fortran/artemis.f90 index 3cc8d6f..5c2ae81 100644 --- a/src/fortran/artemis.f90 +++ b/src/fortran/artemis.f90 @@ -1,6 +1,7 @@ module artemis use inputs - use artemis__generator + use artemis__termination_generator + use artemis__interface_generator implicit none diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 535a3a8..e55a9f0 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -43,6 +43,9 @@ module artemis__misc_types integer :: axis = 3 !! Axis along which to align the slab/interface normal vector + real(real32) :: vacuum_gap = 14._real32 + !! Vacuum thickness in Å + real(real32) :: tol_cart real(real32), dimension(3) :: tol_crys diff --git a/src/fortran/mod_generator.f90 b/src/fortran/mod_intf_generator.f90 similarity index 88% rename from src/fortran/mod_generator.f90 rename to src/fortran/mod_intf_generator.f90 index 8254659..e61d97b 100644 --- a/src/fortran/mod_generator.f90 +++ b/src/fortran/mod_intf_generator.f90 @@ -4,7 +4,7 @@ !!! Code part of the ARTEMIS group (Hepplestone research group). !!! Think Hepplestone, think HRG. !!!############################################################################# -module artemis__generator +module artemis__interface_generator use artemis__constants, only: real32, ierror, pi use artemis__misc, only: to_lower,to_upper use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type @@ -27,23 +27,12 @@ module artemis__generator use shifting !!! CHANGE TO SHIFTER? implicit none integer, private :: intf=0 - real(real32), private, parameter :: tmp_vac = 14._real32 type(bulk_DON_type), dimension(2) :: bulk_DON - - type, extends(abstract_artemis_generator_type) :: artemis_termination_generator_type - - real(real32) :: layer_separation_cutoff = 1._real32 - - contains - procedure, pass(this) :: generate => generate_terminations - end type artemis_termination_generator_type - - type, extends(abstract_artemis_generator_type) :: artemis_interface_generator_type integer :: shift_method = 4 !! Shift method @@ -129,167 +118,6 @@ end subroutine set_tolerance !############################################################################### -!############################################################################### - subroutine generate_terminations( & - this, basis, miller_plane, axis, num_layers, thickness & - ) - !! Generate and prints terminations parallel to the supplied miller plane - implicit none - - ! Arguments - class(artemis_termination_generator_type), intent(inout) :: this - !! Instance of artemis generator type - type(basis_type), intent(in) :: basis - !! Atomic structure data - integer, dimension(3), intent(in) :: miller_plane - !! Miller plane - integer, intent(in) :: axis - !! Axis along which to align the slab - integer, intent(in), optional :: num_layers - !! Number of layers in the slab - real(real32), intent(in), optional :: thickness - !! Thickness of the slab (in Å) - - type(basis_type), dimension(:), allocatable :: output - !! Output structures - - ! Local variables - integer :: itmp1, iterm, term_start, term_end, iterm_step, i - !! Termination loop variables - integer :: ncells, ntrans - !! Number of cells in the slab - integer :: num_structures - !! Number of structures to be generated - integer :: num_layers_ - !! Number of layers in the slab - real(real32) :: height - !! Height of the slab - logical :: lcycle - !! Boolean whether to cycle through the slab - type(basis_type) :: tmp_bas1,tmp_bas2 - !! Temporary basis structures - type(confine_type) :: confine - !! Confine structure along the specified axis - type(term_arr_type) :: term - !! List of terminations - real(real32), dimension(3,3) :: tfmat - !! Transformation matrix - - character(len=256) :: warn_msg - - integer, allocatable, dimension(:,:,:) :: bas_map,t1bas_map - real(real32), allocatable, dimension(:,:) :: trans - - - !! copy lattice and basis for manipulating - call tmp_bas1%copy(basis) - allocate(bas_map(tmp_bas1%nspec,maxval(tmp_bas1%spec(:)%num,dim=1),2)) - bas_map = -1 - - - write(6,'(1X,"Using supplied plane...")') - tfmat = planecutter(tmp_bas1%lat,real(miller_plane,real32)) - call transformer(tmp_bas1,tfmat,bas_map) - !call err_abort_print_struc(bas,"check.vasp","stop") - - !--------------------------------------------------------------------------- - ! Finds smallest thickness of the slab and increases to ... - ! ... user-defined thickness - !--------------------------------------------------------------------------- - confine%l = .false. - confine%axis = this%axis - confine%laxis = .false. - confine%laxis(this%axis) = .true. - if(allocated(trans)) deallocate(trans) - allocate(trans(minval(tmp_bas1%spec(:)%num+2),3)) - call gldfnd(confine, tmp_bas1, tmp_bas1, trans, ntrans) - tfmat(:,:) = 0._real32 - tfmat(1,1) = 1._real32 - tfmat(2,2) = 1._real32 - if(ntrans.eq.0)then - tfmat(3,3)=1._real32 - else - itmp1=minloc(abs(trans(:ntrans,this%axis)),dim=1,& - mask=abs(trans(:ntrans,this%axis)).gt.1.D-3/modu(tmp_bas1%lat(this%axis,:))) - tfmat(3,:)=trans(itmp1,:) - end if - if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 - call transformer(tmp_bas1,tfmat,bas_map) - if(.not.compare_stoichiometry(tmp_bas1,basis))then - write(0,'(1X,"ERROR: Internal error in generate_terminations")') - write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the material")') - if(ierror.eq.1)then - call err_abort_print_struc(tmp_bas1, "broken_primitive.vasp", & - "Code exiting due to IPRINT = 1") - end if - write(0,'(2X,"Skipping this lattice match")') - return - end if - - ! get the terminations - term = get_termination_info( & - tmp_bas1, this%axis, & - lprint = .true., layer_sep = this%layer_separation_cutoff, & - break_on_fail = lbreak_on_no_term & - ) - if(term%nterm .eq. 0)then - write(warn_msg, '(A,I0,1X,I0,1X,I0,A)') & - "No terminations found for Miller plane (",miller_plane,")" - call print_warning(trim(warn_msg)) - return - end if - - ! set thickness if provided by user - if(present(num_layers))then - num_layers_ = num_layers - else - num_layers_ = 1 - end if - - ! determine tolerance for layer separations (termination tolerance) - ! ... this is different from layer_sep - call set_layer_tol(term) - - ! determine required extension and perform that - call set_slab_height(tmp_bas1,bas_map,term,lw_surf,& - height,num_layers_, thickness, ncells,& - term_start,term_end,iterm_step & - ) - - !--------------------------------------------------------------------------- - ! Normalise lattice - !--------------------------------------------------------------------------- - if(lnorm_lat)then - call reducer(tmp_bas1) - tmp_bas1%lat = MATNORM(tmp_bas1%lat) - end if - - - !--------------------------------------------------------------------------- - ! loop over terminations and write them - !--------------------------------------------------------------------------- - num_structures = ( term_end - term_start ) / iterm_step + 1 - allocate(output(num_structures)) - do iterm = term_start, term_end, iterm_step - i = ( iterm - term_start ) / iterm_step + 1 - call output(i)%copy(tmp_bas1) - if(allocated(t1bas_map)) deallocate(t1bas_map) - allocate(t1bas_map,source=bas_map) - call build_slab(output(i),bas_map,term,[iterm,lw_surf(2)],& - thickness, ncells, num_layers_, height,& - "lw",lcycle,lortho,vacuum & - ) - end do - if(.not.allocated(this%structures))then - call move_alloc(output,this%structures) - else - this%structures = [ this%structures, output ] - end if - - end subroutine generate_terminations -!############################################################################### - - !############################################################################### subroutine generate_intefaces_from_existing(this, basis) !! Generate interfaces for the given basis @@ -934,7 +762,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! Shifts lower material to specified termination !!-------------------------------------------------------------------- call build_slab(slab_lw,t2lw_map,lw_term,[iterm_lw,lw_surf(2)],& - lw_thickness, ncells_lw, lw_num_layers, height_lw,& + lw_thickness, ncells_lw, lw_num_layers, height_lw,& "lw",lcycle) if(lcycle) cycle lw_term_loop @@ -999,9 +827,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) map1 = t2lw_map, map2 = t2up_map & ) intf_loc(1) = ( modu(slab_lw%lat(this%axis,:)) + 0.5_real32*init_offset(this%axis) - & - tmp_vac)/modu(interface%lat(this%axis,:)) + this%vacuum_gap)/modu(interface%lat(this%axis,:)) intf_loc(2) = ( modu(slab_lw%lat(this%axis,:)) + modu(slab_up%lat(this%axis,:)) + & - 1.5_real32*init_offset(this%axis) - 2._real32*tmp_vac )/modu(interface%lat(this%axis,:)) + 1.5_real32*init_offset(this%axis) - 2._real32*this%vacuum_gap )/modu(interface%lat(this%axis,:)) if(ierror.ge.1)then write(0,*) "interface:",intf_loc if(ierror.eq.1.and.iunique.eq.icheck_intf-1)then @@ -1357,5 +1185,4 @@ subroutine output_intf_data(SAV, ifit, lw_term, term_lw_idx, up_term, term_up_id end subroutine output_intf_data !!!############################################################################# - -end module artemis__generator +end module artemis__interface_generator diff --git a/src/fortran/mod_term_generator.f90 b/src/fortran/mod_term_generator.f90 new file mode 100644 index 0000000..99cf6f8 --- /dev/null +++ b/src/fortran/mod_term_generator.f90 @@ -0,0 +1,232 @@ +!!!############################################################################# +!!! INTERFACES CARD SUBROUTINES +!!! Code written by Ned Thaddeus Taylor and Isiah Edward Mikel Rudkin +!!! Code part of the ARTEMIS group (Hepplestone research group). +!!! Think Hepplestone, think HRG. +!!!############################################################################# +module artemis__termination_generator + use artemis__constants, only: real32, ierror + use artemis__misc_types, only: abstract_artemis_generator_type + use artemis__geom_rw, only: basis_type + use artemis__io_utils, only: err_abort, print_warning + use artemis__io_utils_extd, only: err_abort_print_struc + use misc_linalg, only: modu + use edit_geom, only: planecutter, transformer, reducer, & + MATNORM, compare_stoichiometry + use artemis__sym, only: confine_type, gldfnd + use artemis__terminations, only: get_termination_info, term_arr_type, set_slab_height, set_layer_tol, build_slab + implicit none + + + type, extends(abstract_artemis_generator_type) :: artemis_termination_generator_type + + real(real32) :: layer_separation_cutoff = 1._real32 + + contains + procedure, pass(this) :: generate => generate_terminations + end type artemis_termination_generator_type + + + +contains + +!############################################################################### + subroutine generate_terminations( & + this, basis, miller_plane, axis, surface, num_layers, thickness, & + orthogonalise, normalise, break_on_fail & + ) + !! Generate and prints terminations parallel to the supplied miller plane + implicit none + + ! Arguments + class(artemis_termination_generator_type), intent(inout) :: this + !! Instance of artemis generator type + type(basis_type), intent(in) :: basis + !! Atomic structure data + integer, dimension(3), intent(in) :: miller_plane + !! Miller plane + integer, intent(in) :: axis + !! Axis along which to align the slab + integer, dimension(:), intent(in), optional :: surface + !! Surface termination indices + integer, intent(in), optional :: num_layers + !! Number of layers in the slab + real(real32), intent(in), optional :: thickness + !! Thickness of the slab (in Å) + logical, intent(in), optional :: orthogonalise + !! Boolean whether to orthogonalise the lattice + logical, intent(in), optional :: normalise + !! Boolean whether to normalise the lattice and basis + logical, intent(in), optional :: break_on_fail + !! Boolean whether to break on failure + + type(basis_type), dimension(:), allocatable :: output + !! Output structures + + ! Local variables + integer :: itmp1, iterm, term_start, term_end, iterm_step, i + !! Termination loop variables + integer :: ncells, ntrans + !! Number of cells in the slab + integer :: num_structures + !! Number of structures to be generated + integer, dimension(2) :: surface_ + !! Surface termination indices + integer :: num_layers_ + !! Number of layers in the slab + real(real32) :: height + !! Height of the slab + logical :: lcycle + !! Boolean whether to cycle through the slab + type(basis_type) :: tmp_bas1,tmp_bas2 + !! Temporary basis structures + type(confine_type) :: confine + !! Confine structure along the specified axis + type(term_arr_type) :: term + !! List of terminations + real(real32), dimension(3,3) :: tfmat + !! Transformation matrix + logical :: orthogonalise_ + !! Boolean whether to orthogonalise the lattice + logical :: normalise_ + !! Boolean whether to normalise the lattice + logical :: break_on_fail_ + !! Boolean whether to break on failure + + + character(len=256) :: warn_msg + + integer, allocatable, dimension(:,:,:) :: bas_map,t1bas_map + real(real32), allocatable, dimension(:,:) :: trans + + + orthogonalise_ = .true. + if(present(orthogonalise)) orthogonalise_ = orthogonalise + break_on_fail_ = .true. + if(present(break_on_fail)) break_on_fail_ = break_on_fail + normalise_ = .true. + if(present(normalise)) normalise_ = normalise + surface_ = 0 + if(present(surface))then + select case(size(surface,dim=1)) + case(1) + surface_(:) = surface(1) + case(2) + surface_ = surface + case default + write(0,'(1X,"ERROR: Internal error in generate_terminations")') + write(0,'(2X,"The surface termination indices are not of the correct size")') + return + end select + end if + + !! copy lattice and basis for manipulating + call tmp_bas1%copy(basis) + allocate(bas_map(tmp_bas1%nspec,maxval(tmp_bas1%spec(:)%num,dim=1),2)) + bas_map = -1 + + + write(6,'(1X,"Using supplied plane...")') + tfmat = planecutter(tmp_bas1%lat,real(miller_plane,real32)) + call transformer(tmp_bas1,tfmat,bas_map) + !call err_abort_print_struc(bas,"check.vasp","stop") + + + !--------------------------------------------------------------------------- + ! Finds smallest thickness of the slab and increases to ... + ! ... user-defined thickness + !--------------------------------------------------------------------------- + confine%l = .false. + confine%axis = this%axis + confine%laxis = .false. + confine%laxis(this%axis) = .true. + if(allocated(trans)) deallocate(trans) + allocate(trans(minval(tmp_bas1%spec(:)%num+2),3)) + call gldfnd(confine, tmp_bas1, tmp_bas1, trans, ntrans) + tfmat(:,:) = 0._real32 + tfmat(1,1) = 1._real32 + tfmat(2,2) = 1._real32 + if(ntrans.eq.0)then + tfmat(3,3)=1._real32 + else + itmp1=minloc(abs(trans(:ntrans,this%axis)),dim=1,& + mask=abs(trans(:ntrans,this%axis)).gt.1.D-3/modu(tmp_bas1%lat(this%axis,:))) + tfmat(3,:)=trans(itmp1,:) + end if + if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 + call transformer(tmp_bas1,tfmat,bas_map) + if(.not.compare_stoichiometry(tmp_bas1,basis))then + write(0,'(1X,"ERROR: Internal error in generate_terminations")') + write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the material")') + if(ierror.eq.1)then + call err_abort_print_struc(tmp_bas1, "broken_primitive.vasp", & + "Code exiting due to IPRINT = 1") + end if + write(0,'(2X,"Skipping this lattice match")') + return + end if + + ! get the terminations + term = get_termination_info( & + tmp_bas1, this%axis, & + lprint = .true., layer_sep = this%layer_separation_cutoff, & + break_on_fail = break_on_fail_ & + ) + if(term%nterm .eq. 0)then + write(warn_msg, '(A,I0,1X,I0,1X,I0,A)') & + "No terminations found for Miller plane (",miller_plane,")" + call print_warning(trim(warn_msg)) + return + end if + + ! set thickness if provided by user + if(present(num_layers))then + num_layers_ = num_layers + else + num_layers_ = 1 + end if + + ! determine tolerance for layer separations (termination tolerance) + ! ... this is different from layer_sep + call set_layer_tol(term) + + ! determine required extension and perform that + call set_slab_height(tmp_bas1,bas_map,term,surface_,& + height,num_layers_, thickness, ncells,& + term_start,term_end,iterm_step & + ) + + !--------------------------------------------------------------------------- + ! Normalise lattice + !--------------------------------------------------------------------------- + if(normalise_)then + call reducer(tmp_bas1) + tmp_bas1%lat = MATNORM(tmp_bas1%lat) + end if + + + !--------------------------------------------------------------------------- + ! loop over terminations and write them + !--------------------------------------------------------------------------- + num_structures = ( term_end - term_start ) / iterm_step + 1 + allocate(output(num_structures)) + do iterm = term_start, term_end, iterm_step + i = ( iterm - term_start ) / iterm_step + 1 + call output(i)%copy(tmp_bas1) + if(allocated(t1bas_map)) deallocate(t1bas_map) + allocate(t1bas_map,source=bas_map) + call build_slab(output(i),bas_map,term,[iterm,surface_(2)],& + thickness, ncells, num_layers_, height,& + "lw", lcycle, orthogonalise_, this%vacuum_gap & + ) + end do + if(.not.allocated(this%structures))then + call move_alloc(output,this%structures) + else + this%structures = [ this%structures, output ] + end if + + end subroutine generate_terminations +!############################################################################### + +end module artemis__termination_generator From 236f81b8ce1c5562579ac6171dc62991e6c7103e Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 15:22:07 +0100 Subject: [PATCH 042/137] Fix shift handling --- src/fortran/lib/mod_edit_geom.f90 | 9 ++++---- src/fortran/lib/mod_rw_geom.f90 | 30 +++++++++++++++------------ src/fortran/lib/mod_terminations.f90 | 10 +++------ src/fortran/mod_intf_generator.f90 | 13 ++++++++---- src/fortran/mod_shifting.f90 | 31 ++++++++++++++-------------- 5 files changed, 49 insertions(+), 44 deletions(-) diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_edit_geom.f90 index b6bd8e9..47ae565 100644 --- a/src/fortran/lib/mod_edit_geom.f90 +++ b/src/fortran/lib/mod_edit_geom.f90 @@ -627,26 +627,26 @@ end subroutine set_vacuum !!! Takes a lattice and makes the defined axis orthogonal to the other two !!! WARNING! THIS IS FOR SLAB STRUCTURES! IT REMOVES PERIODICITY ALONG THAT AXIS !!!############################################################################# - subroutine ortho_axis(lat,bas,axis) + subroutine ortho_axis(basis,axis) implicit none + type(basis_type), intent(inout) :: basis integer :: axis real(real32) :: ortho_comp - type(basis_type) :: bas integer, dimension(3) :: order real(real32), dimension(3) :: ortho_vec real(real32), dimension(3,3) :: lat - call bas%convert() order = [ 1, 2, 3 ] order = cshift( order, 3 - axis ) + lat = basis%lat ortho_vec=cross( [ lat(order(1),:) ] , [ lat(order(2),:) ] ) ortho_comp=dot_product([ lat(3,:) ],ortho_vec)/modu(ortho_vec)**2._real32 ortho_vec=ortho_vec*ortho_comp lat(3,:)=ortho_vec - call bas%change_lattice(lat) + call basis%change_lattice(lat) return end subroutine ortho_axis @@ -1889,6 +1889,7 @@ function split_bas(inbas,loc_vec,axis,lall_same_nspec,map1,map2) result(bas_arr) tbas%nspec=count(bas_arr(i)%spec(:)%num.gt.0) tbas%natom=bas_arr(i)%natom tbas%sysname=bas_arr(i)%sysname + tbas%lat = inbas%lat allocate(tbas%spec(tbas%nspec)) if(lmap.and.i.eq.1)then diff --git a/src/fortran/lib/mod_rw_geom.f90 b/src/fortran/lib/mod_rw_geom.f90 index cb9ee04..e5755fa 100644 --- a/src/fortran/lib/mod_rw_geom.f90 +++ b/src/fortran/lib/mod_rw_geom.f90 @@ -420,7 +420,7 @@ end subroutine VASP_geom_read !############################################################################### - subroutine VASP_geom_write(UNIT, basis, cartesian) + subroutine VASP_geom_write(UNIT, basis) !! Write the structure in vasp poscar style format. implicit none @@ -429,8 +429,6 @@ subroutine VASP_geom_write(UNIT, basis, cartesian) !! The unit number of the file to write to. class(basis_type), intent(in) :: basis !! The basis to write the geometry from. - logical, intent(in), optional :: cartesian - !! Optional. Whether to write the basis in cartesian coordinates. ! Local variables integer :: i,j @@ -441,9 +439,10 @@ subroutine VASP_geom_write(UNIT, basis, cartesian) !! String to determine whether to write in direct or cartesian coordinates. - string="Direct" - if(present(cartesian))then - if(cartesian) string="Cartesian" + if(basis%lcart)then + string = "Cartesian" + else + string="Direct" end if write(UNIT,'(A)') trim(adjustl(basis%sysname)) @@ -1255,16 +1254,21 @@ subroutine change_lattice(this, lattice) !! Loop index. real(real32), dimension(3,3) :: transform !! The transformation matrix. + logical :: lcart + !! Logical variable to determine whether the basis is in cartesian coordinates. transform = matmul(inverse_3x3(lattice),this%lat) - if(.not.this%lcart) call this%convert() - do is = 1, this%nspec - do ia = 1, this%spec(is)%num - this%spec(is)%atom(ia,1:3) = & - matmul(transform, this%spec(is)%atom(ia,1:3)) - end do - end do + lcart = this%lcart + if(.not.lcart) call this%convert() + ! do is = 1, this%nspec + ! do ia = 1, this%spec(is)%num + ! this%spec(is)%atom(ia,1:3) = & + ! matmul(transform, this%spec(is)%atom(ia,1:3)) + ! end do + ! end do + this%lat = lattice + if(.not.lcart) call this%convert() end subroutine change_lattice !############################################################################### diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index ca5ad4b..220aa45 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -835,7 +835,7 @@ subroutine build_slab( & logical, intent(out) :: lcycle logical, optional, intent(in) :: orthogonalise - real(real32), optional, intent(in) :: vacuum + real(real32), intent(in) :: vacuum ! Local variables @@ -843,7 +843,6 @@ subroutine build_slab( & !! Indices of the bottom and top terminations logical :: equivalent_surfaces !! Boolean whether the two surfaces are equivalent - real(real32) :: vacuum_ integer :: j, j_start, istep, natom_check real(real32) :: rtmp1, slab_thickness, shift_val character(2) :: lwup @@ -922,9 +921,6 @@ subroutine build_slab( & orthogonalise_ = .true. if(present(orthogonalise)) orthogonalise_ = orthogonalise - vacuum_ = 10._real32 - if(present(vacuum)) vacuum_ = vacuum - !!-------------------------------------------------------------------- !! Set up list for checking expected number of atoms @@ -1022,12 +1018,12 @@ subroutine build_slab( & !!-------------------------------------------------------------------- !! Apply slab_cuber to orthogonalise lower material !!-------------------------------------------------------------------- - call set_vacuum(basis,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum_) + call set_vacuum(basis,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum) abc=cshift(abc,3-term%axis) if(orthogonalise_)then ortho_check: do j=1,2 if(abs(dot_product(basis%lat(abc(j),:),basis%lat(term%axis,:))).gt.1.E-5_real32)then - call ortho_axis(basis%lat,basis,term%axis) + call ortho_axis(basis,term%axis) exit ortho_check end if end do ortho_check diff --git a/src/fortran/mod_intf_generator.f90 b/src/fortran/mod_intf_generator.f90 index e61d97b..390d010 100644 --- a/src/fortran/mod_intf_generator.f90 +++ b/src/fortran/mod_intf_generator.f90 @@ -763,7 +763,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!-------------------------------------------------------------------- call build_slab(slab_lw,t2lw_map,lw_term,[iterm_lw,lw_surf(2)],& lw_thickness, ncells_lw, lw_num_layers, height_lw,& - "lw",lcycle) + "lw",lcycle, & + vacuum = this%vacuum_gap & + ) if(lcycle) cycle lw_term_loop @@ -776,7 +778,9 @@ subroutine generate_interfaces(this, basis_lw, basis_up) allocate(t2up_map,source=t1up_map) call build_slab(slab_up,t2up_map,up_term,[iterm_up,up_surf(2)],& up_thickness, ncells_up, up_num_layers, height_up,& - "up",lcycle) + "up",lcycle, & + vacuum = this%vacuum_gap & + ) if(lcycle) cycle up_term_loop @@ -846,6 +850,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) &code is now exiting...") end if end if + write(*,*) "intf_loc",intf_loc !!----------------------------------------------------------------- @@ -985,7 +990,7 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& case(4) if(present(map))then output_shifts = get_shifts_DON(& - lat=basis%lat,bas=basis,& + bas=basis,& axis=this%axis,& intf_loc=intf_loc,& nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& @@ -993,7 +998,7 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& max_bondlength=max_bondlength) else output_shifts = get_shifts_DON(& - lat=basis%lat,bas=basis,& + bas=basis,& axis=this%axis,& intf_loc=intf_loc,& nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& diff --git a/src/fortran/mod_shifting.f90 b/src/fortran/mod_shifting.f90 index 7960072..982b6c3 100644 --- a/src/fortran/mod_shifting.f90 +++ b/src/fortran/mod_shifting.f90 @@ -740,7 +740,7 @@ end function get_descriptive_ab_shifts !!!############################################################################# !!! generate shifts by filling missing neighours for surface atoms !!!############################################################################# - function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& + function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& bulk_DON,bulk_map,lprint,max_bondlength) result(res_shifts) use artemis__sym, only: gldfnd,confine_type use edit_geom, only: get_bulk,wyck_spec_type,get_wyckoff @@ -770,7 +770,6 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& real(real32), intent(in), optional :: max_bondlength type(basis_type), intent(in) :: bas real(real32), dimension(:), intent(in) :: intf_loc - real(real32), dimension(3,3), intent(in) :: lat real(real32), optional :: c_scale logical, optional :: lprint real(real32), dimension(3), optional, intent(in) :: offset @@ -901,7 +900,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& count1 = 0 DON_missing(i,:) = & - gen_DON(lat,splitbas(i),dist_max,scale_dist=.false.,norm=.true.) + gen_DON(bas%lat,splitbas(i),dist_max,scale_dist=.false.,norm=.true.) !!----------------------------------------------------------------------- !! Loops through the basis and finds the missing bonds of surface atoms. !! Does this by minusing the DON of the wyckoff atom of the surface ... @@ -1059,24 +1058,24 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& lpresent=.false. if(present(offset))then if(offset(axis).ge.0._real32)then - max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:)) + max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(bas%lat(axis,:)) lpresent=.true. end if end if if(.not.lpresent)then - max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(lat(axis,:)) + 6._real32 + max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(bas%lat(axis,:)) + 6._real32 add = 0._real32 end if stepsize=0.1 - ngrid(1)=nint(modu(lat(1,:))/stepsize) - ngrid(2)=nint(modu(lat(2,:))/stepsize) + ngrid(1)=nint(modu(bas%lat(1,:))/stepsize) + ngrid(2)=nint(modu(bas%lat(2,:))/stepsize) ngrid(3)=ceiling(max_sep/stepsize)+1 allocate(course_grid(2,ngrid(1),ngrid(2),ngrid(3))) allocate(tmp_neigh(max(size(intf(1)%neigh),size(intf(2)%neigh))*9)) - gridsize(1) = stepsize/modu(lat(1,:)) - gridsize(2) = stepsize/modu(lat(2,:)) - gridsize(3) = stepsize/modu(lat(3,:)) + gridsize(1) = stepsize/modu(bas%lat(1,:)) + gridsize(2) = stepsize/modu(bas%lat(2,:)) + gridsize(3) = stepsize/modu(bas%lat(3,:)) nstep(:2) = min_trans(:2)*ngrid(:2) nstep(3) = 0 @@ -1101,7 +1100,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& add(i) = 0.0 end if end do - add(axis) = add(axis)/modu(lat(axis,:)) + add(axis) = add(axis)/modu(bas%lat(axis,:)) end if !nthreads=8 @@ -1112,7 +1111,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !!!----------------------------------------------------------------------------- if(abs(ierror).ge.1)then write(6,'(1X,A,3(2X,F8.4))') & - "lat:",modu(lat(1,:)),modu(lat(2,:)),modu(lat(3,:)) + "lat:",modu(bas%lat(1,:)),modu(bas%lat(2,:)),modu(bas%lat(3,:)) write(6,'(1X,A,3(2X,F8.4))') "gridsize:",gridsize write(6,*) "add:",add write(6,*) "nstep:",nstep @@ -1133,7 +1132,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& !$OMP PARALLEL DO & !$OMP DEFAULT(SHARED) & !$OMP PRIVATE(is,ja,jb,jc,pos,vtmp1,vtmp2,vtmp3,count1,tmp_neigh) & -!$OMP SCHEDULE(DYNAMIC,8) +!$OMP SCHEDULE(DYNAMIC,2) do k=1,2 nneigh = size(intf(k)%neigh,dim=1) @@ -1156,7 +1155,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& vtmp2(1) = vtmp1(1) + real(i,real32) b_extend_loop: do j=-1,1,1 vtmp2(2) = vtmp1(2) + real(j,real32) - vtmp3 = matmul(vtmp2,lat) + vtmp3 = matmul(vtmp2,bas%lat) if(modu(vtmp3).gt.dist_max) cycle b_extend_loop count1 = count1 + 1 tmp_neigh(count1) = modu(vtmp3) @@ -1275,7 +1274,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& res_shifts(i,:2) = res_shifts(i,:2) + add(:2) write(6,'(1X,I3,":",2X,F6.2,3(2X,I3))') i,fit_store(i),shift_store(i,:) end do - res_shifts(:,axis) = (res_shifts(:,axis)*max_sep)/modu(lat(axis,:)) + & + res_shifts(:,axis) = (res_shifts(:,axis)*max_sep)/modu(bas%lat(axis,:)) + & add(axis) if(present(c_scale)) res_shifts(:,axis) = res_shifts(:,axis)*c_scale @@ -1285,7 +1284,7 @@ function get_shifts_DON(lat,bas,axis,intf_loc,nstore,c_scale,offset,& write(6,'(1X,"Shifts to be applied (Å)")') do i=1,nstore write(6,'(I3,":",2X,3(2X,F7.4))') & - i,res_shifts(i,:2),res_shifts(i,3)*modu(lat(axis,:)) + i,res_shifts(i,:2),res_shifts(i,3)*modu(bas%lat(axis,:)) end do end if end if From 738ad8e55f7243502db2ac86d8557e944ba2b838 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 15:23:59 +0100 Subject: [PATCH 043/137] Remove printing --- src/fortran/mod_intf_generator.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fortran/mod_intf_generator.f90 b/src/fortran/mod_intf_generator.f90 index 390d010..231d0cc 100644 --- a/src/fortran/mod_intf_generator.f90 +++ b/src/fortran/mod_intf_generator.f90 @@ -850,7 +850,6 @@ subroutine generate_interfaces(this, basis_lw, basis_up) &code is now exiting...") end if end if - write(*,*) "intf_loc",intf_loc !!----------------------------------------------------------------- From 85357e1192c156c5761a191764e32434e53e559b Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 17 Apr 2025 17:34:54 +0100 Subject: [PATCH 044/137] Reduce input module dependency --- app/main.f90 | 6 +- src/fortran/mod_intf_generator.f90 | 789 +++++++++++++++++++++-------- src/fortran/mod_swapping.f90 | 6 +- 3 files changed, 588 insertions(+), 213 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 740107e..27441b7 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -93,7 +93,11 @@ program artemis_executable call intf_gen%set_tolerance( & tolerance = tolerance & ) - call intf_gen%generate(struc1_bas, struc2_bas) + call intf_gen%generate( & + struc1_bas, struc2_bas, & + miller_lw = lw_mplane, miller_up = up_mplane, & + surface_lw = lw_surf, surface_up = up_surf & + ) else call intf_gen%restart(struc1_bas) end if diff --git a/src/fortran/mod_intf_generator.f90 b/src/fortran/mod_intf_generator.f90 index 231d0cc..255b2b1 100644 --- a/src/fortran/mod_intf_generator.f90 +++ b/src/fortran/mod_intf_generator.f90 @@ -5,25 +5,24 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module artemis__interface_generator - use artemis__constants, only: real32, ierror, pi - use artemis__misc, only: to_lower,to_upper - use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type - use artemis__geom_rw, only: basis_type,geom_write - use lat_compare, only: get_best_match - use artemis__io_utils, only: err_abort + use artemis__constants, only: real32, ierror, pi + use artemis__misc, only: to_lower,to_upper + use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type + use artemis__geom_rw, only: basis_type,geom_write + use lat_compare, only: get_best_match + use artemis__io_utils, only: err_abort, print_warning use artemis__io_utils_extd, only: err_abort_print_struc - use misc_linalg, only: uvec,modu,get_area,inverse,cross - use inputs - use interface_identifier, only: intf_info_type,& + use misc_linalg, only: uvec,modu,get_area,inverse,cross + use interface_identifier, only: intf_info_type,& get_interface,get_layered_axis,gen_DON - use edit_geom, only: planecutter,primitive_lat,ortho_axis,& + use edit_geom, only: planecutter,primitive_lat,ortho_axis,& shift_region,set_vacuum,transformer,shifter,reducer,& get_min_bulk_bond,get_min_bond,get_shortest_bond,bond_type,& share_strain, MATNORM, basis_stack, compare_stoichiometry - use artemis__sym, only: confine_type,gldfnd,& + use artemis__sym, only: confine_type,gldfnd,& get_primitive_cell - use artemis__terminations, only: get_termination_info, term_arr_type, set_slab_height, set_layer_tol, build_slab - use swapping, only: rand_swapper + use artemis__terminations, only: get_termination_info, term_arr_type, set_slab_height, set_layer_tol, build_slab + use swapping, only: rand_swapper use shifting !!! CHANGE TO SHIFTER? implicit none integer, private :: intf=0 @@ -36,17 +35,41 @@ module artemis__interface_generator type, extends(abstract_artemis_generator_type) :: artemis_interface_generator_type integer :: shift_method = 4 !! Shift method - integer :: swap_method = 0 - !! Swap method integer :: num_shifts = 5 !! Number of shifts per lattice match + real(real32), dimension(:,:), allocatable :: shifts + !! Shift values + real(real32) :: interface_depth = 1.5_real32 + !! Interface depth + real(real32) :: separation_scale = 1.5_real32 + !! Separation scale + integer :: depth_method = 0 + !! Method for determining the depth to which consider atoms from interface + real(real32), dimension(:,:), allocatable :: shift_data + !! Data of shifts for each interface, where index 1 is the interface number in structures + + integer :: swap_method = 0 + !! Swap method integer :: num_swaps = 0 !! Number of swaps per shifted interface + real(real32) :: swap_density = 5.E-2_real32 + !! Swap density + real(real32) :: swap_depth = 3._real32 + !! Swap depth + real(real32) :: swap_sigma = -1._real32 + !! Swap sigma + logical :: require_mirror_swaps = .true. + !! Require mirror swaps integer :: match_method = 0 integer :: max_num_matches = 5 - integer :: max_num_term = 5 - integer :: num_miller_planes = 10 + integer :: max_num_terms = 5 + integer :: max_num_planes = 10 + + logical :: fix_normal = .true. !! compensate_strains_parallel = .true. + !! Fix the lattice constants parallel to the interface normal vector + !! Fix = true = strained + !! Fix = false = relaxed (compensate for interfacial strain by extending/compressing) real(real32) :: bondlength_cutoff = 6._real32 real(real32), dimension(2) :: layer_separation_cutoff = 1._real32 @@ -119,7 +142,84 @@ end subroutine set_tolerance !############################################################################### - subroutine generate_intefaces_from_existing(this, basis) + subroutine set_shift_method( & + this, & + method, num_shifts, shifts, & + interface_depth, separation_scale, depth_method & + ) + !! Set the shift method + implicit none + + ! Arguments + class(artemis_interface_generator_type), intent(inout) :: this + !! Instance of artemis generator type + integer, intent(in), optional :: method + !! Shift method + integer, intent(in), optional :: num_shifts + !! Number of shifts + real(real32), dimension(..), intent(in), optional :: shifts + !! Shift values + real(real32), intent(in), optional :: interface_depth + !! Interface depth + real(real32), intent(in), optional :: separation_scale + !! Separation scale + integer, intent(in), optional :: depth_method + !! Method for determining the depth to which consider atoms from interface + + ! Local variables + character(len=256) :: err_msg + + if(present(method)) this%shift_method = method + if(present(num_shifts)) this%num_shifts = num_shifts + if(present(interface_depth)) this%interface_depth = interface_depth + if(present(separation_scale)) this%separation_scale = separation_scale + if(present(depth_method)) this%depth_method = depth_method + if(present(shifts)) then + if(allocated(this%shifts)) deallocate(this%shifts) + select rank(shifts) + rank(0) + allocate(this%shifts(1,3)) + this%shifts(1,this%axis) = shifts + rank(1) + allocate(this%shifts(1,3)) + select case(size(shifts,dim=1)) + case(1) + this%shifts(1,this%axis) = shifts(1) + case(3) + this%shifts(1,:) = shifts + case default + write(err_msg,'(A,I0,A)') & + "ERROR: The shifts vector has ", size(shifts, dim=1), & + " components. It should have 1 or 3." + call err_abort(trim(err_msg),fmtd=.true.) + end select + rank(2) + if(size(shifts,dim=2).eq.3) then + allocate(this%shifts(size(shifts,1),3)) + this%shifts = shifts + else + write(err_msg,'(A,I0,A)') & + "ERROR: The shifts vector has ", size(shifts, dim=1), & + " components. It should have 3." + call err_abort(trim(err_msg),fmtd=.true.) + end if + rank default + write(err_msg,'(A,I0,A)') & + "ERROR: The shifts vector has ", size(shifts, dim=1), & + " components. It should have 1, 2, or 3." + call err_abort(trim(err_msg),fmtd=.true.) + end select + end if + + end subroutine set_shift_method +!############################################################################### + + +!############################################################################### + subroutine generate_intefaces_from_existing(this, basis, & + interface_location, & + print_shift_info, seed & + ) !! Generate interfaces for the given basis implicit none @@ -128,6 +228,12 @@ subroutine generate_intefaces_from_existing(this, basis) !! Instance of artemis generator type type(basis_type), intent(in) :: basis !! Atomic structure data + real(real32), dimension(2), intent(in), optional :: interface_location + !! Interface location + logical, intent(in), optional :: print_shift_info + !! Print shift information + integer, intent(in), optional :: seed + !! Random seed for generating random numbers ! Local variables integer :: is,ia,js,ja @@ -138,16 +244,41 @@ subroutine generate_intefaces_from_existing(this, basis) !! Interface information real(real32), dimension(3) :: vtmp1 !! Temporary vector + logical :: print_shift_info_ + !! Print shift information + integer :: num_seed + !! Number of seeds for the random number generator. + integer, dimension(:), allocatable :: seed_arr + !! Array of seeds for the random number generator. + + + !--------------------------------------------------------------------------- + ! Set the random seed + !--------------------------------------------------------------------------- + if(present(seed))then + call random_seed(size=num_seed) + allocate(seed_arr(num_seed)) + seed_arr = seed + call random_seed(put=seed_arr) + else + call random_seed(size=num_seed) + allocate(seed_arr(num_seed)) + call random_seed(get=seed_arr) + end if + + print_shift_info_ = .false. + if(present(print_shift_info)) print_shift_info_ = print_shift_info + + if(.not.allocated(this%structures)) allocate(this%structures(0)) min_bond1=huge(0._real32) min_bond2=huge(0._real32) - if(any(udef_intf_loc.lt.0._real32))then - if(ludef_axis)then - intf=get_interface(basis%lat,basis,this%axis) - else - intf=get_interface(basis%lat,basis) - end if + if(present(interface_location))then + intf%axis = this%axis + intf%loc = interface_location + else + intf=get_interface(basis%lat,basis,this%axis) intf%loc=intf%loc/modu(basis%lat(intf%axis,:)) write(6,*) "interface axis:",intf%axis write(6,*) "interface loc:",intf%loc @@ -156,9 +287,6 @@ subroutine generate_intefaces_from_existing(this, basis) write(10,'(1X,"AXIS = ",I0)') intf%axis write(10,'(1X,"INTF_LOC = ",2(2X,F9.6))') intf%loc close(10) - else - intf%axis = this%axis - intf%loc = udef_intf_loc end if specloop1: do is=1,basis%nspec atomloop1: do ia=1,basis%spec(is)%num @@ -194,11 +322,9 @@ subroutine generate_intefaces_from_existing(this, basis) min_bond = ( min_bond1 + min_bond2 )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond - write(6,'(1X,"Trans-interfacial scaling factor:",F0.3)') c_scale + write(6,'(1X,"Trans-interfacial scaling factor:",F0.3)') this%separation_scale this%axis = intf%axis - call this%generate_perturbations(basis,intf%loc,min_bond,& - nshift,& - swap_den,nswap) + call this%generate_perturbations(basis,intf%loc,min_bond, print_shift_info_, seed_arr) end subroutine generate_intefaces_from_existing @@ -206,7 +332,21 @@ end subroutine generate_intefaces_from_existing !############################################################################### - subroutine generate_interfaces(this, basis_lw, basis_up) + subroutine generate_interfaces( & + this, basis_lw, basis_up, & + miller_lw, miller_up, & + surface_lw, surface_up, & + thickness_lw, thickness_up, & + num_layers_lw, num_layers_up, & + use_pricel_lw, use_pricel_up, & + is_layered_lw, is_layered_up, & + elastic_constants_lw, elastic_constants_up, & + print_lattice_match_info, print_termination_info, print_shift_info, & + break_on_fail, & + icheck_match, interface_idx, & + generate_structures, & + seed & + ) !! Generate interfaces from two bulk structures implicit none @@ -217,6 +357,53 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! Lower bulk structure type(basis_type), intent(in) :: basis_up !! Upper bulk structure + integer, intent(in), optional :: miller_lw(3) + !! Miller indices for the lower bulk structure + integer, intent(in), optional :: miller_up(3) + !! Miller indices for the upper bulk structure + integer, intent(in), dimension(:), optional :: surface_lw + !! Surface indices for the lower bulk structure + integer, intent(in), dimension(:), optional :: surface_up + !! Surface indices for the upper bulk structure + real(real32), intent(in), optional :: thickness_lw + !! Thickness of the lower slab + real(real32), intent(in), optional :: thickness_up + !! Thickness of the upper slab + integer, intent(in), optional :: num_layers_lw + !! Number of layers in the lower slab + integer, intent(in), optional :: num_layers_up + !! Number of layers in the upper slab + + logical, intent(in), optional :: use_pricel_lw + !! Use primitive cell for lower bulk structure + logical, intent(in), optional :: use_pricel_up + !! Use primitive cell for upper bulk structure + logical, intent(in), optional :: is_layered_lw + !! Boolean whether the lower bulk structure is layered + logical, intent(in), optional :: is_layered_up + !! Boolean whether the upper bulk structure is layered + + real(real32), dimension(:), intent(in), optional :: elastic_constants_lw + !! Elastic constants for the lower bulk structure + real(real32), dimension(:), intent(in), optional :: elastic_constants_up + !! Elastic constants for the upper bulk structure + + logical, intent(in), optional :: break_on_fail + !! Break on failure + logical, intent(in), optional :: print_lattice_match_info + !! Print lattice match information + logical, intent(in), optional :: print_termination_info + !! Print termination information + logical, intent(in), optional :: print_shift_info + !! Print shift information + integer, intent(in), optional :: icheck_match + !! Index of the lattice match to check + integer, intent(in), optional :: interface_idx + !! Index of the interface to output + logical, intent(in), optional :: generate_structures + !! Boolean whether to generate structures or just print information + integer, intent(in), optional :: seed + !! Random seed for generating random numbers ! Local variables real(real32) :: avg_min_bond @@ -247,15 +434,50 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! Number of cells in the slab real(real32) :: height_lw, height_up !! Height of the slab - - + real(real32) :: thickness_lw_, thickness_up_ + !! Thickness of the slab + integer :: num_layers_lw_, num_layers_up_ + !! Number of layers in the slab + logical :: use_pricel_lw_, use_pricel_up_ + !! Use primitive cell for lower and upper bulk structures + logical :: is_layered_lw_, is_layered_up_ + !! Boolean whether the bulk structures are layered + logical :: ludef_is_layered_lw, ludef_is_layered_up + !! Boolean whether the user defined whether to use layered structures + + integer, dimension(3) :: miller_lw_, miller_up_ + !! Miller indices for the lower and upper bulk structures + integer, dimension(2) :: surface_lw_, surface_up_ + !! Surface indices for the lower and upper bulk structures + logical :: ludef_surface_lw, ludef_surface_up + !! Boolean whether surfaces are defined + logical :: lcycle + !! Boolean whether to skip the cycle + + logical :: break_on_fail_ + !! Boolean whether to break on failure + logical :: print_lattice_match_info_, print_termination_info_, print_shift_info_ + !! Boolean whether to print lattice match, termination, and shift information + integer :: num_seed + !! Number of seeds for the random number generator. + integer, dimension(:), allocatable :: seed_arr + !! Array of seeds for the random number generator. + integer :: icheck_match_ + !! Index of the lattice match to check + integer :: interface_idx_ + !! Index of the interface to output + logical :: generate_structures_ + !! Boolean whether to generate structures or just print information + + real(real32), dimension(:), allocatable :: elastic_constants_lw_, elastic_constants_up_ + !! Elastic constants for the lower and upper bulk structures + integer :: ntrans,iunique,itmp1,old_intf - integer :: lw_layered_axis,up_layered_axis + integer :: layered_axis_lw,layered_axis_up real(real32) :: dtmp1,bondlength character(3) :: abc - character(1024) :: pwd,intf_dir,dirpath,msg, filename - logical :: ludef_lw_surf,ludef_up_surf,lcycle + character(1024) :: pwd,intf_dir,dirpath,msg type(confine_type) :: confine type(latmatch_type) :: SAV type(term_arr_type) :: lw_term,up_term @@ -269,13 +491,63 @@ subroutine generate_interfaces(this, basis_lw, basis_up) real(real32), allocatable, dimension(:,:) :: trans + !--------------------------------------------------------------------------- + ! Set the random seed + !--------------------------------------------------------------------------- + if(present(seed))then + call random_seed(size=num_seed) + allocate(seed_arr(num_seed)) + seed_arr = seed + call random_seed(put=seed_arr) + else + call random_seed(size=num_seed) + allocate(seed_arr(num_seed)) + call random_seed(get=seed_arr) + end if + icheck_match_ = -1 + interface_idx_ = -1 + if(present(icheck_match)) icheck_match_ = icheck_match + if(present(interface_idx)) interface_idx_ = interface_idx + break_on_fail_ = .true. + if(present(break_on_fail)) break_on_fail_ = break_on_fail + generate_structures_ = .true. + if(present(generate_structures)) generate_structures_ = generate_structures + + + !--------------------------------------------------------------------------- + ! Handle the elastic constants + !--------------------------------------------------------------------------- + if(present(elastic_constants_lw))then + if(allocated(elastic_constants_lw_)) deallocate(elastic_constants_lw_) + allocate(elastic_constants_lw_(size(elastic_constants_lw))) + elastic_constants_lw_ = elastic_constants_lw + else + if(allocated(elastic_constants_lw_)) deallocate(elastic_constants_lw_) + allocate(elastic_constants_lw_(1)) + elastic_constants_lw_ = 0._real32 + end if + if(present(elastic_constants_up))then + if(allocated(elastic_constants_up_)) deallocate(elastic_constants_up_) + allocate(elastic_constants_up_(size(elastic_constants_up))) + elastic_constants_up_ = elastic_constants_up + else + if(allocated(elastic_constants_up_)) deallocate(elastic_constants_up_) + allocate(elastic_constants_up_(1)) + elastic_constants_up_ = 0._real32 + end if + + !!!----------------------------------------------------------------------------- !!! determines the primitive and niggli reduced cell for each bulk !!!----------------------------------------------------------------------------- call basis_lw_%copy(basis_lw) call basis_up_%copy(basis_up) write(6,*) - if(lw_use_pricel)then + use_pricel_lw_ = .false. + use_pricel_up_ = .false. + if(present(use_pricel_lw)) use_pricel_lw_ = use_pricel_lw + if(present(use_pricel_up)) use_pricel_up_ = use_pricel_up + if(use_pricel_lw_)then write(6,'(1X,"Using primitive cell for lower material")') call get_primitive_cell(basis_lw_) else @@ -283,7 +555,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) call reducer(basis_lw_) basis_lw_%lat=primitive_lat(basis_lw_%lat) end if - if(up_use_pricel)then + if(use_pricel_up_)then write(6,'(1X,"Using primitive cell for upper material")') call get_primitive_cell(basis_up_) else @@ -294,11 +566,77 @@ subroutine generate_interfaces(this, basis_lw, basis_up) write(6,*) - ludef_lw_surf = .false. - if(all(lw_surf.gt.0)) ludef_lw_surf = .true. - ludef_up_surf = .false. - if(all(up_surf.gt.0)) ludef_up_surf = .true. + surface_lw_ = 0 + surface_up_ = 0 + if(present(surface_lw))then + select case(size(surface_lw, dim=1)) + case(1) + surface_lw_ = surface_lw(1) + case(2) + surface_lw_ = surface_lw + case default + write(msg,'(A,I0,A)') & + "ERROR: The surface vector for the lower material has ", & + size(surface_lw, dim=1), " components. It should have 1 or 2." + call err_abort(trim(msg),fmtd=.true.) + end select + end if + if(present(surface_up))then + select case(size(surface_up, dim=1)) + case(1) + surface_up_ = surface_up(1) + case(2) + surface_up_ = surface_up + case default + write(msg,'(A,I0,A)') & + "ERROR: The surface vector for the upper material has ", & + size(surface_up, dim=1), " components. It should have 1 or 2." + call err_abort(trim(msg),fmtd=.true.) + end select + end if + + ludef_surface_lw = .false. + ludef_surface_up = .false. + if(all(surface_lw_.gt.0)) ludef_surface_lw = .true. + if(all(surface_up_.gt.0)) ludef_surface_up = .true. + + miller_lw_ = 0 + miller_up_ = 0 + if(present(miller_lw)) miller_lw_ = miller_lw + if(present(miller_up)) miller_up_ = miller_up + + print_lattice_match_info_ = .false. + print_termination_info_ = .false. + print_shift_info_ = .false. + if(present(print_lattice_match_info)) print_lattice_match_info_ = print_lattice_match_info + if(present(print_termination_info)) print_termination_info_ = print_termination_info + if(present(print_shift_info)) print_shift_info_ = print_shift_info + if(.not.allocated(this%structures)) allocate(this%structures(0)) + + thickness_lw_ = 10._real32 + thickness_up_ = 10._real32 + num_layers_lw_ = 0 + num_layers_up_ = 0 + if(present(num_layers_lw)) num_layers_lw_ = num_layers_lw + if(present(num_layers_up)) num_layers_up_ = num_layers_up + if(present(thickness_lw)) thickness_lw_ = thickness_lw + if(present(thickness_up)) thickness_up_ = thickness_up + if(num_layers_lw_.le.0.and.thickness_lw_.le.0._real32)then + write(msg,'(A,I0,A)') & + "ERROR: The number of layers for the lower material is ", & + num_layers_lw_, " and the thickness is ", thickness_lw_, & + " One of these must be greater than 0." + call err_abort(trim(msg),fmtd=.true.) + end if + if(num_layers_up_.le.0.and.thickness_up_.le.0._real32)then + write(msg,'(A,I0,A)') & + "ERROR: The number of layers for the upper material is ", & + num_layers_up_, " and the thickness is ", thickness_up_, & + " One of these must be greater than 0." + call err_abort(trim(msg),fmtd=.true.) + end if + !!!----------------------------------------------------------------------------- @@ -307,8 +645,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) avg_min_bond = & ( get_min_bulk_bond(basis_lw_) + get_min_bulk_bond(basis_up_) )/2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond - write(6,'(1X,"Trans-interfacial scaling factor: ",F0.3)') c_scale - if(this%shift_method.eq.-1) nshift=1 + write(6,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale + if(this%shift_method.eq.-1) this%num_shifts=1 !!!----------------------------------------------------------------------------- @@ -319,7 +657,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) if(this%shift_method.eq.4.or.this%shift_method.eq.0)then lw_map=0 bulk_DON(1)%spec=gen_DON(basis_lw_%lat,basis_lw_,& - dist_max=max_bondlength,& + dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) do is = 1, inlw_bas%nspec @@ -350,7 +688,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) end do up_map=0 bulk_DON(2)%spec=gen_DON(basis_up_%lat,basis_up_,& - dist_max=max_bondlength,& + dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) do is = 1, inup_bas%nspec @@ -388,14 +726,31 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!!----------------------------------------------------------------------------- !!! checks whether system appears layered !!!----------------------------------------------------------------------------- - lw_layered_axis=get_layered_axis(basis_lw_%lat,basis_lw_) - if(.not.lw_layered.and.lw_layered_axis.gt.0)then + if(present(is_layered_lw))then + is_layered_lw_ = is_layered_lw + ludef_is_layered_lw = .true. + else + is_layered_lw_ = .false. + ludef_is_layered_lw = .false. + end if + if(present(is_layered_up))then + is_layered_up_ = is_layered_up + ludef_is_layered_up = .true. + else + is_layered_up_ = .false. + ludef_is_layered_up = .false. + end if + + + + layered_axis_lw=get_layered_axis(basis_lw_%lat,basis_lw_) + if(.not.is_layered_lw_.and.layered_axis_lw.gt.0)then ivtmp1=0 - ivtmp1(lw_layered_axis)=1 - if(ludef_lw_layered)then + ivtmp1(layered_axis_lw)=1 + if(ludef_is_layered_lw)then write(msg,'("Lower crystal appears layered along axis ",I0,"\n& &Partial layer terminations will be generated\n& - &We suggest using LW_MILLER =",3(1X,I1))') lw_layered_axis,ivtmp1 + &We suggest using LW_MILLER =",3(1X,I1))') layered_axis_lw,ivtmp1 call print_warning(trim(msg)) else write(msg,'("Lower crystal has been identified as layered\nalong",3(1X,I1),"\n& @@ -403,21 +758,21 @@ subroutine generate_interfaces(this, basis_lw, basis_up) &If you don''t want this, set\nLW_LAYERED = .FALSE.")') & ivtmp1 call print_warning(trim(msg)) - lw_mplane=ivtmp1 - lw_layered=.true. + miller_lw_=ivtmp1 + is_layered_lw_=.true. end if - elseif(lw_layered.and.lw_layered_axis.gt.0.and.all(lw_mplane.eq.0))then - lw_mplane(lw_layered_axis)=1 + elseif(is_layered_lw_.and.layered_axis_lw.gt.0.and.all(miller_lw_.eq.0))then + miller_lw_(layered_axis_lw)=1 end if - up_layered_axis=get_layered_axis(basis_up_%lat,basis_up_) - if(.not.up_layered.and.up_layered_axis.gt.0)then + layered_axis_up=get_layered_axis(basis_up_%lat,basis_up_) + if(.not.is_layered_up_.and.layered_axis_up.gt.0)then ivtmp1=0 - ivtmp1(up_layered_axis)=1 - if(ludef_up_layered)then + ivtmp1(layered_axis_up)=1 + if(ludef_is_layered_up)then write(msg,'("Upper crystal appears layered along axis ",I0,"\n& &Partial layer terminations will be generated\n& - &We suggest using UP_MILLER =",3(1X,I1))') up_layered_axis,ivtmp1 + &We suggest using UP_MILLER =",3(1X,I1))') layered_axis_up,ivtmp1 call print_warning(trim(msg)) else write(msg,'("Upper crystal has been identified as layered\nalong",3(1X,I1),"\n& @@ -425,28 +780,28 @@ subroutine generate_interfaces(this, basis_lw, basis_up) &If you don''t want this, set\nUP_LAYERED = .FALSE.")') & ivtmp1 call print_warning(trim(msg)) - up_mplane=ivtmp1 - up_layered=.true. + miller_up_=ivtmp1 + is_layered_up_=.true. end if - elseif(up_layered.and.up_layered_axis.gt.0.and.all(up_mplane.eq.0))then - up_mplane(up_layered_axis)=1 + elseif(is_layered_up_.and.layered_axis_up.gt.0.and.all(miller_up_.eq.0))then + miller_up_(layered_axis_up)=1 end if !!!----------------------------------------------------------------------------- !!! Finds and stores the best matches between the materials !!!----------------------------------------------------------------------------- - call getcwd(pwd) + ! call getcwd(pwd) old_intf = -1 intf=0 abc="abc" - if(imatch.ne.0.and.(any(lw_mplane.ne.0).or.any(up_mplane.ne.0)))then + if(this%match_method.ne.0.and.(any(miller_lw_.ne.0).or.any(miller_up_.ne.0)))then call err_abort( '& &Cannot use LW_MILLER or UP_MILLER with IMATCH>0\n& Exiting...', & fmtd=.true. & ) - elseif(imatch.ne.0)then + elseif(this%match_method.ne.0)then write(msg,'("& &IMATCH /= 0 methods are experimental and may\n& ¬ work as expected.\n& @@ -457,40 +812,40 @@ subroutine generate_interfaces(this, basis_lw, basis_up) &")') call print_warning(trim(msg)) end if - if(any(lw_mplane.ne.0))then - if(imatch.ne.0)then + if(any(miller_lw_.ne.0))then + if(this%match_method.ne.0)then abc="ab" - tfmat=planecutter(basis_lw_%lat,real(lw_mplane,real32)) + tfmat=planecutter(basis_lw_%lat,real(miller_lw_,real32)) call transformer(basis_lw_,tfmat,lw_map) SAV=get_best_match(& this%tolerance,& basis_lw_,basis_up_,& - trim(abc),"abc",lprint_matches,ierror,imatch=imatch) - elseif(any(up_mplane.ne.0))then + trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method) + elseif(any(miller_up_.ne.0))then SAV=get_best_match(& this%tolerance,& basis_lw_,basis_up_,& - trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& - plane1=lw_mplane,plane2=up_mplane,nmiller=nmiller) + trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& + plane1=miller_lw_,plane2=miller_up_,nmiller=this%max_num_planes) else SAV=get_best_match(& this%tolerance,& basis_lw_,basis_up_,& - trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& - plane1=lw_mplane,nmiller=nmiller) + trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& + plane1=miller_lw_,nmiller=this%max_num_planes) end if - elseif(any(up_mplane.ne.0))then + elseif(any(miller_up_.ne.0))then SAV=get_best_match(& this%tolerance,& basis_lw_,basis_up_,& - trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& - plane2=up_mplane,nmiller=nmiller) + trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& + plane2=miller_up_,nmiller=this%max_num_planes) else SAV=get_best_match(& this%tolerance,& basis_lw_,basis_up_,& - trim(abc),"abc",lprint_matches,ierror,imatch=imatch,& - nmiller=nmiller) + trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& + nmiller=this%max_num_planes) end if if(min(this%tolerance%nstore,SAV%nfit).eq.0)then write(0,'("No matches found.")') @@ -501,8 +856,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) min(this%tolerance%nstore,SAV%nfit) end if write(6,'(1X,"Maximum number of generated interfaces will be: ",I0)')& - nterm*nshift*this%tolerance%nstore - if(.not.lgen_interfaces)then + this%max_num_terms*this%num_shifts*this%tolerance%nstore + if(.not.generate_structures_)then write(0,'(1X,"Told not to generate interfaces, just find matches.")') write(0,'("Exiting...")') call exit() @@ -512,14 +867,14 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!!----------------------------------------------------------------------------- !!! Saves current directory and moves to new directory !!!----------------------------------------------------------------------------- - call system('mkdir -p '//trim(adjustl(dirname))) - call chdir(dirname) - call getcwd(intf_dir) - - if(iintf.gt.0)then - intf_start=iintf - intf_end=iintf - write(6,'(1X,"Generating only interfaces for match ",I0)') iintf + ! call system('mkdir -p '//trim(adjustl(dirname))) + ! call chdir(dirname) + ! call getcwd(intf_dir) + + if(interface_idx_.gt.0)then + intf_start=interface_idx_ + intf_end=interface_idx_ + write(6,'(1X,"Generating only interfaces for match ",I0)') interface_idx_ else intf_start=1 intf_end=min(this%tolerance%nstore,SAV%nfit) @@ -571,7 +926,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !end if deallocate(bulk_DON(2)%spec) bulk_DON(2)%spec=gen_DON(supercell_up%lat,supercell_up,& - dist_max=max_bondlength,& + dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) !call err_abort_print_struc(basis_up_,"bulk_up_term.vasp",& @@ -621,8 +976,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) if(allocated(lw_term%arr)) deallocate(lw_term%arr) lw_term = get_termination_info( & supercell_lw, this%axis, & - lprint = lprint_terms, layer_sep = lw_layer_sep, & - break_on_fail = lbreak_on_no_term & + lprint = print_termination_info_, layer_sep = this%layer_separation_cutoff(1), & + break_on_fail = break_on_fail_ & ) if(lw_term%nterm .eq. 0)then write(0,'("WARNING: & @@ -631,12 +986,12 @@ subroutine generate_interfaces(this, basis_lw, basis_up) ) SAV%tf1(ifit,3,1:3) cycle intf_loop end if - if(any(lw_surf.gt.lw_term%nterm))then - write(msg, '("LW_SURFACE VALUES INVALID!\nOne or more value & + if(any(surface_lw_.gt.lw_term%nterm))then + write(msg, '("surface_lw_ACE VALUES INVALID!\nOne or more value & &exceeds the maximum number of terminations in the & structure.\n& & Supplied values: ",I0,1X,I0,"\n& - & Maximum allowed: ",I0)') lw_surf, lw_term%nterm + & Maximum allowed: ",I0)') surface_lw_, lw_term%nterm call err_abort(trim(msg),fmtd=.true.) end if @@ -656,11 +1011,11 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Defines height of lower slab from user-defined values !!----------------------------------------------------------------------- - call set_slab_height(supercell_lw,t1lw_map,lw_term,lw_surf,& - height_lw,lw_num_layers, lw_thickness,ncells_lw,& + call set_slab_height(supercell_lw,t1lw_map,lw_term,surface_lw_,& + height_lw,num_layers_lw_, thickness_lw_,ncells_lw,& term_lw_start_idx,term_lw_end_idx,term_lw_step & ) - if(term_lw_end_idx.gt.this%max_num_term) term_lw_end_idx = this%max_num_term + if(term_lw_end_idx.gt.this%max_num_terms) term_lw_end_idx = this%max_num_terms !!----------------------------------------------------------------------- @@ -702,8 +1057,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) if(allocated(up_term%arr)) deallocate(up_term%arr) up_term = get_termination_info( & supercell_up, this%axis, & - lprint = lprint_terms, layer_sep = up_layer_sep, & - break_on_fail = lbreak_on_no_term & + lprint = print_termination_info_, layer_sep = this%layer_separation_cutoff(2), & + break_on_fail = break_on_fail_ & ) if(up_term%nterm .eq. 0)then write(0,'("WARNING: & @@ -712,12 +1067,12 @@ subroutine generate_interfaces(this, basis_lw, basis_up) ) SAV%tf2(ifit,3,1:3) cycle intf_loop end if - if(any(up_surf.gt.up_term%nterm))then - write(msg, '("UP_SURFACE VALUES INVALID!\nOne or more value & + if(any(surface_up_.gt.up_term%nterm))then + write(msg, '("surface_up_ACE VALUES INVALID!\nOne or more value & &exceeds the maximum number of terminations in the & structure.\n& & Supplied values: ",I0,1X,I0,"\n& - & Maximum allowed: ",I0)') up_surf, up_term%nterm + & Maximum allowed: ",I0)') surface_up_, up_term%nterm call err_abort(trim(msg),fmtd=.true.) end if @@ -737,11 +1092,11 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------------- !! Defines height of upper slab from user-defined values !!----------------------------------------------------------------------- - call set_slab_height(supercell_up,t1up_map,up_term,up_surf,& - height_up,up_num_layers, up_thickness, ncells_up,& + call set_slab_height(supercell_up,t1up_map,up_term,surface_up_,& + height_up,num_layers_up_, thickness_up_, ncells_up,& term_up_start_idx,term_up_end_idx,term_up_step & ) - if(term_up_end_idx.gt.this%max_num_term) term_up_end_idx = this%max_num_term + if(term_up_end_idx.gt.this%max_num_terms) term_up_end_idx = this%max_num_terms !!----------------------------------------------------------------------- @@ -761,8 +1116,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!-------------------------------------------------------------------- !! Shifts lower material to specified termination !!-------------------------------------------------------------------- - call build_slab(slab_lw,t2lw_map,lw_term,[iterm_lw,lw_surf(2)],& - lw_thickness, ncells_lw, lw_num_layers, height_lw,& + call build_slab(slab_lw,t2lw_map,lw_term,[iterm_lw,surface_lw_(2)],& + thickness_lw_, ncells_lw, num_layers_lw_, height_lw,& "lw",lcycle, & vacuum = this%vacuum_gap & ) @@ -776,8 +1131,8 @@ subroutine generate_interfaces(this, basis_lw, basis_up) call slab_up%copy(supercell_up) if(allocated(t2up_map)) deallocate(t2up_map) allocate(t2up_map,source=t1up_map) - call build_slab(slab_up,t2up_map,up_term,[iterm_up,up_surf(2)],& - up_thickness, ncells_up, up_num_layers, height_up,& + call build_slab(slab_up,t2up_map,up_term,[iterm_up,surface_up_(2)],& + thickness_up_, ncells_up, num_layers_up_, height_up,& "up",lcycle, & vacuum = this%vacuum_gap & ) @@ -792,7 +1147,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) /slab_lw%spec(1)%num.ne.basis_lw_%spec(:)%num))then write(6,'("WARNING: This lower surface termination is not & &stoichiometric")') - if(lw_layered)then + if(is_layered_lw_)then write(6,'(2X,"As lower structure is layered, stoichiometric & &surfaces are required.")') write(6,'(2X,"Skipping this termination...")') @@ -804,7 +1159,7 @@ subroutine generate_interfaces(this, basis_lw, basis_up) /slab_up%spec(1)%num.ne.basis_up_%spec(:)%num))then write(6,'("WARNING: This upper surface termination is not & &stoichiometric")') - if(up_layered)then + if(is_layered_up_)then write(6,'(2X,"As upper structure is layered, stoichiometric & &surfaces are required.")') write(6,'(2X,"Skipping this termination...")') @@ -816,9 +1171,14 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- !! Use the bulk moduli to determine the strain sharing !!----------------------------------------------------------------- - if(lw_bulk_modulus.ne.0.E0.and.up_bulk_modulus.ne.0.E0)then + if( all(abs(elastic_constants_lw_).gt.0.E0) .and. & + all(abs(elastic_constants_up_).gt.0.E0) & + )then call share_strain(slab_lw%lat,slab_up%lat,& - lw_bulk_modulus,up_bulk_modulus,lcompensate=.not.lc_fix) + elastic_constants_lw_(1), & + elastic_constants_up_(1), & + lcompensate = .not.this%fix_normal & + ) end if @@ -836,15 +1196,15 @@ subroutine generate_interfaces(this, basis_lw, basis_up) 1.5_real32*init_offset(this%axis) - 2._real32*this%vacuum_gap )/modu(interface%lat(this%axis,:)) if(ierror.ge.1)then write(0,*) "interface:",intf_loc - if(ierror.eq.1.and.iunique.eq.icheck_intf-1)then - call chdir(intf_dir) + if(ierror.eq.1.and.iunique.eq.icheck_match_-1)then + ! call chdir(intf_dir) call err_abort_print_struc(slab_lw,"lw_term.vasp",& "",.false.) call err_abort_print_struc(slab_up,"up_term.vasp",& "As IPRINT = 1 and ICHECK has been set, & &code is now exiting...") - elseif(ierror.eq.2.and.iunique.eq.icheck_intf-1)then - call chdir(intf_dir) + elseif(ierror.eq.2.and.iunique.eq.icheck_match_-1)then + ! call chdir(intf_dir) call err_abort_print_struc(interface,"test_intf.vasp",& "As IPRINT = 2 and ICHECK has been set, & &code is now exiting...") @@ -857,15 +1217,15 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !!----------------------------------------------------------------- if(intf.gt.old_intf)then iunique=iunique+1 - if(this%shift_method.gt.0.and.nshift.gt.1) & - write(6,'(1X,"Generating shifts for unique interface ",& - &I0,":")') iunique - write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique - call system('mkdir -p '//trim(adjustl(dirpath))) + ! if(this%shift_method.gt.0.and.this%num_shifts.gt.1) & + ! write(6,'(1X,"Generating shifts for unique interface ",& + ! &I0,":")') iunique + ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique + ! call system('mkdir -p '//trim(adjustl(dirpath))) else - write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique + ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique end if - call chdir(dirpath) + ! call chdir(dirpath) old_intf = intf @@ -873,32 +1233,35 @@ subroutine generate_interfaces(this, basis_lw, basis_up) !! Writes information of current match to file in save directory !!----------------------------------------------------------------- call output_intf_data(SAV, ifit, lw_term, iterm_lw, up_term, iterm_up,& - lw_use_pricel,up_use_pricel) + use_pricel_lw_,use_pricel_up_) !!----------------------------------------------------------------- !! Generates shifts and swaps and prints the subsequent structures !!----------------------------------------------------------------- - call this%generate_perturbations(interface,intf_loc,avg_min_bond,& - nshift,& - swap_den,nswap,t2lw_map) + call this%generate_perturbations( & + interface, intf_loc, avg_min_bond, & + print_shift_info_, & + seed_arr, & + t2lw_map & + ) - if(intf.ge.nintf) exit intf_loop + if(intf.ge.this%max_num_structures) exit intf_loop !call chdir(dirname) - call chdir(intf_dir) + ! call chdir(intf_dir) - if(ludef_up_surf) exit up_term_loop + if(ludef_surface_up) exit up_term_loop end do up_term_loop - if(ludef_lw_surf) exit lw_term_loop + if(ludef_surface_lw) exit lw_term_loop end do lw_term_loop !!----------------------------------------------------------------------- !! Returns to working directory !!----------------------------------------------------------------------- - call chdir(intf_dir) + ! call chdir(intf_dir) end do intf_loop - call chdir(pwd) + ! call chdir(pwd) return @@ -911,13 +1274,18 @@ end subroutine generate_interfaces !!! Prints these new structures to POSCARs. !!!############################################################################# !!! ISWAP METHOD NOT YET SET UP - subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& - nshift,& - swap_den,nswap,& - map) + subroutine generate_shifts_and_swaps( & + this, basis, intf_loc, bond, print_shift_info, seed_arr, map & + ) implicit none class(artemis_interface_generator_type), intent(inout) :: this type(basis_type), intent(in) :: basis + real(real32), dimension(2), intent(in) :: intf_loc + real(real32), intent(in) :: bond + logical, intent(in) :: print_shift_info + integer, dimension(:), intent(in) :: seed_arr + integer, dimension(:,:,:), optional, intent(in) :: map + integer :: shift_unit integer :: ounit,iaxis,k,l integer :: ngen_swaps,nswaps_per_cell @@ -926,15 +1294,10 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& type(bond_type) :: min_bond character(1024) :: filename,dirpath,pwd1,pwd2,msg integer, dimension(3) :: abc - real(real32), dimension(2) :: intf_loc real(real32), dimension(3) :: toffset type(basis_type), allocatable, dimension(:) :: bas_arr real(real32), allocatable, dimension(:,:) :: output_shifts - integer, intent(in) :: nshift,nswap - real(real32), intent(in) :: bond,swap_den - - integer, dimension(:,:,:), optional, intent(in) :: map !!!----------------------------------------------------------------------------- @@ -947,25 +1310,25 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& !!!----------------------------------------------------------------------------- !!! Sets up and moves to appropriate directories !!!----------------------------------------------------------------------------- - call getcwd(pwd1) - if(this%shift_method.gt.0.or.nshift.gt.1)then - call system('mkdir -p '//trim(adjustl(shiftdir))) - call chdir(shiftdir) - end if - call getcwd(pwd2) - open(newunit=shift_unit,file="shift_vals.txt") - write(shift_unit,& - '("# interface_num shift (a,b,c) units=(direct,direct,Å)")') + ! call getcwd(pwd1) + ! if(this%shift_method.gt.0.or.this%num_shifts.gt.1)then + ! call system('mkdir -p '//trim(adjustl(shiftdir))) + ! call chdir(shiftdir) + ! end if + ! call getcwd(pwd2) + ! open(newunit=shift_unit,file="shift_vals.txt") + ! write(shift_unit,& + ! '("# interface_num shift (a,b,c) units=(direct,direct,Å)")') !!!----------------------------------------------------------------------------- !!! Generates sets of shifts based on shift version !!!----------------------------------------------------------------------------- - if(this%shift_method.eq.0.or.this%shift_method.eq.1) allocate(output_shifts(nshift,3)) + if(this%shift_method.eq.0.or.this%shift_method.eq.1) allocate(output_shifts(this%num_shifts,3)) select case(this%shift_method) case(1) output_shifts(1,:3)=0._real32 - do k=2,nshift + do k=2,this%num_shifts do iaxis=1,2 call random_number(output_shifts(k,iaxis)) end do @@ -976,33 +1339,39 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& bond=bond,& axis=this%axis,& intf_loc=intf_loc,& - depth=intf_depth,& - nstore=nshift) + depth=this%interface_depth,& + nstore=this%num_shifts) case(3) output_shifts = get_descriptive_shifts(& lat=basis%lat,bas=basis,& bond=bond,& axis=this%axis,& intf_loc=intf_loc,& - depth=intf_depth,c_scale=c_scale,& - nstore=nshift,lprint=lprint_shifts) + depth=this%interface_depth, & + c_scale=this%separation_scale,& + nstore=this%num_shifts,lprint=print_shift_info) case(4) if(present(map))then output_shifts = get_shifts_DON(& bas=basis,& axis=this%axis,& intf_loc=intf_loc,& - nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& - lprint=lprint_shifts,bulk_DON=bulk_DON,bulk_map=map,& - max_bondlength=max_bondlength) + nstore=this%num_shifts, & + c_scale=this%separation_scale, & + offset=this%shifts(1,:3),& + lprint=print_shift_info, & + bulk_DON=bulk_DON,bulk_map=map,& + max_bondlength=this%bondlength_cutoff) else output_shifts = get_shifts_DON(& bas=basis,& axis=this%axis,& intf_loc=intf_loc,& - nstore=nshift,c_scale=c_scale,offset=offset(1,:3),& - lprint=lprint_shifts,& - max_bondlength=max_bondlength) + nstore=this%num_shifts, & + c_scale=this%separation_scale, & + offset=this%shifts(1,:3),& + lprint=print_shift_info,& + max_bondlength=this%bondlength_cutoff) end if if(size(output_shifts(:,1)).eq.0)then write(0,'(2X,"No shifts were identified with ISHIFT = 4 for this lattice match")') @@ -1012,7 +1381,7 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& end if case default if(.not.allocated(output_shifts)) allocate(output_shifts(1,3)) - output_shifts(:,:) = offset + output_shifts(:,:) = this%shifts do iaxis = 1, 2 output_shifts(1,iaxis) = output_shifts(1,iaxis)!/modu(lat(iaxis,:)) end do @@ -1025,13 +1394,13 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& !!!----------------------------------------------------------------------------- !!! Prints number of shifts to terminal !!!----------------------------------------------------------------------------- - write(6,'(3X,"Number of unique shifts structures: ",I0)') nshift + write(6,'(3X,"Number of unique shifts structures: ",I0)') this%num_shifts !!!----------------------------------------------------------------------------- !!! Determines number of swaps across the interface !!!----------------------------------------------------------------------------- - nswaps_per_cell=nint(swap_den*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) + nswaps_per_cell=nint(this%swap_density*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) if(this%swap_method.ne.0)then write(6,& '(" Generating ",I0," swaps per structure ")') nswaps_per_cell @@ -1041,7 +1410,7 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& !!!----------------------------------------------------------------------------- !!! Prints each unique shift structure !!!----------------------------------------------------------------------------- - shift_loop: do k=1,nshift + shift_loop: do k=1,this%num_shifts call tbas%copy(basis) toffset=output_shifts(k,:3) do iaxis=1,2 @@ -1072,8 +1441,8 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& !!----------------------------------------------------------------------- !! prints shift vector to shift_vals.txt !!----------------------------------------------------------------------- - write(shift_unit,'(2X,I0.2,15X,"(",2(" ",F9.6,", ")," ",F9.6," )")') & - k,toffset(:) + ! write(shift_unit,'(2X,I0.2,15X,"(",2(" ",F9.6,", ")," ",F9.6," )")') & + ! k,toffset(:) !!----------------------------------------------------------------------- @@ -1082,29 +1451,30 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& !!----------------------------------------------------------------------- intf=intf+1 ounit=100+intf - if(this%shift_method.gt.0.or.nshift.gt.1)then - write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),k - call system('mkdir -p '//trim(adjustl(dirpath))) - write(filename,'(A,"/",A)') trim(adjustl(dirpath)),trim(out_filename) - else - filename = trim(out_filename) - end if - write(6,'(2X,"Writing interface ",I0,"...")') intf - open(unit=ounit,file=trim(adjustl(filename))) - call geom_write(ounit,tbas) - close(ounit) - if(intf.ge.nintf) return + ! if(this%shift_method.gt.0.or.this%num_shifts.gt.1)then + ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),k + ! call system('mkdir -p '//trim(adjustl(dirpath))) + ! write(filename,'(A,"/",A)') trim(adjustl(dirpath)),trim(out_filename) + ! else + ! filename = trim(out_filename) + ! end if + ! write(6,'(2X,"Writing interface ",I0,"...")') intf + ! open(unit=ounit,file=trim(adjustl(filename))) + ! call geom_write(ounit,tbas) + ! close(ounit) + this%structures = [ this%structures, tbas ] + if(intf.ge.this%max_num_structures) return !!----------------------------------------------------------------------- !! Performs swaps within the shifted structures if requested !!----------------------------------------------------------------------- if_swap: if(this%swap_method.ne.0)then - bas_arr = rand_swapper(tbas%lat,tbas,this%axis,swap_depth,& - nswaps_per_cell,nswap,intf_loc,this%swap_method,seed,sigma=swap_sigma,& - require_mirror=lswap_mirror) - ngen_swaps = nswap - LOOPswaps: do l=1,nswap + bas_arr = rand_swapper(tbas%lat,tbas,this%axis,this%swap_depth,& + nswaps_per_cell,this%num_swaps,intf_loc,this%swap_method,seed_arr,sigma=this%swap_sigma,& + require_mirror=this%require_mirror_swaps) + ngen_swaps = this%num_swaps + LOOPswaps: do l=1,this%num_swaps if (bas_arr(l)%nspec.eq.0) then ngen_swaps = l - 1 exit LOOPswaps @@ -1113,29 +1483,30 @@ subroutine generate_shifts_and_swaps(this,basis,intf_loc,bond,& if(ngen_swaps.eq.0)then exit if_swap end if - call chdir(dirpath) - call system('mkdir -p '//trim(adjustl(swapdir))) - call chdir(swapdir) - write(6,'(3X,"Number of unique swap structures: ",I0)') ngen_swaps - do l=1,ngen_swaps - write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),l - call system('mkdir -p '//trim(adjustl(dirpath))) - write(filename,'(A,"/",A)') & - trim(adjustl(dirpath)),trim(out_filename) - ounit=100+l - write(6,'(3X,"Writing swap ",I0,"...")') l - open(unit=ounit,file=trim(adjustl(filename))) - call geom_write(ounit,bas_arr(l)) - close(ounit) - end do + ! call chdir(dirpath) + ! call system('mkdir -p '//trim(adjustl(swapdir))) + ! call chdir(swapdir) + ! write(6,'(3X,"Number of unique swap structures: ",I0)') ngen_swaps + this%structures = [ this%structures, bas_arr(1:ngen_swaps) ] + ! do l=1,ngen_swaps + ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),l + ! call system('mkdir -p '//trim(adjustl(dirpath))) + ! write(filename,'(A,"/",A)') & + ! trim(adjustl(dirpath)),trim(out_filename) + ! ounit=100+l + ! write(6,'(3X,"Writing swap ",I0,"...")') l + ! open(unit=ounit,file=trim(adjustl(filename))) + ! call geom_write(ounit,bas_arr(l)) + ! close(ounit) + ! end do deallocate(bas_arr) - call chdir(pwd2) + ! call chdir(pwd2) end if if_swap end do shift_loop - call chdir(pwd1) - close(unit=shift_unit) + ! call chdir(pwd1) + ! close(unit=shift_unit) end subroutine generate_shifts_and_swaps diff --git a/src/fortran/mod_swapping.f90 b/src/fortran/mod_swapping.f90 index 2c66dcc..13577f0 100644 --- a/src/fortran/mod_swapping.f90 +++ b/src/fortran/mod_swapping.f90 @@ -29,7 +29,7 @@ module swapping !!! Main function to be called from ARTEMIS !!!############################################################################# function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& - iswap,seed,sigma,require_mirror) result(bas_arr) + iswap,seed_arr,sigma,require_mirror) result(bas_arr) implicit none integer :: i,j,is,iout,itmp,count1 integer :: axis,nswap @@ -53,7 +53,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& real(real32), optional, intent(in) :: sigma logical, optional, intent(in) :: require_mirror type(basis_type), intent(in) :: bas - integer, allocatable, dimension(:), intent(in) :: seed + integer, dimension(:), intent(in) :: seed_arr real(real32), dimension(2), intent(in) :: intf_loc !USE 1 type(basis_type), allocatable, dimension(:) :: bas_arr real(real32), dimension(3,3), intent(in) :: lat @@ -75,7 +75,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& end if udef_sigma = udef_sigma/modu(lat(axis,:)) small_sigma = 0.01/modu(lat(axis,:)) - call random_seed(put=seed) + call random_seed(put=seed_arr) !!!----------------------------------------------------------------------------- From 99761eea2f2318a59028586a9055621a0953c2f5 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 06:11:38 +0100 Subject: [PATCH 045/137] Fix temporary arrays --- src/fortran/lib/mod_sym.f90 | 6 +++--- src/fortran/lib/mod_terminations.f90 | 6 +++--- src/fortran/mod_plane_matching.f90 | 24 ++++++++++++------------ 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 2968978..736583d 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -1044,7 +1044,7 @@ subroutine get_primitive_cell(basis) trans(i,i-ntrans)=1._real32 end do ! trans=matmul(trans(1:ntrans,1:3),basis%lat) - call sort2D(trans(1:ntrans+3,:),ntrans+3) + call sort2D( [ trans(1:ntrans+3,:) ] ,ntrans+3) !! for each lattice vector, determine the shortest translation ... !! ... vector that has a non-zero projection along that lattice vector. do i=1,3 @@ -1054,10 +1054,10 @@ subroutine get_primitive_cell(basis) if(dtmp1.lt.tol_sym) cycle trans_loop do k=1,i-1,1 - if(modu(abs(cross(trans(j,:),dmat1(k,:)))).lt.1.E-8_real32) cycle trans_loop + if(modu(abs(cross( [ trans(j,:) ], [ dmat1(k,:) ]))).lt.1.E-8_real32) cycle trans_loop end do - dtmp1 = modu(trans(j,:)) + dtmp1 = modu( [ trans(j,:) ] ) if(dtmp1.lt.proj)then proj=dtmp1 dmat1(i,:) = trans(j,:) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 220aa45..d0929cf 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -705,11 +705,11 @@ subroutine set_slab_height( basis, map, term, surf,& if(thickness.gt.0._real32)then select case(term%axis) case(1) - slab_thickness = dot_product(uvec(cross(basis%lat(2,:),basis%lat(3,:))), basis%lat(1,:)) + slab_thickness = dot_product(uvec(cross([ basis%lat(2,:) ], [ basis%lat(3,:) ])), [ basis%lat(1,:) ]) case(2) - slab_thickness = dot_product(uvec(cross(basis%lat(1,:),basis%lat(3,:))), basis%lat(2,:)) + slab_thickness = dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(3,:) ])), [ basis%lat(2,:) ]) case(3) - slab_thickness = dot_product(uvec(cross(basis%lat(1,:),basis%lat(2,:))), basis%lat(3,:)) + slab_thickness = dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(2,:) ])), [ basis%lat(3,:) ]) end select ! get the largest separation between two terminations if(ludef_surf)then diff --git a/src/fortran/mod_plane_matching.f90 b/src/fortran/mod_plane_matching.f90 index e22580a..4af9c6e 100644 --- a/src/fortran/mod_plane_matching.f90 +++ b/src/fortran/mod_plane_matching.f90 @@ -453,8 +453,8 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list allocate(tf_testlist(nlist,2,2)) do i=1,nlist tf_testlist(i,:2,:2) = find_tf_2x2(& - mat_testlist(i,:2,:2),& - transpose(mat_testlist(i,:2,3:4))) + [ mat_testlist(i,:2,:2) ],& + [ transpose(mat_testlist(i,:2,3:4)) ]) end do @@ -525,10 +525,10 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list !!! saves the smallest match if successful !!!------------------------------------------------------------------------ if(.not.lunique)then - if(abs(get_area(inmat(:2,:2),inmat(:2,3:4))).lt.& + if(abs(get_area([ inmat(:2,:2) ], [ inmat(:2,3:4) ])).lt.& abs(& - get_area(mat_testlist(matched_loc,:2,:2),& - mat_testlist(matched_loc,:2,3:4))))then + get_area([ mat_testlist(matched_loc,:2,:2) ],& + [ mat_testlist(matched_loc,:2,3:4) ])))then mat_testlist(matched_loc,:2,:4) = inmat(:2,:4) if(present(test_list))then test_list = mat_testlist @@ -628,10 +628,10 @@ subroutine cell_match(& !!! Setting up tolerances !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!! tiny = 1.E-5_real32 - tol_up_ang = 1.E0 + real(tol%ang)/(2.E0*pi) - tol_dw_ang = 1.E0 - real(tol%ang)/(2.E0*pi) - tol_up_vec = 1.E0 + real(tol%vec)!/100._real32 - tol_dw_vec = 1.E0 - real(tol%vec)!/100._real32 + tol_up_ang = 1._real32 + tol%ang/(2._real32*pi) + tol_dw_ang = 1._real32 - tol%ang/(2._real32*pi) + tol_up_vec = 1._real32 + tol%vec!/100._real32 + tol_dw_vec = 1._real32 - tol%vec!/100._real32 if(allocated(matched_tols)) deallocate(matched_tols) allocate(matched_tols(tol%maxfit,3)) @@ -849,10 +849,10 @@ subroutine cell_match(& mat1(2,:2)=real(numstore_1(m,:2),real32) mat2(1,:2)=real(list_angle_fits(i,1:2),real32) mat2(2,:2)=real(list_angle_fits(i,3:4),real32) - tf=find_tf(mat1,mat2) + tf=find_tf_2x2(mat1,mat2) do j=1,tol%maxfit - if(all(abs(tf-find_tf(real(MAIN_LOOP_LIST(j,:2,1:2),real32),& - real(MAIN_LOOP_LIST(j,:2,3:4),real32))).lt.1.D-6))then + if(all(abs(tf-find_tf_2x2( [ MAIN_LOOP_LIST(j,:2,1:2) ],& + [ MAIN_LOOP_LIST(j,:2,3:4) ] )).lt.1.E-6_real32))then cycle loop112 end if end do From fd32072812ffbf65a11f9f12fffedc898a852b41 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 06:12:44 +0100 Subject: [PATCH 046/137] Improve inputs handling --- CMakeLists.txt | 13 +++++++------ {src/fortran => app}/inputs.f90 | 0 app/main.f90 | 6 +++++- src/fortran/mod_intf_generator.f90 | 10 +++++++++- 4 files changed, 21 insertions(+), 8 deletions(-) rename {src/fortran => app}/inputs.f90 (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4932afb..5dd1aa8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -77,8 +77,8 @@ set(SPECIAL_LIB_FILES mod_swapping.f90 mod_shifting.f90 default_infile.f90 - inputs.f90 - mod_generator.f90 + mod_term_generator.f90 + mod_intf_generator.f90 ) @@ -105,6 +105,7 @@ endforeach() set(EXECUTABLE_FILES + inputs.f90 main.f90 ) set(APP_DIR app) @@ -201,8 +202,8 @@ set_target_properties(${PROJECT_NAME} PROPERTIES VERSION ${PROJECT_VERSION}) # set compile options based on different build configurations target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${OPTIMFLAGS}>") -target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${MPFLAGS}>") -target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${PYTHONFLAGS}>") +# target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${MPFLAGS}>") +# target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${PYTHONFLAGS}>") target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${DEVFLAGS}>") @@ -218,8 +219,8 @@ if (BUILD_EXECUTABLE) set_target_properties(${PROJECT_NAME}_executable PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIR}) target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${OPTIMFLAGS}>") - target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${MPFLAGS}>") - target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${PYTHONFLAGS}>") + # target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${MPFLAGS}>") + # target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${PYTHONFLAGS}>") target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${DEVFLAGS}>") diff --git a/src/fortran/inputs.f90 b/app/inputs.f90 similarity index 100% rename from src/fortran/inputs.f90 rename to app/inputs.f90 diff --git a/app/main.f90 b/app/main.f90 index 27441b7..fb3b25b 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -96,7 +96,11 @@ program artemis_executable call intf_gen%generate( & struc1_bas, struc2_bas, & miller_lw = lw_mplane, miller_up = up_mplane, & - surface_lw = lw_surf, surface_up = up_surf & + surface_lw = lw_surf, surface_up = up_surf, & + use_pricel_lw = lw_use_pricel, use_pricel_up = up_use_pricel, & + print_lattice_match_info = lprint_matches, & + print_termination_info = lprint_terms, & + print_shift_info = lprint_shifts & ) else call intf_gen%restart(struc1_bas) diff --git a/src/fortran/mod_intf_generator.f90 b/src/fortran/mod_intf_generator.f90 index 255b2b1..f5e06e3 100644 --- a/src/fortran/mod_intf_generator.f90 +++ b/src/fortran/mod_intf_generator.f90 @@ -41,7 +41,7 @@ module artemis__interface_generator !! Shift values real(real32) :: interface_depth = 1.5_real32 !! Interface depth - real(real32) :: separation_scale = 1.5_real32 + real(real32) :: separation_scale = 1._real32 !! Separation scale integer :: depth_method = 0 !! Method for determining the depth to which consider atoms from interface @@ -80,6 +80,7 @@ module artemis__interface_generator ! type(basis_type), dimension(:), allocatable :: term_structures_up contains procedure, pass(this) :: set_tolerance + procedure, pass(this) :: set_shift_method procedure, pass(this) :: generate => generate_interfaces procedure, pass(this) :: restart => generate_intefaces_from_existing procedure, pass(this) :: generate_perturbations => generate_shifts_and_swaps @@ -137,6 +138,8 @@ subroutine set_tolerance( & if(present(area_weight)) this%tolerance%area_weight = area_weight end if + !!! TOLERANCE EXPECTED IN FRACTIONS OF Å, radians, and Å^2 + end subroutine set_tolerance !############################################################################### @@ -209,6 +212,9 @@ subroutine set_shift_method( & " components. It should have 1, 2, or 3." call err_abort(trim(err_msg),fmtd=.true.) end select + else + if(allocated(this%shifts)) deallocate(this%shifts) + allocate(this%shifts(1,3), source = -1._real32) end if end subroutine set_shift_method @@ -513,6 +519,8 @@ subroutine generate_interfaces( & generate_structures_ = .true. if(present(generate_structures)) generate_structures_ = generate_structures + if(.not.allocated(this%shifts)) call this%set_shift_method() + !--------------------------------------------------------------------------- ! Handle the elastic constants From 0d5860cde15ffbbc6d6531a9e84463f41882aa5d Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 06:13:01 +0100 Subject: [PATCH 047/137] Setup documentation --- .readthedocs.yaml | 23 +++++++++++++++++++++++ docs/requirements.txt | 4 ++++ docs/source/index.rst | 8 ++++++++ 3 files changed, 35 insertions(+) create mode 100644 .readthedocs.yaml create mode 100644 docs/requirements.txt create mode 100644 docs/source/index.rst diff --git a/.readthedocs.yaml b/.readthedocs.yaml new file mode 100644 index 0000000..95194ca --- /dev/null +++ b/.readthedocs.yaml @@ -0,0 +1,23 @@ +# .readthedocs.yaml +# Read the Docs configuration file +# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details + +# Required +version: 2 + +# Set the OS, Python version and other tools you might need +build: + os: ubuntu-24.04 + tools: + python: "3.13" + +# Build documentation in the "docs/" directory with Sphinx +sphinx: + configuration: docs/source/conf.py + +# Optional but recommended, declare the Python requirements required +# to build your documentation +# See https://docs.readthedocs.io/en/stable/guides/reproducible-builds.html +python: + install: + - requirements: docs/requirements.txt diff --git a/docs/requirements.txt b/docs/requirements.txt new file mode 100644 index 0000000..c7b727f --- /dev/null +++ b/docs/requirements.txt @@ -0,0 +1,4 @@ +sphinx==8.1.3 +sphinx-rtd-theme==3.0.2 +sphinxcontrib-bibtex==2.6.3 +f90wrap==0.2.16 diff --git a/docs/source/index.rst b/docs/source/index.rst new file mode 100644 index 0000000..f4336c7 --- /dev/null +++ b/docs/source/index.rst @@ -0,0 +1,8 @@ +======= +ARTEMIS +======= + +ARTEMIS (Ab Initio Restructuring Tool Enabling Modelling of Interface Structures) is a Python and Fortran package for generating lattice matched structured between materials. +ARTEMIS can be utilised as a Python package, a Fortran library, or a standalone Fortran executable. +The Python package provides a high-level interface to the Fortran library, which contains the core functionality. + From 78540e1e9dd0572e67239f6c5d1842c0707ee27e Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 06:23:49 +0100 Subject: [PATCH 048/137] Update requirements --- docs/requirements.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/requirements.txt b/docs/requirements.txt index c7b727f..050cc9b 100644 --- a/docs/requirements.txt +++ b/docs/requirements.txt @@ -1,4 +1,4 @@ -sphinx==8.1.3 +sphinx==8.2.3 sphinx-rtd-theme==3.0.2 sphinxcontrib-bibtex==2.6.3 -f90wrap==0.2.16 +# f90wrap==0.2.16 From 0fb27a732d89be428acc5ba98cd234b159de07a6 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 06:34:02 +0100 Subject: [PATCH 049/137] Add docs build files --- docs/Makefile | 20 +++++ docs/make.bat | 35 ++++++++ .../ARTEMIS_logo.pdf} | Bin docs/source/ARTEMIS_logo_no_background.png | Bin 0 -> 50441 bytes docs/source/conf.py | 84 ++++++++++++++++++ docs/source/references.bib | 0 6 files changed, 139 insertions(+) create mode 100644 docs/Makefile create mode 100644 docs/make.bat rename docs/{artemis_logo.pdf => source/ARTEMIS_logo.pdf} (100%) create mode 100644 docs/source/ARTEMIS_logo_no_background.png create mode 100644 docs/source/conf.py create mode 100644 docs/source/references.bib diff --git a/docs/Makefile b/docs/Makefile new file mode 100644 index 0000000..99abc40 --- /dev/null +++ b/docs/Makefile @@ -0,0 +1,20 @@ +# Minimal makefile for Sphinx documentation +# + +# You can set these variables from the command line, and also +# from the environment for the first two. +SPHINXOPTS ?= +SPHINXBUILD ?= python -m sphinx +SOURCEDIR = source +BUILDDIR = build + +# Put it first so that "make" without argument is like "make help". +help: + @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) + +.PHONY: help Makefile + +# Catch-all target: route all unknown targets to Sphinx using the new +# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). +%: Makefile + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) diff --git a/docs/make.bat b/docs/make.bat new file mode 100644 index 0000000..dc1312a --- /dev/null +++ b/docs/make.bat @@ -0,0 +1,35 @@ +@ECHO OFF + +pushd %~dp0 + +REM Command file for Sphinx documentation + +if "%SPHINXBUILD%" == "" ( + set SPHINXBUILD=sphinx-build +) +set SOURCEDIR=source +set BUILDDIR=build + +%SPHINXBUILD% >NUL 2>NUL +if errorlevel 9009 ( + echo. + echo.The 'sphinx-build' command was not found. Make sure you have Sphinx + echo.installed, then set the SPHINXBUILD environment variable to point + echo.to the full path of the 'sphinx-build' executable. Alternatively you + echo.may add the Sphinx directory to PATH. + echo. + echo.If you don't have Sphinx installed, grab it from + echo.https://www.sphinx-doc.org/ + exit /b 1 +) + +if "%1" == "" goto help + +%SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% +goto end + +:help +%SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% + +:end +popd diff --git a/docs/artemis_logo.pdf b/docs/source/ARTEMIS_logo.pdf similarity index 100% rename from docs/artemis_logo.pdf rename to docs/source/ARTEMIS_logo.pdf diff --git a/docs/source/ARTEMIS_logo_no_background.png b/docs/source/ARTEMIS_logo_no_background.png new file mode 100644 index 0000000000000000000000000000000000000000..1100bc9c9383cd452f91f0b25bc6153ca2a1d07f GIT binary patch literal 50441 zcmce;bwCr`_dgCJ1rd+|DybkHN(s_PcOyMeKw_kfj){m41?iIR7>sV1DAFM{8bm_r z?)Xlg=XpQl`TYL={lSWR@6NsFoY%>_cbe)7Bt&^BQpYXCR6RZwLKEYb&dvi+%?D`3ybH7yZEY*Yls(M%5DUO3SgZ zq_C7^rFA{ASEmSSX!VZTTpatWNL5Vqfa^?b~VSYxMAdEQ+VPK|Fes6ZqY_ zrKPd3aml3qe|^Z~?$3}Lx99zKlaMhG3xM&^&C_2LBBXh$^3YIAvmviWwzS-m9uMz7 z6hdKuCwtvcSRAELUJ=#L-P3n4J)jy95#~yafl|G=tH0(mU_HPP4j%2vbcFN*P_9zi zDtpOnaK!;poAv6|mG5T!s0Gz3KncMHfd`yTn!0z`54W6kiE@F6Pr?iU`e zm!!>Ji)m#Z&W6Y3HeW|u0-+()M#j|FD&QI3s;G@6PJ9kF44(fHfrr;d&o~Y=M;(eR z2pk3DoWQ11K^+W~_}3qoJ*YTw5+sPo4(e16Aid*SfM1}3n)FvnHbc#<{GWBmiG3AT ze00enY5FclIXS&D3aOPZv$o#Kc=Sm!(P-+^zPND?PS18fhaE-dC(-qY>3uIw`;QC? zu=OjHNGd(lBe!*<-Q3v)eaL8JsQKh86G)}uh2XTKV-&% zHp1#VgHDbr@9FVt1M3@nKJt?V*Fu^e*_#%Kn(*fO$1r;RhvIT1q2Bp5xp?UjuC6MN zq9S{)l20NpLR~kX+M7a>7jje8+3(2UpX}{VNb+zseLdrMTSo=N87}L7`DrHJcg7bi zbrtTs@#L4|mMAUo4fx|KCq7)i<=NgXZ3O=e8tQYZ8>0w*N0Ez1qZMnoyjIOhDIc)$ zJ>iJ-mS@fK2w%CspoznqvAh3Kl8-*vqOOJqvt^a;pIiFZn|oEeK>E1dSN2Vi>r50H_y1)Q)P#66?U#~VKXizz zYwvftI>$j77yZkyv6Wh9rVb93iHL5iSRdy_kXQdloiEqSgWz?z>&ObD?~u71;frNg_{>CUY&8$H_1 z(4YYL@gvIHy6z`B#opvGa+sT%BwoD>O~c8_SV$B|==)KAy-AtC*Y?zJ(a>p#Kdk6D z@r=~hBGwy1GFsA}o-;*WyJ3NasiRUnxUqWNtn4k<a+FBg`u0vU{>ynKXp~-I z8ctS1mpjB!%V7N z%cukBDiqS8lqOK%kF~cq)~>!+>lZ5>TNu%761+KdouTJCJ&MU{Xj+e;1nRf42+KX?lYHBz{U%ZP`teo}4`dyC>hEbkbo0B`{ zvJby;O+Mbw9J`J_0s3#QQIiK!SeTq=?$3S&UV`glo>kE3 zE(NxrMWH_51A&*FtA!=%T%&86uxb?l+)Qw6Z0)NXeCE17FXxM?wJk8&)BYN{Um(~2 zx$pe~+MbORm3s8@z2%_SwEA)IQ^Pa+f#30NU6}Q{$l}nx zN@+>^+?)WOjb6ac8D4wOKSLPO=NOURw)>-94`R*gmzRHVxiN?-wlb#E3*c?`(F z-oRDY|0YfF*r-_Vps}H8H89_kF?M05dgjM(O`LAg^~0JXRG_rN8|T!Yo*Uj&*O)Ne zN~v|+6zvZQ;)%p(>~*@&Z1{Fu>v6eFiq)?T%>lQfpNKbw$QA{>C9& zGvAX^zyGe76+*Xkx>dWI0;vHr`ms;~ zK{%W^hK^S6&dY_hEo!sFj76bgpOD~m2u;b0y^OdBW=t;4%gizk^KGVC&!#=& zxDmE36knt}Gn0I3G>pAyXw$6q9bt3GZ5Nt@TuZMqzDwO0t^A)|w{dhKaT4!7>4OUk z7YNLDPW)8iJpuhFEXmQMeXcM1%2uD7n+c~nWZY4M*ZZ~-=4`Yz^v^ZIr|-YMQX7e# zgAc95??IWI__ty&mY_jtd1XRWpJG>A3- zw${+41^rP+JrdCqM=I;UqmR^$|2b)D0Bd0^Hh}kF4vDQhXZpoQYG9z8rr{NFrG=f z%SvDuo&h;gTK9Q~g{k+muaRY)_x?=JkHWToYyZH9Aob!DMZk|A|Htp;syaOT^X=#0 zw0$WBXy-+nz>Y8G1!9iiFZ_~=cbe|kD|#%J*K_m7stEgd4E{_B=}&YLAT)om!S z4eI+O*etX*}W!KR^@q2IbjQknW);3G>*xfevaeluluTrrB2xt48h?9aw-&-L02T0lxx0oVhd+)f4 z4uLcA&b=^M|0@%a;c}X8$iYdzT$YpCAZhEMpzg=vX49&VFpUg0t}odOtw>%DyBmB2 z*B?h>TjSt#qirbj&;DwbQpiyRDcw6-OzVJ!O);vZ30OGUu`RQAbNSnc7}04Ia4=fjNI?4E_tX-?+tsNv zSgy*#BS7viR3c6eIw|#P3iizNdqhLSnMBc2qKxrGq#(S&Q+>#d)AvcA)0JsbRk*9( z-84W!0`;DrC&cJ%Mb`p4(Eg}HjDBl(N6+O`&XRxD73#162~@vI#>ETrL;}%_%#mKq zuDy*u;#-9)+||XuZz3J5RSy_BLav+v@Y>6j0~c6gP=3y$bTHa@_nk5hh8c~+jb6p; z8d}$-oYej&#W=4FQXk$olna#BQ?Nk$3Vb5%wBvqW>6v}Mu`u2fm6Ywzl4Vg__rP*tMqx^PDWAn6;9^Xc)bJQRQTxL|g&-y^NFagLFPd9A3f z#Hy-u_pyfR7#V%5E=~h*A3mT_bEbCg0m3lk+%emBQ1-zb`HuhHA_}(|?z9o7E zYiEO{3d>BiN@H5AAJJvA8LXNmEOE%(NE{brS~23c{YWOxJYR8iNN&2)7RqZ0p;VE{o*=;WVG!bIuq_2WUmdOI^Lfu>mO-SwFt|RaG$5F z_ma~tMxC2X?!396@@|R(X1Ikr0K8T3p}CllAB)IUZFbUV={Ag4 zrdU*!-j?eGv0NV7g8xCf3&ed(u2|@Wx!5mx!y8vDv7&aGAx*s!Ib?Gu!t7ZIiM9il zPyD@AMj;1v7ak{ygHcsw?4mHd`&o8Z^tqpn__fVDSG)>FM`&gxbO2km zznQa#%b0zMO1u<0N7O1S*T0rk`N@>uHutzVpYU<~NCstB^PZ}%`&j;*zUP&QpG;92 zC;f_X*EU<&9t0uXf^e!FEq-z1h%k18>#6R*5!c+-HJROea_G_V1Ff zwPoKI&TlyK;ROB}RnIonE^VB{4JH9F7(~}UvVk|O32LyN z=N~q?@HVNE>@e%`f4KOy85Pi!Z~+zYPy0F30= zNiG#HHMRR@a#LKc z*?ccUh~2R(uClimxZJ{m>5VY50*DJ!QaND+_x8^Hoz=S|^A@eiE0t`G>EmR#9dIy3 zd7HIAokKE*jqdf(&Owq9sX|-E%99Zxh-^(tRo?!cdU;6cuYu=kSI!1`f!o_3ZWk2s zpl^-HZXQ4_H!9Hz_A;JND3ifFlJ-ie=v+`()N_?$!Jql3kBz`v$OoM>Yjws~OKJTG zWP{NcR#+ZBSCY^ta!xi@P|&^yrBoU}Ys^95(Qwxix^HsM53MWYj>u;6(RrmRa4Ue}3q;#4NMwRaB28P4|0 z^Tc-*<7t6#qNas@P+Too5ORSOXu3#vmi<--kjB=Zew2W#SIHBJ?q*_=f0UwNrSmE^ebNRcd9NDK!)e47d&Y~hj}_H{m~)()`?WD|87AQ z>h@z5GYk>H0;m(O=B;*;U}bna_~hDaxV8eqTPLZNPlh5|X_h=NH@RsHiXK4wbag)& zhG+Whrf3^?bHi!Lo|&_ua+`+s7q>z}R539#EfLw{T{amOpc@W02LBXW`h--p0;0q< zIrs9rl64rbNDLwOCVykbfO-HhJbdst>4{A%@c4_Y?xzgyS*ir*>vGYNv1o=x-RuSGOuP{;Z!4qV$OT97q zOPl8D1%Fue0l-f;NZ83-C*MhJ1VX)O7EXjAz8`U*%<3Qf48v#}yX9@_6o>N!$lmX` zh>FKuv1&JnN43&#O{(*b`xvP2vTLB~Y5jRP)QC>8!yTWd60imzeT~LE<+j3nXq%f0!7n-3#%>;l6;LPyTq{#w(J>vH%M!wvaLD~Y z|2M%{g44@{pi}F6Cmevj`$Hj}d!J`?J3@0YeJVz2Y|&Q4q`J>gxL?-Vt_H%)fx{4* zSy7vJqT0WwHc+*sQB~(a@-N%5ah35Fhj3EaUahx3Dw~YRrdirhy~g!PQ?g))prkvR zB?d!zkWZlYF>cv(`)mvssuQ%eitRr*|1J~2gmKyXh!}k!grI49 zp;n%!K;O+r{DgTlw{x#mq0+B@>c$mwbrX0i1KgO)RvksZ_l%-4`Ny@94{F)0pj;CT z9oeanmLjK<-GaVY4E1TxMcyxf#3%2|$BJ{NeyxS?!LRMZUC*}lz|Bn6$GRBE4}Fa{ zg4*v~i*MT+1%mCHUazz*4p5F7CWUA61{*H<|GtTE#}L=;yZsu&zUW>Fo5l#MHAVLO z<^UXBQ&H}^2>-!f_G_`iLEEkBU<^_e&1Qk%vhT?UX(g$}VD1!O%CQU_fB{=b+8J~4 zLj2QCXqXhyzYHCtd}^kbRPfe5r0Hd&flXXw;xO5$z-NE`@eS{bs?5AhyZMg6e}@w? zYKBOKnmwy_{xx-^KDPvOpYKp9y9oK-*p**ahavE?O4 zkHX{UQLm5;H`m=3juBIQR{6l?UQE}my$I=BFor8vOSf4=U!GvcenfQ(zT7t4+){LK z?E46(5+jOXG=kDp)IAWL|G;yS`eM)qoPw^UZ9JmH(K zm&HgaTnE4$m4kHB`4zBmy!@mylU><1zt_m`Q zvlll}K^lz}^f~o0Ouy6(yk7m}FYB)#)t$!EKGs=S2J~h1lXmU>q>fQA-qZD>!j$pO zYeiWEVEi6e(Qy~?eP|V`+JsLm)*kvr@1*9~WOQ#mW+gTav%olX7j)3zYeEiLs{g(a zUd&`*7U>5)(rcAJ(bp{rFt6S1lMoTah#43kL(eJ-@*wR&#Y-w+x2G@lKx(%sYBct) zjmOQItzYn2tGHwE=dBvZ5$@G+Z#{W;U@w)@_`_2dD%^e5bdA{k@6*kadOShpfy#84 z6O3o?fYUq_9_Od(RQBM_72jGpFiJBX)6ilbX0-<|;g$$0VS018xI!aBc56@DwoYd# z@@SGa&1a9Jk8NrtB&BPwAEZX#!2nOPaH(AVld_D--j|c%a59aUr}p1)t5os>^p`Jk zt-9luF~=q#OO150>3$0{G>ezrL1YvW@9N;KwOf2Td)Qsa%1&Kxop1$m*<-K>!%mK{FGc-qHccfWfFL(u2dX07#vVaaQV6;JsIa3_t>9#|1% z+W6Q(GStm0$@4|}8@sQeE9AHGsp0TLsHLG?5=J&^HV{eGdAFBt({5$D2YMX!${f(6 ze84SN=^wM}7I!T7%e|_Q?Zov!HaV}&NoQ1C*}&i>8%FNt8u6$g*oiH2`fl}FWA3la zG)6N0S=mO$4-&?2P@GNLx^^LRZEMjN^}sgv5uKOp7|T2){*<*x zy%Bx?=tS!w>cg;&0TSO$X@8h;qU@widye8(wq8In;Q-Y_Y-s>MEM3@Oi=wp!qwzxO zH6Ya1R5~0#dcwkf{-J0xT(qSQQE+-qEQjOK0KrdB?&^tmB@8KKPkhi$>2%&O^3o?YLYqV@|_4^1b`D&+meK1gw6i;h3%uZdlGW-C!85C7`b!~+$W zIL5IO(|3Vc+O%#H6*Ex(OTh!EdTSx90@6}4SjA2#d)K*9KT=<^xWY8)>6@F4Qbq^A z;X}PTdaX-9$QoRYxdPte7-yMU^1pZ$UE@_KtcrmoMtV-Jn<_{%5<%gWk<7;qqu~Cw z%okIJs2_8J)eFbL$?01KE$VR+rlq--rmem(s(-!I_Gsj3L60mN*D{&u%MEGKble9i zgi7czfA{#}@N+$nqutw@h;{)a8uFW>YV~=rsfwMA%c)suwdJ$m9+*S*`;7ld{`9rc zc}fcpScZu|>&92bQFkbDG$`6npuipe^YJH}qYs)*=8wlmwDuAXbeltf25jp3r`lUj zTB|9=VJ!cW+LRl`qX{SzjA7|2KbXN&RA&Dn)B|Juho(r+w7E1Am(hq~LC* zmGwQ>9z0mwm?_KJU#xfJ%54pAB465}nBUE4Iqz`Ep5toOf~9f_859*i)qSY@z3AV( zaXQ|rZlSQp3p@Bk@yY6qWIO7wI#o{yg#t%I?#?i@P{j#=tS~qL0gQ(E5v? zxy40bgN{pOi@KCq7JDPs5SnCfRY2r$ z;hu9-@Wf1b;ed$QhH^nYU3TGOuiMtK@BILpcyz{@UUxF9M%5*3&a+h-HbrU7>7Vvg zuJpB~V=ERODvAjD7tjQj03hDFDIGw>gv#Kv=Qj@!R6@(tU~ z>LKnO@>_Y-0r`sc&2bY=bf(!~nffz_rwiDYdY{$cuHpO~4w=>*{jOUdzSazkV^cSv z%|wiOd+0ml+=4$fdZ_(9|8Hh~q`|HaFzV+;)x`QpiwG>qe}d(3JLlhgTgdyU&MeIG z8%lIlpra8et)2j`pz~_1-zcpZ|8`z#6*R~StY%-8$XQ}vH5xjj6y*@oEy{Z;Wr0fj zyB52to@RP`VwMNaJ2|~JuFimmc9vI%s;8Tl#`_2&W!kqOZwl9KI84MN*Njq`Q+FkJ z9U`+xfxH~_dZWnQJFTg}T=vzxd=hmq)eIcCPg=0S(Ugr?(Kz`BMwvMfB~`Key+L$p z2&G$Wgv@Bg?J_sWnmXVF2b^Uwx;D|(7dvVMuT@Nh`DX9Wx;Xf*W|{PPC?B`2)arLfXRN%e7N8 z$?k2?7*!3n;H?moUWS%P@0yNMOehYr@w zNA}j8076+_5dV{$sf$AJ%=$G&B@Lwd!wO^bQSOJrF(YdS%9RJ?eR3!WYNZjBJM;HR zvT-8b(!2kNM%Z^*w*?V0Gdafz{an8B%ddkB5rYMwGqSFjyVWXAB)ZT)?El29LT%D- zmUsCA;>Y@z^9(h_Jx_0*JHJU(c3x@S0h1(C)St~AH~HwFIKl^^1Gb7|*IQ49JxI+% z3?|%mt~--ZUO7uzSR0?bCi;)*>n1};Clj0dY7Ed5W^sXVg0B%#Pm?aV)-YKy2r;N4 zt(Q#{EEI${be)yq^&9!F8~pTz&5h?d=Z>kFm)Z@bB^D@L4`(+yl$pBUwk9<^MP4%+ zaquMjV19XBGeSuUoj9w`Xes`2T0h4vm%YD$X4eLeMt;CQ9meyzAfMrhVBT`l7=_eN zRoKH26;Q>1%MWoa_7LOAxqC^E@fN?YRB3+7s(JEbJ7P!KFQRSgyhyR!Z`CZhi}Nqr zD?)*|C}=KH+)>H%m}pz-PFb$w?9Uo9@iO0Sl2i^Tp66jm7-sL!Kyhb}8oK1n`Qzn| z)NP&V9-sf*0IgY~tcuhB(wuok(EH`(7V2!Zw+}fK)^&&dpqbGb#2X)!MNF0??%tMX z1O@fpN2`Up-ek_9qE^27rm#@)9&~HD1mZ1x$rnZffY7zpdLrtk_dI>jM|!&|Ac<^I z(;qD-nc6qHj^vc9$ceh)?%*O}6N{(}n!@M0v(*I#H_ch3t4g2Af5?x$K)0K| z;=Fj9ziU?49bj$uF#`z#PZWnw=(|ME^${hRy#1UjIuj8yebOZ1m<#!<;>O1Uiu$dp zTeG>a+qC_wJ)U>CBNi!A5JtQaqb#DT<8Lw%4VPF_2G>Qm4-koN*Ots(4_4!`IuJfJ z(aP7@78V*lMiwrMuKndRNxi}CH83skJ7hijWXdWljkJPpu+=ipQ0zIZSjJ&@aF+uh z`N3)eRyh6U9IM^8k`QYWtu(NFnD;S%Nk`L!<1)=(Qv9BfE6aP7TiWChQ2mZ|vGXnG zaC;Rpsvw1UBSBeY)W;j@@CdtdM-y3mR>5z*ngUPabRhGNoYM|gOWP}&hIlsepFj$Y2PXV zqX1H~7aNFWc$%VbiR54G)C34k*=bxNP2dthXd=tBWTBIKYdgg!(%&EVO@2Y~#-x!y z)6O9CkU%aVNY|-;aTGt(m~CJ8RN19!ZUZ(!slhp|;|wbnojF+87ah^2(YlN$#HefJ zkK#@~YWys%7prDIJH2M|qyHp#z-NE{RFGIuJ}pBkD&=+o!nmR+XH?Y!bxxOoSdm*J z{4EJQVEe}IFd%}T-Lb~%z>GGwXc$D_8sTI+P!`R$6?2S|(Inec0{Puf`sQ=LTd0jw zA;~isZRBPMN2T1rt+qt<`#X1A;jnTb#3vRCo3`v4*BZd1gq%?M%sAzas<=eAjBMEi zC)fEj&xy2#5aH+ikYre66S!0<F&Hx|j;4=t0VbX{KTNdc%@Ze*Z`=zsgcAST@j}LrCXT*Ci0`x_H4jDXTdh znV6?<+?$p%vx6w=?8nu0_`a{ZsaLARJCfeeLsM=*}+-qi^R4+tK&J4kpn_VW!-k<%QB%efXKH9Ibn} zTXJ)#UU1B1ztUHp&A=+MC2F~NcMUzBoo{B(gaV}+02B6m7RP=@UE}N!AZ{5;e+Cga z51}L9to`-uJTU{jTH*{Jo!usqo7@ZcK7&+LP6?`RUn&D34korf%!PSU?dEOyqaezFrN{fz1-lY6V)q$@LZyI!v&zV1%HnRO z2l}h9IZ9OO^h#zZz6}n9_oPh+_QSW zj@>MkmJ#x|YO^IqZsQxJj1$#L(rkoT><<)aE^1qfEv^sP_!(M9-O^eUm=qP;EemJ> z|9wm7xfC+YOrp^Fcj(dF^%`wFT#jqL8X7gb{)N$9FBfW`W-D(B|G8e}i)GKrqo=B? zyPPT^=@=JyT}#%~AsN!AIOEWy+dC6}Cur}oPLRclXcSr-kNdv;+XZ2TYe|iu`xOT) zZrtcxcvkMJO{ORVG6T=Ep(9pTzlZkW$vNKghKoa;CP{g`ib-P*rJ0$pL8g~J-*2MP z=Qw@ruY9jDS9Ul4jzp&oZ;}g}7%MG{54S^BU%DsdN4=7w1qhLUFwL+)5s#Da$R8It zl~n4;D6nU+?bzRMIvp&iNtV!?E|kSaKE8zHN%F&Y+U(~Dj~@r{sULSKa4jirsMD=b?s$K~tK@!r_Fov@{#PtM-UXOim< zd*N~`1E;T>&l3?hKMyAEKKnn}O$9uNu351k`gB7zR9wjE0JZ>Ky-Qv{Kp`M+vu(|Hu-FUg}hPqmAptDFVO4b%$NiHll_ z-g|NXuXYF|FE({aW5Xz~Oqm?xO(;cWth~o~r1u$5#87<9b3NpGb4~f2qnx%MAMr%# zHSd;aoC-uZ#l5ML27-`$wyw)^-60c5f!8!iWCU_ke>3ExD*0PgWZ3RuS(L*;7Z_Hw zSj5H&D9pb{&Hjzk_jgzEyzRkJ#m0PEYi@udCCy9$(LS+}QtXpI_1;YlkWaSB>F14> z4al<>L;x?!8XZcHAAYx(3F;lAUjyCSJvuk~piA98oEFv&8x5&VIW`uhr%U8Ar3k8$eZlC#`wd_n;(=bVw*ai4N+i3_`$sv@L2cKyb0dRPc$ z%rSO2%Eql+HBM)UL+EZV4iQ5#DO^wFuU?q;H^`BKH}>Ybki_B1vDs`YLIGyPd$YCi z6ZA?#K?`#v!?D!$Y#<6@c=lm=OWO&j{&LBmtp)^?JT)TE+I^AE3gnrmX9=<=w3|5_01z6}ySY)%R<)&YhnpX;Q^2CYVWuVf{n695 z3)(e?yhm(Rny(Y)t<||D)qf=YH0bo={99UC0ZI8OJpP98WQu@-cT!|f(~6Iw8-uPQ zW4-h3j4_tCS@Dk93cd)?avFW90^{4?@~ipA)stzU^< zF&XVs`^<$v&OkVwk4s!MGNS8DfW(ZLhyMQ%j>;W>9)6dg33nHQA0 zMa}k&v$K*oe0a$cMKw{`&&e^zC1L6`H4*3FEFz{3{HytBwhBq2TymiDIXjhh&AEQ& zV=@gu$l3X~pD|~g`y{B#mkJX8H3%p~>;V`0aWpFrDU1!^tTK4XF~`%CoDK5pD5jtz ze{_B2vb5rC020Ywoa=2R=q&tVD#Z5$-Jl&4{VsIlhqB1j{CkuAo25GJYi8drv{m(V z?QrNxoput%0*{ODE%-Ok4nJdjpi_0sQ;w&V zPdU<%H;vYx2Tu{TwD!4~yCt&qbpcm65-F8po5tfwMtsYBq>o&CtRfp|4?91rB*)$U6a$M&@r%Xmk}O*M6>r}}DY^&~E}oQT~U6sHWL zw2g7Aut**6wSJev%FR_3dWj!lfot=%hj`Yg*XYE@a_En8^bZYq{P`^a#u_9e_i=Vh z>w#PCr&awMOhE?W_nWC+4D@ZVpJ#05H+Jn|qv%gGbD9mf;EMG{a9op}{Mf$wPLGI+ z@1qizKFl#-hdr1bW@moKR=nEfSnPRVpa&p8`0?q`AxOUUzIimhEKl`i6E z_c~Cc?gjg#J>0-GB5K%_=%AxlWY!a=iDTK?x(93?>1*xSXk>41M2_8jF|TsJ7}b>1 zkkKIGzD{!|aFVbnBk|i_)B9(QkWhm99-{09DF*R|4|7z(p>cd)zq3Xf<(hJO=C!nD z{;KCF$)de8)l1zuEaCBYeV{x3N6&D=?;E*(WKwC4*r{Q@qrLE{_!PcEWcA)s0xX>J z!woFYvqx_z=8qIwmx&BQ&)kONGKV0EC*H*}k<^#_-3BxdvzSh9A#@-L%zdA!$lKo| zdG#o$XC`7?%lN5`_%qD|WqjX~9 zNZ9oBq!G2+v1^rwQ3Z!D;M`yHo?!UN#3k}qz`+W7B-G;d$TG)DIwYPg1GjwB#U1Fz595(T-bq0(-=SIoNQKs$S%1RCQajVlm zI`V!l%<1>q`w#T=UaMedO47_c=xWJMg`9nVu=G`t5IX>GUw@gWvCV$L@_^}6pZU5W z-^O?I6HZ^6d6ZpdMQSy=g-hQd_m}Q-I9DN2HrT}WnG+*#doNhYKUep$WsA7r_lP)Ni4BP?ef?s5u7`li07EpjV;XDQ{>x6}Oyws303y=4k*Gw&2 zF^SXtJIl((>6}XM?#}wf`U0IhLbIjsMP+f*LD#|_Y}?)a9ytxdJS%=S!B)g34z1oP zxty_D^NsH*1Bt=U6h5N5eV%CsTw-=7pm2qqx(U&_05Z2!UDv5y^TdbBTEnP z@pssf=cN0wvNTY4LrW~zd91s7GN)rlzBLvG!CMFbH1~&BObm>F%RXTAyKF&3N<&wo zb;iw~##HsqOWc6m((a5#k_~^W?(lc`)+rF$Q**`?><3ZT(>*?&+u9W3ZQpTjRm8J` zKzYQY_if80lf=2{|7wYtMJL$(TNaYM!_Qgt{GVV!<8jZ6_Kt;a8Qolj&714cxpbvT11WIHRD_RCM7znyFjFHNJ_y z*?rfNqy^sbY0{K336XMeEVTUG8yl^>sOMPCqrG1f*mLZkbnmynhw3KK@aCUNH)9FF zt#FQKCVVZhLFoFPJR>^9W;rRH5PT2o=zz?kv_~VRcqx@O+HJgiHrjWXTP=x{&(LjC zzYAem$DQx?ayvOMoyKiu=K_wTp*Wq>x=dV`OWcnKfvx}`q@`Q1n&$Xr(~AW|C#>a= zz-Isn_5Gc9*G~k0z2J{_Os|o)D1SC`lF+(hU42p_c3`l}#+s5|ZImJ0b&Dw_Y<53$v zagEZ*SCQ|L)fEYGK&^v(bJi#ciK|EUImu=3*a|Tv0K%>{ku)ySzUjs|hA5DbvWQIj8`phfdI~|-{*FF%4^D@m5 zD*px0JN4oafl`5&h2@xXy(hBtCz#{-j4%60+g}B)IegH`s@2g3PYChPe=-crxk2d3 zfvDat-luopsx|I>+LzgOu3=##TN7ViBBB<#Gy|M55a486zvipJE}la;(Uvk|AM0N7 z`1xhq#B5z)&m8r>3Twwgi96lLQ?mA&KsBtzpAk*>qpOq8n`7o!*11|R*d(aLV{KXvMKy!G##c79`7N2hPn?Y|PECD0BUTG=8X zNw7S&uhS{gJ0`Hw(Q$wp#Z}B@cgWF(H3JIS_M#{c*rzocifarls#)&*Q>xOeMs|8< zcZrHQaY)v``2%ggiHZt(>Q4=&9k(jO>5dw;O0!!Wf5`l$c<6YEgUBS?#$@`TXqDxn z7!(VjM2ss^*}Kq3;Yxhqb&>IS^ao5!$wQ#(pUW-&L|l0lrcEpzIdZ8p8b)REj8Ooe zeEsVKW#G-=@xz;~FM`#u6#ln7fcR7XebZ?}TACUbuD9sr2}i}5)?)E^0vtaY`>pK+ zj=OuHi;#cSV9@GE$o)XJ1aYBT-@yOPuUh62C%S41flAsEUryNE_tF3#iMG!Db9jHu zEYiZevP;xbXeV>Z>`x`o@!IHW6i)!;qw(H;=?T$=PH8?`wf;xZ9V&z&){It71C#aO zEIPhHs$tikg>EvSA-Xg~a` z|G#9D6(YTj>Q_XAeZF!aJJF_r2rBvFesMtTJbQEX5Irj!Ral0L;s1Jt$#iF}xqoe| z$4vn&K>eKvS^!}d3!>OkHL@xB-77ldX?{(GUu{tW1g3jFimKf$Fqt;9A4lVEV4yL;FD8t{*W}z}OQiaD zS)*EMGUgSfPvpYN2{lcb?lt^I%xEr2<+~>W)Jm#9503N z9*tRHRkQgQ&F-lGQ?4i5)ImaSn$BRCU(BNgh0zq+T6q*jxq;q!_a=L@!Ms<6CB|=9 zZ5n~dt(*oY>znwiKA}39!vmWErpkVgTF;13lB~X+P8sN*@+iuj9Z~t;1v)7q++J-# zlNt7MV_LM!z-R~^uBesdU|}=4c)!UmnS`*>!2GeO_UOR1*+az6VV7#Y&TZUD%3J9} zH}u7FH*NbDy^9+u_PKsK4o2PnTl^XOYmiW*;1yBpsF=@*v-hk80z7lkvt!l7jWH+Y#sBuDBWrPn<>EJG?7JEZN^X?Y zA@Nc9`$V98=IMHT@M$)BqfTR8ob={4*%@2m9P!@GHKU6I!TIPg7*IiZ#8I58@0~Q` z?|zHwlhX zI}5o8R?cQ$(j1T|Qkw$-oRi<>M^=5#RMB8-KOUxug$A6kW}&VD7s*NGhLD#T5`UwT zz`IJwIsukyh;*x%gOW3GtZdjw!TBa<&sSZ!{2#sjHcj#9)z0O6HQQ*$+jbXo1EkW3 zmvxXz!_MK&w(kKnL%4I#lX><3$clwp5n=CaO-GR+f(BA_t3Z)5DWy%H+!r-k0#H2H zW^{|>|CSHqLpiKhy>scfng;#Z|w*&+ZN3&^-bd<2^;D3009VP*EHx15S}~T5n_=) zP)$;ra|`6Q{5O`(euO_5m$|P2&7;pE_1vQe_Y4$zWt|x-(1&}Y_>v6D#Z~vn3$;O? z#O204TiZmN+r&<8P-uYIs@F>xG20N+D)D1cjFq{3AnfpIEAgulcSq?zd-v@mMlcLK zl3u4s%4@_*#rR2Kh__XO-++3-x?V-QQPE0hrvT%N{(7}Kc6(X+zg~>8w7+KQglRPj3 zGEkNOc4r;+FV$@Xf2AWttWbRW{YJSb7a1Fuq0DZGW?hc`viP)>gu#yuOaH5An<++< zlE)YYaweMwCU%mg|JtJZudi8H`qXlK@RPa$R1QAcfDj?l5a)rmuc!|qA>lYAicvbD zMcDvR^0&hAi{L+`jS$VS-LcOTRI|!zi(JrBCVp!(r(?)9^mhjp0xJCDF}WGT+$qTo zQ)knBXYn)~)G!KgnVs(Xe@C2!3Fna6r1(KegWw+YmK=y==K8OGc^7r`)m1OL(CUOD zx0S+slaD%*E1=O{+&I%JozMTRn?5<(*(4I-sOxcP&+jjXF(HDmcmuIhan10gSNFns zcv7zRlQ0Ba`qJ*N-NFr91-g*svz>X4*of5HI7kR2f%hG?c**(=7K)?fWWA>mvYfVC z)Ev;T`ZRdpm0MY}sjID4wMLTa1BqKv^X4PR|C75YA`w)r%zy|K{ypL^dL=h3Koqa} znxSP96i!vR?KHXJt{Ei*o`+WJY^xeK)aW$0)R4>T|Fak=cA{EoUw(+bWWL5FMwt|p zFT+-)dY%Dnw|_*hci_UWXfPf@+f6>A;KROK)9gIrxX1fjlyC2(UPhRJdg5h{8s~YE zNCJDik@#ZvVguejF?7;2b^ZbYc1a3J0YXNU0LBPH=;0;H+LLxlLufQsH)X-fS z4S%#oHV@UJe4zOm#Rq=#C0zyb2f}4*S{)wG80kKWo>`vn0kMSA>ym_ngjcspn&Nbl zuljLt>oOJZeVTk(TK?Yn0vD%KmqX-rPm9_avE{&r|G77Nc_4^WulqK$u^IwlmwDg- z)Ewd0)WnMHYgG0l;uH0~GyQz}$v&rhs`wlXM%C9en!a91PH`_^3qXXz#$%Bf^k_J^Aze)KZ$&x+`9*~>WN@H-u>s< zh41`Ks%sL*CcvYWs^&DqbuB zogE6y*BhH!F>m=H8quu)DtZG{j5R>p+$+>lRNw8trq|Uy5)ghmZs3W*M9xU z8=Q6hL|enI&(-1h=>InS)ysd(uQuo|v_7N0D&&$2{`GU%C%@Q=C=2X4hIHXIgP4p3 zFD~qDv*dcunaCCNRa8=Z>douG78+&#=W%i_;j?%zjygCP#j>iY8-EKT<0+&`&fS%r zej?fNgyJ|XLl4}()&3+fXYBLVK3YpK@W-2>|6(*GiDwPGUN2dQTQx|#ofO$1Z+y3< zo}9_0U$1Kq*l>Bf!G1Ryo1!ppKOCjNl#c_G-|_zUY8+|Q$hQgvOxNx2yA91LXd56% zC}GAWp;_JU;@LZE3tveuehgt3K?>S*M2}W{IM~&|i9ZnGsQj-h!;{tioj32qeTTgr z-Uhk&N&1_=)Ff)bjIipl0MCwParj?YNw(joq$Vh)T;(WJNUQUICpsJV&%%N|N2RfV zj-ic=YWCt!{WVheANSS1?Cjm=#Xqu#s5RC!2PZ-MX<`(((94pZOCv?#g{VJ!?f(L- z4YsL)E$PNy^>4!ZBab_JIilBb7(J#77m7MIWn0F`Q69w6V0NZ`s6{Zs=jDGfaA=J0 zIJ)6=!1tlXXk|tJtC}~o^;C3Ich#mXCD*x%emDZG#RGC%@EwwXPTG#{tcIcZC1;BG zPqhDH5yd9k@3uD||5*vFKHLoZIC`LwXe5vDX%Y7C^!lDP_7~jgMP;h6E;GfIv8XOt zrn~$wDQ)KOpZgC^w>uz#_a?HQAEMyl&bw@|p(O8SRtHASsJ%iMW7&?Y2_=#8}HW84#wzzuj}7 zzCRT4(i`S2bmUrCOjez>y=~R*sA6Ak%A7(IW<2XJCVt6b&yvIPgOmixU#4^Cj*pXh z!~t3AQ#tD8and^aq0zQ=-49@(yBIljV+^HU*TR4TajE8mxRf3AQ6OH}*m!|!3dn_X z<%SsO263O;u}b>{z8)SsTJrE=A0s;5v|l zCj53X5qtwPX$YIKZDEt9p08OF@n&voV{mq`D!&FisE zszVWxJ+0ruD!yn_!Ltrs{g)LH6JO_!zbdub~sb$0=n^hV@3064iBAv^tgz z66udWoH1qC|9$D*G9I&-$kw-7+!5qud=C+@< zssYajk=JEYmX&rzZyY`m!CL%Jc{Ig{2(l<355;`7-z(BPc)lmyG>?U$0zmWyA5HhX zoo+yUa;TPn0PRdt<2K@@i0h^}Y%?ER|NM72bU6%1ELCM1i|WtQ?w3j>W=oDHyQ zL7&o?ULi*@z5BY4A2Z7%lXCG8>EQ;NYtPNN(0D-Ri>%JV`e^NW1jIyCIsy{v;x-;d)z=eW z?bnZ8NNx4DWnv7JiWxK@9rH6{KXjCnJJ+9)LVBO1u(8~W&ioX)a5>s1d6{DHf0WWa07mFqxsvZDMa_c71z<(^WiU3H65-V@7T$XSn%ST3OoPLugWy7Jk!C1*&nUm7&Y38{C!A^vI3{Q_&X7~a0eCZ z_50y<;vbjs1#({+l9m&a6ZIu{+_*CVu=ZpI;UIHpKPy$D3#abku>zc=Ftm)Jpu9FJ zShf0BLPdgi)NBQ6hzjvG&=1J1yduVSQ2AcH!A`d$$Ih~bCI;jrXJkJ97dj}gR2OfK z%OS4~egvN9TiE+TzoXR!*nKEFz+jxjt->?` zsxWp~oY#-hSr2R$7~q+I2n&t|!vNT(J-5kIek|#JY{lx-KAiNf-I-gL1vnxco8c^% zAtH!xQ9M*wWVzLgM%b&bBU|*#e}2`2jsSVD4dyj|f#$7My@f;D-t%HMg!CR5JaU%= z0Ub(oVb(o5zOa7(84URFG5Pi4X3aJpoPbU+4R;h2cyoNy7faQshLEVd@kBS-2~(2g zvt$qXi-b{A6OR76_r$I8`3Sz6C^R-z~+dS{nKbyO3{NH8hwmW?z*xJ zzq{GY$Y$H?UaN3lZn{*3+VMc=osSj|f#oP=g1oqepl;~JiL4mZaMhjAB!Ce}-vs!Z zWsXNvL6>?G;ExJeshGeWE~%~zW8ainy|qg!ni>zraerXq-*rEN?)j zlI3T;Gc}QEbqp$dl(#X-X{(9e950=ju}s?j)*^>;BM9WJ@f$9sUIP_+SLNXwfM4_4-5r$1|>CTuWu!x7&M2!xTrg< zt$zFRiQN$a48fmTS8wOFH!FALP^Mv>u*0fjDYuH+{g9m^n4l14)hMn(`D#6wio!$E}BLeTi1U;6&yrR;@iow;#- zQbweF8l8Gaf3-TTLYjMcY5%Dz>oJBsu1F+_p77!GbF28cSgjFO!Ai{69iYaS{A1m< zg`QB!_iPDfA`}oeD(#Hm+JBIkPC(NBkg7U3+h;9^^YC0 zbb1f@dl%GiGv*aDu>lm2&^q7odwGYDSpSg)_TKNHf2pnwawJlU8lhpkacL-Z8n4rI z5d;@`u$0>fOu9nJ=Vo0(MKQ@Y@&4NT=AkX=jJgJ`2Jr#bmmO#4RcLvWTAX1t5dJ&B5h0F+Nd_rHSY?s;7X>U$>WG2Ad^B6s;m&2ZSh|xjANAB8XSHr%cn( zNJWxYO&rEB1z7N4nM;p{yl#IX*y)l z%adRJ6rclUAuN3)kB(JP`3VzCab|83Or3qfhdr6VvIA*pGOw!e$!zAS0S8hW0{13+e0Vvbb*zrU=OUL6SQN+#+p$S-Z$6eJb_2`k!k z^t+EGDTujHESy(5Ma5Fqh>zGqE3ji`7I(RWbeCmY?~^CJfbSLwog=+bEE9E@F8eZZ z;MXG+o}Y)Gb57S9^nB`?r9~R#;>U&HL}1)6NCJH?lnCZ`*&!|#*n2{)j!f1L5- zbs=?o*O_?ia>PaQH+ND^B|8n z?GswTI$7OY+nBzNi&QT-F(;CsDU?JWhl98LmzL@_4x?<+KY#qEsUv3IfEgjZr(B^a8$mp;->;@ zkjy!xFbVzv83fD%Ug|yO8ew#hQawA!$iDO2XL5u^CI;8x_JZ&#nq4%<)~0|GgsMGJ z?PKkz;m=qqPwzg@)AQp2*U$WXNv&5FS*+J;B)B(iK;tLFXTF4V76{`hkX+8E`1h%= z6b-N9;xib6c^38y@>R5WLQ72Ez6L6?OvFl-tyolkzRYrj{z^h(h)D?S#7TiMwpnFN=X@*T<6U^3|c1)S}^P47DHgCV!!?E}gSrB?4MVfJ^m0goxwB!_$$ zp-DZQlR-a%Pzy^xGaW-wq}3l~i}O8`t-K8pvp-O7SvTje0yEJhj;x97XOo5vAB@z< z$O5D^0tU?d6P}VaaVxF8gW{c)8)12YZrao3WmX_|;e?M2=M8P_!D}emZ}8QedKcAa zM3A5|Ol!hU9v022r>xPX`Q87WAgiyGEy=KkLTP#7Bt&TA(W&4qlAgRPQ?Nd*y}w5~ zt_G9y>R8P>*IbiOTSJPG9cl&1I*rr5!tl=#B?z95C{zg9GMEA;w1f!ar5Uy#iZB%2 zBKW#<#BMit(`X|ywhm_8;)%*Ho(5+56GLfBC6{-EMUl03m~MY5zzx67eZPAf*K+O+*4T!w(NiYw$=O|`z-$S8QG^z zwqs7YGZ&?QUPXkxt6EaA)3i>XT4y1YYNe)0Z9hrDD$nmwdD{}5tb?yq7oha^w-Yp0 zowZHTukZk)MaU!x!DkFdajCv(#v2QlEk;pZXZZ5J_?C{26&FRn-<~JGJtw6)aAxx=VxuJWt}<&IMH*(=Q`}a@^ zpl$kAD=HyQTMcvt)Ao*g%Mhv)M8nymfv(ViDzwtSz(TO9_lc=*J}qsYNVHEuw3~U;oPY{dz9kJL|<7 zT?SG(>-?N13GV*|A2mgX44rN<8IpIL*OsI(Vb8HKx|z2=@2VOxROVaj9?n_Vd{J_E zYs@RnBu(9MkKKYH>pr>UGEe`#%8wJD(HebcG?KvQO+DxK;9>qY9oo22{y0z!_@=iZau^056DE zH`LQn`vJtl8{GC`v{8}E- zs0{Q52HT1k?LLNDWptW-^~!(f^u?G+`bJBk%lPy4RKGoe?xv&|*Jpe=Zy=m&w_ zf_wsq0l>^mYRe7pEL;yFDARb7q5EWOFE8n%%BZe!OF&KmI2om`(7 zWm#}ku$YQ|%}?&HE7_xxzMUdZp=B?F{=M*(t)`2b^nvq<(|Aj5u67miLy3C(wuE{T z;`wz#&IoXg^DRF+D^jTHrWOa2XH}TKe5q;i#&Sf4FV{RBU230eT%M{nUN@4_*+`2t zp(h*{0BZ-K-VGm>D7YCDAfwPSD(pL6`UI&GoD*Rkqonb;FRB{v@$U@_`)3Vci@`HuVE z1Dj2wx#|fv-*k!Spk-+Ubp+^X=&LJg%o(*M3VxSlN**pXcKPdtG|8M^{dg2}TI;u0 zpK{EI^gp@;xpfjw+@LA8T7W^(K`waDBNtG@OkB`a8EQe>xm%uacj?K;CkLr-E%66% zMZWdqymNF|7f`agMvPdT`9xm3*OP%d=C0=8gV4Rtx9)0xIQGEAjN+7MF-G0qfn#c` z?UqFVk*NT3G;%EpnBbL5{(5WOJ(3rA&ad#DpWR|$IFn< zcwNzq5Ysbo3uD?0G+`clV4u*iaQ2={hf2RqjSkE%5}Hp{?;(M*KLx6j>NRIsNoh~> z1%F^rFn#T#I!w4Uf(T9*OfEx3Rw6Vn7uFE?u*VUIKTD;mkU}388if z(h}-pY1L38nF@Z@gdAbGgWt@pmM|1+<~v?387};z&Tx!3t8!%tS4r!KlD{hm4WSW$NgrV#2ST2KU z91{eS@xS_(fPO4Qo4!Y3_K{R^y|GeDGwL=KoF6d`G$kifxg{Sb=L8|N8c9KyO;hR> zIA#9*E?zBrhpN!-C4Z0L!%@~y10qPhA!*BRa!4+2zau?xZ`3IV4;nh4isr&!^p)fi z)I!&lQD{*rE0ik_<4|=5n^q%{`dPa{snSqxpP|dq(Z@9M?>A@wFCoReN$dl=tUEEU zZ7a#?ZmJ)5fjN{F$v#94sSi~)aR>jrzv1%&fXNDND&i;bdBsb#T54SxoKM=I-T83* zeh(ce9IzsM^W4r`%#Mt-q;$qc>BJRvpRrktK+UP;cmfgX!v?MI^~+>0juCrPnN(!2 zvM?+iNuie@ZMUrfX!Y2#*c;jo$KN;(QK_ zuW=Ss%Q*}~3;5Q909B`9tqK+HjbeID%Wp3&u}mNY2KsX&;d!=37I<|ug!puN4lkkE zxeKkWa&bnI&48C+<{+xQ6F9z$gGyKM8}&_A$-J)1b5(UHnJGd|f??3ELe9n<)L(`7 z@TTCYQGqPPGvScV`HPk#_fa)eK~bZRQac4#xf(N{)3v#t>?GyOJXv_%i3@OBI}u)4 zN3vHMO~HZqqFwFjeR<}ULypd=oBqzF{Oa@>#T0WLSO_;b2LImCe!i745bjJ-z1B zoRiobNKvjvXtH7h+1f-VK+@9bgW(slgO!-Edh!=&wD-x z&d>^IK6Ow`Y1}Aby7HXMl9$Hq2tO4#AHZTM+fV8wiAi4pHRX~?yz z6D{>_@ zDOzsGq58;2q6QvqjPm$NHwAA1t$4{6fAh!iZKn)HDF+f$RrNN`L+iW!w5@#Xgg%mU z$nu7KK|RQ)jp7+VvFol#h~L2MTh+A(&z2>Xj7Iu1YdpUQE@!Z6^Yu8P|8$UHWT;Nv z`%PhWuG-3O-rj{8eAuV^0K+`O2RY+?go<--0IK9q2z4~%C*N`Vj+K>zaF!L5`&L^j zQF3{DZ$NadFqqKk@Ir z2jFO_Ni)#IPPuzPKOxsAUBdwJjV5BV|7ZnpfXP1Ju}leG0wgzwDGe6x#_ew6HZUB+F^! zC&3_|9Bsl}Xq(1UbPc528aa;p&~=mAe!bIL=)hISC{Y=bh@d2u5%muZFHONXL^f{? z80qfYTHpLycU-h+pQDtai`T(=Q*?TE|MaAB@O365T^$tqzNi zvW)77dcYL|%6aLp6q>v_i_PvSt7*iw@ip!wI(lvlX@so# z5WLCb^7}mg3^@AKl=QoXz4z*+!(eUseYhWjwimhOJ422tm>$v=@Z((}mKdYX*<5C8 zMu(5bPtfn~pLP@$k{~p!X3!JQG#5B(`ZMp7eP_EqMAI|mJ`sjxM=^lP+Fr?40L6lz zK6aX~a$fEQZHT`pDNn6KU(I6FOt0|7mKl3Q-yLjPihUHEm&Lw1Eah?QWGVno6ymLY zI!nQ_ZT)Y|Z8+ePvsu^5C5m=TItCV2bLwfhy|aoL?Brh)E9B;4L2$S}KCmj$xIQNp z!^My2wu@UXq0{r{^-(3YsQip6Px~bnP+@e6AMKD(z~qN287vy@gi`UVjJI#!nTnFS zmf=*vvdnKyJ5a@HjX+IIg7Uz*&JX@jX1r@s+wT&!wCMWwJkvsG3DA;Uy?Eh(GBs>J zjkYaVv?q(~#fk(pT9)S5)?w^?6BU=ui(FaptwkI0d?NbsCJ2Pn=) zUwB?8%oMTsMm)sHlr*E#H&J=fav@{0bSKhLT(87+nWMtTGI72H)w9L6=Tqw~U|m9I zaFj0lz^-wiG+y!ygv@5MkDK^YD=z0QT>F~943Z$lyFY|jI#n4bu>9uFR~RTui&x>I zP(!maat@G0^>x;Q__~YaYtRp@6U&1@Hsp;affo)npgBEklVw)$Z`8H7AAb@#NF2Ut zMAv#+;;jMD{(>?E_@S-VC;FakN?t-tMFRSjHZ7zDa6c5o=4eJ*Eb2Mlq=7DTqI9A( zzb&_2q*+jLQ%2mKmgF+kAmJ4k@C!1~H=r%DyAtObInD2q!W(($ZNP3YaVmkD!e$?- zuYq}2y*BYVgKZBe@C04v$%pP}juqa@u%GTsgi-M49U+MJRi!CA94+VSQRQ_jy` zbu2AMp?3A>1cf;nT8Eml-8TS8NbGCwf@?T zP-8ZBUidp_Hb<3dA}`xO9$G)m3_iA!!3>NJ7W$tCB+OGXQ$$w>-5@g^$I)v8=iUJ) z1i&-a{liOzfL7`m;1+|VXLPu{iUgChii2H-JBtR-MMI)0J&&M${7-(p(bUrId>-n) zZ2Igxi)FO)oSz~j$LND+oZGXqC`&?`(oB|L5XDj9MJ~$V5pf&%E`Ym5cVUztQp?4s zR+nwRWxSjMj&T1bnNw+-^((hst;C9F6*_2TK%4B7UKgzO-QinCBE4l9?uMqD0aeER zB1@&suxwfx@e|kYPw5KhEvT@OTPh3d0HYpelRsp&;3Re+d##l*{C-s3D6xkIG)rYs zaBC)MWx*0_KovA*{XC5whIe4)o1j8`-1zdOoq_W2MdY;{!<1jM1>TFh< z#j%wF7Hd|`6Qm3Dw24o8u}<6pcWg!VlKQ7SNhzRPw-=>>PZicOk~wbW)`dGf3k#@d zD_o6#I<0np2LghY-_I2V^cE-qD(=V&N;9}#1Y%FY#TD=q*CS95S1gi=1&0ZT-Q{1&xy6$#AM8DhC>m@-8ow&K}$PC>zec zv3VX&+xtZK*}#!b*s~W$iZ3G^-|q)p@bC;xwzw?cM2(XRq*Qs3@Il=J2Z`=wM21C(mhyR&0N9+D zn5>J%S?PL~uG!NwgBC+fx zw32D6gLo)3ECp~|L>5rR%`g^GC2`dlR zBJs5Qxf_+-xkBCdlH;*|QD33#^ic5+IY~uSMi}a?>PhZoBf@9i4;G!gw-ux=@vyB= zb@7CQ&zavOVCfcPqfS4I`HH$t4v{ezCMFxCijjVb&Y=+E?r*^U!gYL3X0aAApwf8p z8587^>jhi#s!dvd4Rp}ad=Ot45Ou1+g#Ixztw(&+UWE)#fQ_xenkVrTNZk-B09kxk zoQh_edNgXx7gA1(Y$8SsqzF)%fhE+Ql@OEbv|Wr_AxGV7fwe*t)Qn})ZDH2g=9<+y zQCh~6Tz)!j;)lrlexnSLvptgLM~H8{XAuYVG8!lRxJu69n%z$A3CfQowGJ3%yp{ZC z++rEi`UbRZ9`(HQ5^YIekZO(QCoLMG4 z@%A^5`eobxWNd>D^>+A74AUTBQIwZ>^4xng*xX$Du>$oCSLf{#2NXcwTGfc1-f%!q zeK#3}^)OTW54TBrlGUkEZr{8VT zMFC(Z+c%Nhk|7=o+FsHOrGm14!#reP(0rsrF&v1PD2ftJ?#x+a<;Ui> zvK@kJhTMA#KhT5RtROJ7`tgw*6db}Pd7xcW?Mdz|BmVcK$1+r!2&*OMh@CgnN#KZY zVSk@MX|HP-xB+>xp3~fm%I-75&kN*n(()qWR|kN$g$Xru#g*;67a$>!n!x*LNedL8 z{+gt`8*iv@t9#t@v`#hp+0l?&Cn+lt$qaSzQH*fq%b?*O7Nrio4vR7=z@q*!RcKL1 zJ=ap(YAs6(eE~-42UAIj=RK0BQg_x;HlIf;W%rxE%&@>f?F%2vnYTW?4FsbpQ^eb2 zz%3}Lk0xgyjr#FNJYqt!k>F)#>ruim#5VeJ?Vd8FLK&@B5(~vhu`|YVl;>;gM&VNm z8aA{o$H|?606PpzeQNS$zLtZ%hcQe4{4UG->B_ekBZ?@ z$Ta%9@_FnNH$vPtMmLSo#Z~R9ndr&6L?&x^S9%azdT(pgqV(YdGr~#8MhYAHjxS*{ zg6T)Lia+}CJYBeeC~mv)<1>_b zXs7zDB=z9&7SEu*Q>6hu^H0G5y}tsz^H}Z}zT}Zb#DGAbFa}hv{9QOS%3x>UIV@mxke)Dndw=YAqlcFmY2tJ!AJU*~bDeB5uVkJY; z17)nJoR;%8H4{CFpR-7))dkZ)MzD7XRI8eDMXvjU4@+q(AR`RjPIYC8Y^{@p--yUe zc^&&%k6aTa(x~HGq=yi?Z*U^GI+UOb2TV3(&4@{Q{oUfP3H`KqenFVdOOS)h^>2fA zGE4n+^QDg#@WB-Z5W}rkTzCGSR$He+o2WY2yS61d9I6oQ{u%^(Mj(0raN|3A_&i-I z=ySj0bsCCoJ~|y*MH=Y1d{`En#Q*s%j9si+>4w~GJ!78QOBpiaraGWqbPQ|Eq=X%t z+Qj8PvKs7@F>NhfE87w`;4u)Kt6z{EQKYb{mruW({TYnA$Ns6Z_n_l*3)S@v0;~-@ z7T(0Z?}Ne0$2TM3Lkkul=|EGQd&w5Xs1)%!ZaNBK)%N0`)Pod4L#6%d9h2IH&SBzuVR zdbrTt#Lax?jm8_)DWWc(txz;6pQ@u#l^gVJ4L2lp#|BMj)( z7-ff(FU#c&xE#i!?lFc2S6pO;DHOl<=<;UJ=`F2e*KcJ%dJaw<6TDEcbXjS#@}zbG zG<%Cjz<)-**jwAK4!zA{oyb6W#QjPcx7V__Pm3GnZLVz78!F|h#r!^nvw;c?kG8Ut^lQ*D@dWiu9GEWB>ORFFgr>40AR~G z99Nj>t}vF?TLeiwxfzVj(m5KgIZFmZFCx>10xhw%Y!k=#t_79@Vo4jkYbpZ#UF3bi zqJr)WGoNU8>O%*vg?ofLEYoy4gWx>d+Hnpj=H(zu^!+&7h%BgCUvk2UbKYS6siIUO z^X^$iqIEhWaDNz~6w^bF<|+)zAM0ovEkzC=L1)nd3AnB5{e4zkjqG`w*CwD^4=bHY zvuZyn#xrlqW*@pJXH{!CATE)LP`wJcutuI+KAjEL*d31!1dxY^Cw-sxFvI62)QFay!ro!t z{OM->&D(+_%(DhXo;IwXwl)j|m}P6zXotOJPvSwK94LbnAI#3Kj1C$slVXHg+$1KO zlVL_Jh<0lPyfpKYfc3S@KMHaPh8DtW)vYt&_Y_d`AGG8HcTR`Uj+BbWgwA`hQFJ2j zC;_g9{&HPWrT_AG8`YMqs)@!2e*53%7hF7-NbK}7c;TKN0TKAsUKZ+82_%FTcNBm%{Z#7A#G+mu;V-1j8kGaS{PZWH{j+uID$a?i=oA>)<(VeX@rZy6u;l%WoRRi{0rbgff8DE|NW4f9l10AQ&?A<3k8w zGlU35?C*1!HE#B!8UvUU9~*{Stvz&4bsRSc8*%idjVeD5h%>d)e{6BaN2Vfyjd;k} z+1a>j$+HH!v1hEmo=alc zA8ALKEa4P0@-9vc!}jwV13ntGKiMiQ=};qfPqL(Cw;J zW&r(aAw*18&2_J_U*6p$ru7g0&-nTA1k#dM&QF>*hgNQh2}eb#asfX~C|zE^RrqLN zx6d1Ey%x$2P<^DCyRlYxhx!iX9}e&}@vD`z6|&*125M4dtIMfQ5LqNQvDU96wyH+K zg81CIW-RbKQryHcmbr38WZ?-D4=pEuYP=eV&lczA_(8`vT0SpVRHJxCl{F)I#})2? zV%u?UHFp<3VZ=0DLe@q|e*%AH%QBG}!qX0fpFN4 zY6AnEJJ(Lu?gowQQWVCa@YQ6baUUQX^MhG=cH_&coM(=S-|6eB`PZ~Ev>WO_9&8E4 z>3=xjA(YVFXo}TkXZ5Gq;m0au>54Jk&+MdBArX~H}Hq9gUMw={MM z47NZSL*HDb+?)Mw88k!3%QYWlIOAsTbXXUB;M~mqxHMFzWEv@ZdM6eD=i}SZG@z}@ zJgArV6Gx?&^1yJK_=)8tn^|(HOmmWY2R~}Y#!``P57e?}2_H9P{kG5gf-3VBIt!_l z4Q=XgE+A^^Rz|YoMePU+b)OtP3&H;~*h6tD6dh-biLh7h6Fa&**+lFta;*WB$`dot zxb7;u%3jec;N$;$lb~yS{e!P~*}a^|7ZC#`wci=@r{WqHKlqQ!8kV!j@5noQ6&=96gl_2PRxOY=2j+cxK4?5P3obl8-G#CAhos}lgw}Z zg2FeJSzohGU(Kv4J$0epz~+D!cc7vbD`7`K48q9qnV3{vH+JZVQb&zXI{97!-duop z#cd-ovrnk;ZTTq=6{$@+uepqX!N#ywkd%8b@_9cy0>&XloCTiI|17O}tc~k%_WnwZ z^|^b`C*)exji)DY1Tf&cKqJ#}_I9-8P?=WN?+pWjNjV}nHC`4_g@KdnbHxH=CiXqG z&!TPJ}IZJ-(?lw`Lf{+1=X!v!!bt z-Z<3qwCvhMBrGNi9Dgjoeri|GNbp^(wP2621AQ!eKP?B4EBRBq>J@}|m{6DhJ%}6# zebO7b7UXk(e$U-|7nDO#N+h`H4wApwBae4t{V42&6iy=T5N9u#jht@g_L^x5mb*nZ|7H+~MZlI&b$NSo?sC9p=BC6K0?N9im* zk+I2N4Adz;w2pK=8LE@++T1LCV$rXC`s}BhXxVTefdZMvY=v79)qe@}qW3aC-47wyz@cLnoa_rwhtqVw~1vTk&-76Okwy>bJN` zqmK$LXR)(ggxFiknApl(-hex|AcEG-Cw~zl|Ft6ONni;e1xgny>D>w!ZLQ1sciE#T z`Qg*!tuim$S1~RSWz;bNyI#MHcH(5xd{o-MC>E?&WtL^DHbb+k5&jF$)N;HUB8Y|2WqJB*8yBpI40oOY!A|NykmxX_>nNUM$F#PsUo%Ksc+P#$La{Q){J@ z;dUK28F0h;eE2_Fs0A_N>Gxg`)OJL{SzO5GK^@_L^iyib6@TNz0TR}spBNEv zEL^#Hjbr?J<|#0C73mdeI!Kp9IchEnKOKfD8M1b;BfDzrrpAKrlV5$Z1Y<@@5m#CL z$_7NBNIQIyr+!w7Ss6*Hx%Ui!i9Bit-=D#TwZ3}s>xnEKS9@MAS8V>fms^)oSmph* zn)<3Qwy!fB=1w#arrtI6%d;*91?erFvh;wxT18^2COWh-Kl!Vn$$V(EyTJ6*$zG6( zBfe-k6J)Ew9n{v>`DlS-;H-{S+4On8x_=we<*_uJ#Fl*W2_U&CMghUD=NX&TjeIv4 zZB9Fo0G;pg$W<9s4|et5aU=7~3+X3qP1nPH#lr`cZ7!8TxtMmsVm8wMNq7Y+8@|xg zY&fDg*moK->m598ga_#wx>ZQxpJ#X;YLc(WZJy2rAc^OEAz3rR?%THpeZI?A@5-Fa znky-V`j(LpXU4i4+OcjEg*pA}K(!`s5TDJrv|SI+h#%0CP*6&cbVUmTwbsZFrYe(@ z8a}aSG7xMERw0&q2roX2^bfAu&7P1)u|$ul9B7uhMz1|7e)=L-UwcRYGexcRuV1L)Vk zCPF%Q6Wd#CcJ{ZlC%MX^)JxU3fdBwXsQPTg&G#8^<{}9DON=)6-*fhlsY;LUYsiG= zyFJ^c6cEu#GCA#KeaqPMYJ}6Jv%8nvU|-ZeSv7U?+-Ib)$#$3HV-3M9y0}};?LCy; zmRtYEgFWuKR6WVQUkTryk2b11J>cFl(163aoQQPbi)0sSd4Krt*5dGAkZMzf#HfslKn;5nd*fiLtJier>zkd&0*SR~vMN8s3C#FC}osRs4l7;o|?8t7PgrAl1aK z>olf}nZYMMT;gdEUG?7hKDp^Ww!q{T0r*;S>B~klia^^w`CjYw8s3y;y_u{(3V|BL z#6d#D*Y^2^+uL7Kki#D@)i(PgVmaALp=ZT!09=O0tWG`-s@&t$3YW%?wZB zFugU?C#aw83W1&{lJo(Fq6NUK(y2KR(thK~reAhxjvs5Vzq#2FXoTHzqdLc4Dt9=0 zq;3$oXKg<1>`%dgAf@bfBhwkJn$Zx|C6Pa8n0zDdu~vIkq<3VR1kd|>OQKW_CZP^x zltUx+PyfC) zu}VKZiZZ~aidf%oSPRo$Vdjisc2e7F!Dk5*M@!q0kA|L=J~%27AiA@Uo~c((aU=77 zPT`MvAb*SuR_Gxn>t=Ulz<^PP?pfFIkK(BxD#OltP38~R~=^`C#PeBY9zrqh~w`um^xJ|C9BHP_91pWj~M`VX(xUlbSrOdKqD z^D|MxCOvarr`p`0bD!(u9*`9}-+_-8k=E%IGHYi(Ua_0b9jkx$is3Dn{8u2K! z2*IRKH1-~VZ}Q6(TbV(I-c!!|vfvdA3Yjl!&@(YhS_#w=Xkto`TA(Zv;2PuM{6uWh zQrMooW!X||=q%>coq#et_u}e9f_IQYKD=3&l2-!cky*6sj7X0iG6uU4itYlk6hyq@n;nls$L{Z$IEH>(6cRuiig%VHq* z!J#~w<7X06IH5RAn-fgMTOI0@@pTr0Z+>iW!QSz3XV9%syLtGI^4~KH%TqS?E#Y7T zV8gWW0J~2+Yv_87Ux>PG3=RfL`dNDoj-O0tV-6%)JA*>LsT-BAN*v z7jZ~yP*dBjzS2_{leWyF!=avWk@U+725(H>vCeD?akv*+d8*|9Pb2d4zV5CgtmokQ zjr)q8eUp+#^lJ9;`P7>^BgH7qe{m@}90lt~KU9s}-R@s0Webp8skl5@(5-4h4q z){u1LZ z8V?=aW@!8OuzS?je2$+gORo5k^ZnDgx~UV01VDr8KgUF6D-3%s;DEH@-qG zOYhFaX*EiONw0n}1TS5KtRdGjv?+Y}$#y@p)+<0{F2@}fd7)F`cNDm9Df#1S*Tg{TdT)jr|9ER` z&O%bl_0oFQ($#!*hn7_M?a|7Cmf-?~V`F4RP2ed&S1^vP@FzuM=G}$Pha~?Qqz)(2 z@Yy}xze_uttqtfYSSt708G zGOj9vv2Ze`3>MI@*CAOhHJVQe(#V%HD$HLiwD@-a!a`0C$}b<&+BKyl2J;ZWmd>iY z8@H+)5@gs7ss;5oIQ4oJ6TN2O7DUo*H<><6Po}Yo=Zg#P{tdzT+{88E3HeFKx`v7CB_b61s&9XZu{qIfI%uXif*x0v`e$e3dDM zm5e8*I%PD|(7$2-o0*y?^!=O8x^Y{pLW4mmWj6P{$8~h%N@M#Y1XX^~s0ny?uFa+4 zNXk%ti$ZE7499QXZkWFRzp zbk6Du(YwEmvgqznWJY!t${2hyCC_-`pwhn3rpu7F& zS$?FZc-S@8HM(bPs(0%b8;51c)0?_+5^o&-=H}-9N2KmKkU(QhrbK_qRnH)XJ#DE) z!4!AWm>IyOrBFhMgjpsj_^%DSvfgJCQOZXF0~N^q9rC(&W&V!g)s7%H*Y@KLB|1za zuc=pnp8ELbcy`b64o?%z25BWwz5D9$i90E~eiB*u=K8j00ool z3=sinOAzmi^z{lx7DswQ9!UwpAeN-?c+t1B{Vk7Je7;rRp)Av$Dlo%>k7LXU$9YR> z?QV5TWM!@eVXc_QxkASDrWvZwkUXybf-X3gt3K5q(m)xny>RE$7Cu+$_wXyQ`|Kvh zas1_XzY>j1)bf}h(#!NR-|VH{9yh|xlYXa=AVoDK$27KGV5kB4#Qhdw&k$Rodtx)3j6tTAZZkN`^T)~kP1{$&e5fb zQ>HIZBG+;aka>UXsQvC*_+Nn%jRUxSMdWujfX-ydwd4iW=s9kG!$#fOHutOPW_FqQ zqHf5GGYg{rYvG#&FNK!$t07_}C2j_#7}i^Q&tlK(u^ zeXV4yFlc!)+m^AEkRIRrG&R4+K2hAQ_+RNK^JC3;70=Dh)n-T$$vGWD|1ERhCw(yZ zThaX+KmvJRw^H*;iOTV(sW)AW$SB-GHPn0Ty9)VTjsf+(w+oXnTfs%g2tv4SJfFSC zEY;dzH2G4eK(nsBcH^r2PP4d4zb~|-Py2QPB5t#RXELnBNb=?V12KssHo&xB9BkWx0Qq3I>~qw-=qs;hpm54H)S7P=);gR zlts`cb~h%L@Z`ckZ)&u7x7p2ZR;y;Z{4h>TE<5`(l8ICh{mGRMD?HdCEY|5RA&Oo4l}I8;06Vt#PVi_)I74r@2kXy59|8 z{uR$yS|%BLusqM+W!7ZTD373PFp+R+W$Epvg*kR}j5QZr4zJ;ZGp{ok4tQr@tV22P z>(ckpBT?^~?+E{eQy`&&W4B2xJopg~Yz;8gyU>NR!XE^f2my!L>UR`(v7A=d1u^om zE6Ga@XD#f6wnT}UY+g+xE+NTchp>+-TrKDivT@$EpC6=6fdD^S^0<4`~F zBA;7kFqgfXA!#B0rA9;ZiB7w(>P5d;Kb2X#f$#kRhmjNZ2tp3{0gR!v>OhP~Fh+WZ z?yp5*-6{xV`YrObT2UL+tetUl5(%cu(f(0$KrD zs(fC~{wiOJ5Y~ztmdCHnGHjjpBX85x;5D{jPrY^{8D;EvA3%~X@GO6DJhGP1kT$rNP)PrT-1lI#Idz?y z2wS1Vi2GoV@$t60Zp>w?aXK>9i;P9w8M1p_Du?9^a_@d~5Bt5FeI%PzVwgt?d=)a2 zi53PEFBNVw%P2iu3e&i3$>)t{nD0txj?AZ+cC@LWcT+kSH+n=Oj0n_8fN?WjZz@~f zI+{FF#a;^>H8q$pi=xDDZpd3RpZaZdTy{&$tBWZhf7MKziW936d=hpeR)iJGd2Ks` zQL2>nH~yj>?vf|1>z==4|6}T$X{NRD2IWXLnx?V3Vh2Sv7A;cngaFvbM1ixN(5lVm zlGL|vfJpVp9(-oYP>7OPK$%);Mu<${f1{GSz~7 zf_0=>bess-%lmsxLq%~X5d#vGuP1vn_1XJ`-AMU%hy$5rk^1vQCJ6QoO9s@}Dk=h~ za%i;wnp8#NJJ&^Bpg8#L+Ov!k2MbS}>8WzUKP4*GFJ#4)`qTplr(rQO~y#5K-Q zHw_Q$h3NNyDSPCZZPWcrqx4)5J6s8tlSAkUT7j19FiI+X#K?-Qq9>UA8MA93q- z>*WMx!9jAT6_RE!3_^o~PsUV8Zp0qd3AlQ8MHvc>G;N}{_i0@nYJwzd1q7XzG5G;CnM=IdQzH)xdX0PaN;fnK?pDljeF1#<~g5_!5 z1LON(O-=wEAwra?XEV4Eq?It>3to&b6{}C)o4}$FI!X#AOJ53_Hibrn_^TK%+wTfE z07C{j=Gj~VxTZ)&%5@p;qamA{?JH{=v38DA7uJ_)@t|{IjMK|`=i}Y_Cq>f4_jg@5 zR-`1YF`yi{$ur$ZNPwMt5Ys$aiT7iguMO^{4F8IB!dwjSkpWzS+f49cJSMWYU@d3E z7a4n6x=wy5Q(zlG@lQCCle);>w_#Dc5Dfwcb%8ruuz4ZUu%B<@@b|Si1Sl57y`^Gq zd((eW;^syoY3IXD{S~uq{0+*{A~|651ET7{aJc8hwWSD(X^LWY$)}^Ug9K>V4U`t? z3m@Fv_MneE?RJUz#9yg_nIn@q50)u)Z7T&7A-TkF1YIMvyD@yTW3B~Tg3$8=rG1#o z#+duIgl5h$MAjKRn^r%825rHIdmwO!bnDfPpVHU}hOTwCr!C{AP+j?R!qQyzjFe%N zpQ71#n{qn+X(2!EliO(KTyfonGYH4$qhg&(6HHl@nYH zfr-Ax4oV5(t6_t}BbN834Zl1Z*7bS#=Z}INi(Bvi3bZ~;Xj(UKNd$rKji7`q43Qqc zvQ6F0a|0aQ6lAGBAa%ZC&JG&&oUG9)K-VVlSg{Uzp3r`+y{%zZGgqEC`!NFNR%7mh zUIl_DIecM$nF50BMYpx+klX7+(n4vO@>peli`X#&_e73m1gr#G5WpTmV|oTmJ+H!* zsoXlzDNaJcR4GWkC_2~Ht#u$RxXo82;}FoU4$q?9JdA`+W3DBV*>Ub_nfEspXMiEf z7#TXDWIf+b&%;UHPanD1L2Dz$K^H55af&;4T0SYG7O+C0Okv_%J*H%4kVsVHX`%)G zk2RIj@4LjARwubA*OjzN zci@8`e@o8`wbHGP@dDTwhl_xi&yaDEo$<{E&=^WwQ*@iGPD(fRH$YUmF6LLRBlPE; z@P?Wf6awY|M&>%Oz1GsrxmpxY9HO3Cr&t{UE?*L|EW7ud88=CMa_u2JKq z^`)Fmo`zSf+;H)mk;~XuaaH~BmN^mZVDsm%E98(~8Glxg+ZXZMgc(*g{D~8PFDU^r z<>9%=TKqz%B(UDvri6itdv=-0`4cwYVWnribOa7Q-pl=D4{s zU5Cv&Te#t=LY=dk@IlCoHi$IsD2)q>`Y-55Fd38k<>Bf?-mI?JKl$TfFBM7#UQ^yM z%blo~R>ulD(j-vnxUMC+EAdFDd$`Asfo=ex?uO5rU$1eMcm0yJ^@1m=Xcdz}2jD5S zA6%jDy5YHTAK?aZiDd1PS>AXNC_3)H>p)eBnL|&|F zK9!FwTB26?MvtL=7h{_}cx4a7it7fiD^Epfo_(YAao=@q(>32*{B4Abw5v(3wO(ev zUiDHG-}CS#MFF*2;x9MLvp!yfT%U0BQ;&B;wzSRO-%^zTR`l(oyppSQp;^v2r&itef^gG{Kk0(w@=^6+bQ=5YWtf?N+BZXK1Xb zitxZ1)Of($^m{$flM86Q1XSLZh5Ec0%jqxXQTI%B6CymY?s7+#OJ@9DH<31$~$Oa{%?^o7neQ zVJ6}d$*U_!A97D+>Rz`KYf3zkNXfj4oT*yQm6DIA@ed#<>Zq{LRJ_bh&mDuFaC!`V zROGUci*@vnW?rtq5A*a~ryC6Z3jk^a=%bw;8FpePrQ%9#?J_Jxvd5B`n-A*_a72US z^2w~=EKE~;m9!Yy%{N*e@ zbn+4An%*!_Hmx|grh@cATjCpA365$RV<@!>#%4oybkyn>2J&<<5}SoV2crkJuU?dE z`9F9=iTET@vFfPD4eK&a_lUy6WESN1n!D%dt-XLv5oOyj{GPv%*>`-F^uwySiC}Ia zlfGW7=(RU_!`s!g3&+rr$2>I|ZEK;6>llZ`T;6%)-V;W5$5(qXn!L7k7KAa&+MXW? zsi`$fWtZdKw4ORe2$}8+5qkD5Zi4=ZESUrC`gjaf*R;3ys`MX0CPmz0n$wr@yL8BN z{Pgl*m2yb_a=XsX@}51ltYp2~cOWhu_l46|9n`4ix%xaCPzZPMThAVpZFvij7_wh& za?;G!>0Uu&_WSAft22&g6TYL^Ch2R*g8e>m|`+w~mK)Z=DpB`d@o#4)59~%>TEx=t~ zh|A8B;QlsO{T-*3jT8FmyO03z8Bjr{CYwON{i^`Bs?U*3aW9fAz4eEBX+Q}zuY9zn z6ZXsf-*anUclIzq`%M>~SM<%5nq73!O`I<}aTbc%iyQK-vPWL~jJ2h)#Z3%jpF=#i2Nxt;u}9>OcO~?9FZ5zP>-=4S63PkQnErafU9(N!!d#SG*IyqrS_7 zaX!+RJuf2aOoz1#|FyA+yZ3;34b!1Y z$n_a-#vS+5SjPUTi>A!B3)+4ZAS)=p?G+cCIyhzbW5+cA<6p^^@9;i1qM|J9@o`m$DUV{RxmH*8p`9yxY7sM6Ij4J(dlXbx@v zp`H=Y>$P5M5lyRX2?m#+3B8Km8L0xC6vTW@-C-!}o;zJw%1iQk81a5>SDM<0R8DG5 zwA+`J?_R_1D4^;rc*>twk1nG^7We76r95US-1);9@b;yEmy#o$kGk~c;m&gbHx_nG zV=|Zmh^4du-htdpYC#bAN-FJxyj2+Bd3cW(-+^^Q|MhZP=yUD+tZB=JYNR!t&QMfL zOR{@p`xGXmv9rm|c#8Gkt@Q0DSwF(GgS3ahf1=aj0zj~P{sR=@FgGM=c>2sN5HbE{ zbDD60igk3S7^VfpDjmpoFj9ohr8t-OYTLWefe*b6S{}P=`L=f5V9*KT+~Pj0*Zad0 z(u;qCch6}GT~Th-RaN=N|MNZzq6ZzL9#4#m!-8?)ltFzFY_+4z(CDv(W@28o*99PLrZ!BSp>g}136^&5#HNG}PX zf#R)la=hrey0-VF*4a@TnGjxG5%=F@YnBHZ!X?_6p8Ch=a>mX82mjZH=e6-vgXKQq zB^Sq8*K;!Anzrfj83PG{%Qy#v41~=; zag9MH`9gLtf&qm7lJ?rAyL=*!8tKK>OfCSaJ zx+mCH&uD^&p7dMuz$eU)eqK64fO|jxJwVvRJFr#KM-bHb7ShvXDmice=|LRSJuNr+ z#_rxYd|_G|mp@gm?GU2@pTF#JU``k%DyLhl_9+HO1|>o20ChSg{(W&>Z%27N4Zoq) za_);reAToi^*SNUP54$*nNf0AJ+{d2TMudi*${f}oWVXS#_O9#+qdP9KIT?i4F{wpFuc0)LTgqOyNUnXI`E(OH+%Qp~fo5Nl zvPFy9wuY_d@77HR5eNcMJ`S7!V4a4y;AruNSUUuMRYOpG-`#^|8PDmMd!~Lx$3TtY zpvJABoo;4h(SO`(2Fmch$YYU__vQ);Q=L4~;MSxkvZhN8qlR)}kk%hrKVk7GB5R!j}^q zvj-f57Qs$=j#EsCxR7-Syu!{SKPGM`wA>n3E6B0=_2*KdPbN_HK+cm6czX z2yVL52es=tumFqSLLk_Wjiuf$$7JA7IP`ix2gfRaW6>gG^)_Kakm!?=;!)z2FVs%% zR&UG!VMQN3ZEt~0$;PXtRTHTajp5^(Y36RS-cD7ln_qG)!o!S#l5DaP+mTFk3eOjV z!yOc-?u8gN%sr8ORgwIK_Y+@l)i`949#g2OH;Qu&n*e3# zKBCLdR^eI%y0jY<$J11zkl~Bnyxp2o{D9>6E2TZ`xAo)cilyHWp?2v=FLc{4(LZ)B zMXod{H=Jb;&n%7|_*T2bHOvvoD?hAx{0ryAyy-M@M1-!bI8nP{(8a~SZ?tNNhr?Q0 z1L(L=@&`CnBs$g%j)S4o(RW1L9Yyer_60&(%>kl!whK$3mn2dA*A5P(Rni`2Z}38G zNG!in*2HmN78n8GA-v=~yOzst!@7L}a5IC&YPPNPy>-Ng_pVRB>30ml#M#oFfIf-CBL!5XjHNV1~sK6i9IBFLXqf{ zk`PRboKxkiYH-}By~$!u^INw8T?!@lMbC8!_m6<@73A?Z(CBgn>z2=Etd_!>o>-7L z;)e@UdI57_(QqB8kFEwOfC`_!3~-k9z4%2X{@qTF3k-uenl=7H#eu~?#&m|~{L%z} zeQ8{s-tw{a%J=TfepMpS7sl!7jZkF3Oc~Itx3on8=Vo@K=L+ZM<7MNLmm2Q#3nndQ zVuq;3E1(8)^nB^j$-#!o;I4}t?!`Z+?*E;C>hE(f=U>~hf9+o)pM-;7JJBx>`N6Ay z!6wf2jpz7jrsC>C`(>Ubd%xJ+pj@BGxlY7o6UEAPEg?nBTey<2ZE$bjiRI9s!jIac zUw+STy16Wx6oRI3OmDUsljtDhX$8&{5SxP=u1Fv&k` z97l4nH!BR6P2NdybhR~F8#J4V+Y0+irEx$l`;bii{7Q3KVloabg{8)HyS`6#Z z7VA?a_UcFQ*=|?1|0o|;Kx-T=G4ng$Ky_|dga=A18`Q8RlJ`pK8yi`l)O(o4-mnyc zc9{8LL5~oFZJpd|Z4F2ukw3S+toFOiM}xRf7xj<&^ZyNjOfF_yl*t?7hKl(xA+nN_ z@xN`3urGxj+tR7~bJFOMJ~HEA;n#%B^lh>O;Gje(ZQC${4b`TM_9Yl@4#%-KkdP4c zkZ+*XjvDN?d-=R?Qf(E)qjlv^AJ@A)%IPno-G>vMws}(*g<4G`WzBDDANL8o{jG>t zM(MYppKm~Puh8KnT7(KvTGtq_E?hGP{r05IPR6wcy*S#9K}de6`LD9N#r^rYI?Y`p z5^`}-dri~2Y_>#u#%a4$vNcsxW94`t^^4)ipzY+K)HSKO&+(H5lZC}Z_}J`LDG%l{ zngf*8@)C(&BS99VEU=o0CauN3k>+}OcVLq1MaP7g($J_LSgyY}id&|Dw zcMOc7c{tnnq+7xMtLGehd)M;1eqQz;M}V_eyy&Tb0)GH4cnfd;!!v_Qzjq{^nY;^_ zFII62eNBjsOrxD^Zu_D?+-GurBU5A^KY#Z}8yI@|JOs{CUbHSI8;!}?a6C-W{L zauPh%NjnPB(QI?s`ba~c)Mo@C<3#G^5hpdVl5(BDB%58=Sb1p=>rxY@qfB)s;A@%0 z=x@5)XJTr|0+0FszS(Loud50+ zu;q)cpt%>#H1PUf=hS2vCap`{(pNaObJE8Cj(FY=lZkkDQc3D^;4?D_s(CeZ(_Ff(NPXjQJi)9asO~D(pDT?cMwTe|Dq0{}&fR c_QW!hHh+|wyw7m#AK>qSisn7cUCY=12h;JKG5`Po literal 0 HcmV?d00001 diff --git a/docs/source/conf.py b/docs/source/conf.py new file mode 100644 index 0000000..bf32c9d --- /dev/null +++ b/docs/source/conf.py @@ -0,0 +1,84 @@ +# Configuration file for the Sphinx documentation builder. + +# -- Project information +import datetime +import os +import sys + +# from unittest.mock import Mock +# +# MOCK_MODULES = ["artemis._artemis"] # List any other modules if needed +# sys.modules.update((mod_name, Mock()) for mod_name in MOCK_MODULES) + +# sys.path.insert(0, os.path.abspath(os.path.join('..', '..', 'src', 'raffle'))) # Sets the base path to find your modules +sys.path.insert(0, os.path.abspath(os.path.join('..', '..', 'src'))) # Sets the base path to find your modules + +project = 'ARTEMIS' +copyright = f'{datetime.date.today().year}, ARTEMIS-developers' +# release = '1.0' +# version = '1.0.0' + +# -- General configuration +master_doc = 'index' + +extensions = [ + 'sphinx.ext.duration', + 'sphinx.ext.doctest', + 'sphinx.ext.autodoc', + 'sphinx.ext.autosummary', + 'sphinx.ext.intersphinx', + 'sphinxcontrib.bibtex', + 'sphinx.ext.napoleon', + 'sphinx.ext.viewcode', + 'sphinx_rtd_theme', +] + +intersphinx_mapping = { + 'python': ('https://docs.python.org/3/', None), + 'sphinx': ('https://www.sphinx-doc.org/en/master/', None), +} +intersphinx_disabled_domains = ['std'] + +templates_path = ['_templates'] + +exclude_patterns = ['_build', '.DS_Store', 'build'] + + +# -- Options for HTML output + +html_theme = 'sphinx_rtd_theme' + +# -- Options for EPUB output +epub_show_urls = 'footnote' + +html_logo = "ARTEMIS_logo_no_background.png" +# html_favicon = 'favicon.ico' +html_theme_options = { + 'logo_only': False, + 'prev_next_buttons_location': 'bottom', + 'style_external_links': False, + 'vcs_pageview_mode': '', + # 'style_nav_header_background': 'white', + 'flyout_display': 'hidden', + 'version_selector': True, + 'language_selector': True, + # Toc options + 'collapse_navigation': True, + 'sticky_navigation': True, + 'navigation_depth': 4, + 'includehidden': True, + 'titles_only': False, +} + + +html_context = { + "display_github": True, + "github_repo": "ARTEMIS", + "github_user": "ExeQuantCode", + "github_version": "library", + "conf_py_path": "/docs/source/", +} + +autoclass_content="both" + +bibtex_bibfiles = ['references.bib'] diff --git a/docs/source/references.bib b/docs/source/references.bib new file mode 100644 index 0000000..e69de29 From 326e4009d589e681d4b9aa60fcb2f0b4144b6fb9 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 06:52:33 +0100 Subject: [PATCH 050/137] Fix slab thickness --- app/main.f90 | 1 + src/fortran/lib/mod_terminations.f90 | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index fb3b25b..093c3ae 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -102,6 +102,7 @@ program artemis_executable print_termination_info = lprint_terms, & print_shift_info = lprint_shifts & ) + call intf_gen%write_structures(directory = "DINTERFACES", prefix= "") else call intf_gen%restart(struc1_bas) end if diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index d0929cf..b983c79 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -705,11 +705,11 @@ subroutine set_slab_height( basis, map, term, surf,& if(thickness.gt.0._real32)then select case(term%axis) case(1) - slab_thickness = dot_product(uvec(cross([ basis%lat(2,:) ], [ basis%lat(3,:) ])), [ basis%lat(1,:) ]) + slab_thickness = abs( dot_product(uvec(cross([ basis%lat(2,:) ], [ basis%lat(3,:) ])), [ basis%lat(1,:) ]) ) case(2) - slab_thickness = dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(3,:) ])), [ basis%lat(2,:) ]) + slab_thickness = abs( dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(3,:) ])), [ basis%lat(2,:) ]) ) case(3) - slab_thickness = dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(2,:) ])), [ basis%lat(3,:) ]) + slab_thickness = abs( dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(2,:) ])), [ basis%lat(3,:) ]) ) end select ! get the largest separation between two terminations if(ludef_surf)then From 9f6ff528251c47fd42709206d30c0958509ea8d7 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 07:08:48 +0100 Subject: [PATCH 051/137] Change license --- CITATION.cff | 47 +++ LICENCE | 676 ++++++++++++++++++++++++++++++++++++++++- README.md | 3 +- docs/Cc-by-nc_icon.png | Bin 56998 -> 0 bytes 4 files changed, 722 insertions(+), 4 deletions(-) create mode 100644 CITATION.cff delete mode 100644 docs/Cc-by-nc_icon.png diff --git a/CITATION.cff b/CITATION.cff new file mode 100644 index 0000000..cc22e6a --- /dev/null +++ b/CITATION.cff @@ -0,0 +1,47 @@ +# This CITATION.cff file was generated with cffinit. +# Visit https://bit.ly/cffinit to generate yours today! + +cff-version: 1.2.0 +title: >- + ARTEMIS: Ab Initio Restructuring Tool Enabling Modelling + of Interface Structures +message: >- + If you use this software, please cite it using the + metadata from this file. +type: software +authors: + - given-names: Ned Thaddeus + family-names: Taylor + orcid: 'https://orcid.org/0000-0002-9134-9712' + affiliation: University of Exeter + - given-names: Francis Huw + family-names: Davies + orcid: 'https://orcid.org/0000-0003-0786-2773' + affiliation: University of Exeter + - given-names: Isiah Edward Mikel + family-names: Rudkin + - given-names: Conor Jason + family-names: Price + orcid: 'https://orcid.org/0000-0002-1430-3294' + - given-names: Tsz Hin + family-names: Chan + orcid: 'https://orcid.org/0000-0003-1126-6579' + - given-names: Steven Paul + family-names: Hepplestone + affiliation: University of Exeter + orcid: 'https://orcid.org/0000-0002-2528-1270' +identifiers: + - type: doi + value: 10.1016/j.cpc.2020.107515 + description: Paper detailing the first code release +repository-code: 'https://github.com/ExeQuantCode/ARTEMIS' +abstract: >- + ARTEMIS is a software package for the generation and + modelling of interfaces between materials. +keywords: + - materials science + - interfaces + - material interfaces + - structure generation +license: GPL-3.0 +version: 1.0.2 diff --git a/LICENCE b/LICENCE index 157abb7..f288702 100644 --- a/LICENCE +++ b/LICENCE @@ -1,2 +1,674 @@ -This work is licensed under a Creative Commons Attribution-NonCommercial 3.0 Unported (CC BY-NC 3.0) License. -https://creativecommons.org/licenses/by-nc/3.0/ \ No newline at end of file + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/README.md b/README.md index cf28073..356af31 100644 --- a/README.md +++ b/README.md @@ -115,8 +115,7 @@ Advisors License ------------ -This work is licensed under a Creative Commons Attribution-NonCommercial 3.0 Unported (CC BY-NC 3.0) License. -https://creativecommons.org/licenses/by-nc/3.0/ +This work is licensed under a [GPL v3 license]([https://opensource.org/license/mit/](https://www.gnu.org/licenses/gpl-3.0.en.html)). Source file descriptions diff --git a/docs/Cc-by-nc_icon.png b/docs/Cc-by-nc_icon.png deleted file mode 100644 index 080b78753e8319636b4a5bf893f4f458d0234c9a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 56998 zcmb5WWk6Qj7BviV1f)YiT1rw7k(7{5>F!3lyG2?+N>J%gknZjh!2l(tOAwR}$#?Gi z-gCeA?}tB*K0JHxwbzqM(6%i>~DV4DU9B2N1zU&cwwTE({u?){G|U+#7zyYB^`W2_S6{mmH^9Q1oAkLvhuJd*nFj~^FS=N*(ylo|F7vNVqnE$mKBl)&A9 zRFePRi%`u~1g(;!lLMt8_Ds5uTH@7J#f~4!Axe?r>-ebu{@`R$gfNGg`G`7W_3h`5 z2eW;~;^0DggWA|GEjh`#o0k`a64=5fzJ34ST?ao=d^xt@I{az!;POZ8+iOMpLSxjK z)FarDa z*a=X+zEF`sFpffi*ICO*vN>K7iy9^-HD;$}!c6e*Y;F{{B&to;IuVygns9BTtu6kg zFJW1zKr5X`IpA_iRWDR9TS;RWDGk?=NBj4pMARE1lre?aFK=`4S1_8?qjuh2xWdpK zL!FW0R-xvw&_Pdb&&JW=pGbPZ^zUq=d2*f71X!OxtF5hF3L4}Q4mQ7cnh-iBh2l)| zll|`9yWGp~Ub(n>vihq3d&zw{tB)z-Vg0xS0c^LfU%%e>mxwon3T0sI>MYV+Oh~}t z`%f1SuYk6Ke`mw8G9x4No=5N3q<}#T6iqt_3IVwJFaFYmwYzURWQ6~{GkwnL59h9$ zb{kidKUg{S6pu=lf}}e_XQZ&K zO^Aw$I_7Mz-wx$ZpRZN^ojBu%H~*d1k!)Uv(aJ_HPaQOtao49>@0;7aZvXGzV(umS zTg(@1C8(1(f2MkQc~wyV@6PLAwzgtL?5ow#Dp|(a9bg1qG$4sfjD-(xy-$^=Z}aenOyi;jr;}MpO~w-u}MY3zMCt zpMU@Uz4D1Ge#NTvSSkBz=KIY%Z|_uFGtyu5sc<1f!Aed}4og|NS-|-2HZK!NF)OQ_ zvVx4ZHR*kxnisEL?VkT6f5k2N*Y)uu)=TY|m9^DR3V6cn&%-o2$~`uq3nv9-*d>gueHFP7G#SGxl{?-`XI zKQ^;+yspU34tMPy9VOBp*Jjaar-ECC2TonJ&8Ki-^YHN82#S;{;1cLWR)uI~Bl%ra zAVF;7q(HA|lyratmAQp^Vqzkl?R@Ku@XG2M9WT>iYDHa5Ls)(?afV^W!peCEEvIs2 zef`S^41~5iFbZ>8;YWrJ!b_J2?fZ{)=XL*{MnbF;&OI-Xg z^hvTe4)d8wQ^ZcmVpMFLq?%gdx~_h5a^`-*@f)|*A=swOzsC2aX8kZNdMP}tS!w_jmONgeb*pulxH527aP;iTg@2&g(rxvx3SH~!>n5$fv(hxpStip~!o zWkjfG3eFSY;j)8bSPjgpejt?P;EkO9!Q zr)q4X5@KZo9E6EzM0=ON56C^1mv-CR|E6Wk7ee&u!-w_1_evb}CR6JoGux;?zGTN{ zW|kEY5X>|D>z2nrL^yH}`_|BO{$GPnyPsPe7u2VuJ*eoV z72&R52fty8l01j4G2-eGA6JIks_&EQ`D47uxW@>-b4rO<`N8zb1B%`O5i$8y@!|b% znoBgjOKRN=ZT=2DGc#22pX0x%Sh~7Bb+@u<)bt7s)bk%1iHgFJIQ{04A?$VSol3@< zbO9+6SgSwojx_&%$YPS)x-K9U^8zwRjkt~L){dH#taNOAK0l0cxoo`bYki=BrdtuC z5FTMD8po){mn;#<@0mqcnR6awuyy2o(sR7S-Y4DX=Z}nKSFxg_Pg2+l)7_e{!M6$f z-0oAFQTqjAD((%R%*1g^?pxW%Bd$@;zgX6j{FQ zDcy#Cc+&Jr?lxYf9M??}61r2T2i+BhlD&tRQqnT4dm~~@)m-)o@5f5=;%$t4#*bHy zISJKn*gl}hz!ynC3&pr}`$aOCpJc)0u{C<*w@`gpad9!cViFr0TlXqZ1U_`;tEvQ*CUv^>LqVKM_jDOhR%)piA-CWnzKaO6v z`CVrAGz$qS+J}tvr(_gy=yY9llQr)6=6`0%s0S8O@9K~m&2PqdWlr}D4=cfvm7Q9+ z)cKz|&9r+Ocu6)M@ds0fUk9Qvs`k#V8vS^=ZkQq& zXLP)T^M|ex)UZe#8Ng4{vUGmM-%~V8P3rJ|N_=*8_oB8j8Kh24I zz+Cm>uS;d5w@wCSg$thDl*}Jl*a_{yJaJ@qUi$S4J&wY3$A)%)I$cf?>LnfI-AXYR z+NUZQ49pK@J*bjGnwkXl+h>U~Tf9SSVryVMrTV;JMoV?;ugOQt=jFeUf}*?|RB=2~ zlfZxM&X`N@Jm0m~7bKh^mq1QVo-3Iazka0_{AWP+AOfB+1=-}k+XksSBd&5XPGd7) zn+(WW$4>A55tERLNxghPUGlO*YJEy|L{07vXR6W8-=Z&SZ4oW&ES9EjZf=!khkjII zZW#&K6j4|t>0gAbv-O+)OtAfPcGBdY7#mBj5|VDgTs(BX6LpeMA1&Wzkk>Cpt_GjIKi;c;3G&x zv!{wFnXg_9S9^2sBqtzsQ3x;b^CC(tV{+P?NJ$Jlv-v-5KBp_N>kDoJ&{_Xp$J5+4 zj|+dzTP8?E9r`%@^omHVyqP|wLX{?eAVDThpBGkKBsDE9(vy9{ZH%M~Vp8Tgd6y(p zltL7wy=H(1TR&>ZFpjCEtYzN9jZFcjeXYM}+4-}K`(v~oxp8O{C3$%GJ}Jd88zut- z!{pRd*XPf8+S*@qx~3;5&zDF3Fso$cz+M*=6qHj`>{%X2z_n)ZCnhEi*ij4i@b92h z!DA@%yLCl?9i$iH?~S|sl|EJBaOtAIzaJgN)XM5QF>!K7E2oGEb$EFAhoK?=-Js-T zi(6;Q@5k&~=Swh7@z#g#@p9fIQ_@jijTuV&Mf*IO)0n8-VVnW$x{wz>b zUrs9N+mi=K^18<7C~anzyDp%w_Fj|qdyyL2Scy(#axyWSPB{)UGqZr8V6J&zOmI_F z0JWZ;9*kTPP@%bn#qL5ET5n$;9VaIq0Jz4$GrlZg-@Ly0L|xC#vAz#nvR$9&ls#^a zq7C5D_B3nRC#IFqhM8(;XlRybc$Hmn(G&Xj~WX^f(_iwdkkBy1)tDlR$N=i6O zOG^Zll(CbOx>B;T%WI$B$US~MwzMr*3R&N5_=LM?MOWVACVk&BO6**^Onw(s*UG>l zFGgmj*my~y;pu6LS^xG(&TY>{QAR1o=;zOIIMO#`0WRg`x7Npyuy+p)VH+D87iql1 zvm1MVT}MZ!Xv{9RiHL~EWq~Efx0A+x-N6Lh?v-4HjF(p1eeq&S94Y4*JCZ_8^78*S_$77G*yy172$REM{ zbl9wr$`-zu-|;9``>vEMo%#d3%Jn$Ib|3Oh?J{YJRx{xs@jZBsOhr)JNU=ThBAKOB zf!H7E`5rE@&tpw*?v|IAKbdbAne+WgUHfF@8vHYlfy4k-;&bN1$b|({DiOb%Iu*ua z#cjdg?RZad&rzT#EHH#?(nlu{?G7cl6S|AZc%%>&YZentH#jHMJN`hX0oFli-{xxL z+dF~aOX1HMf?@fx2}|AK*g_2->kSf|PF!{#iK@#T0DjM#AUeBEYOhn;w>{x;jK{}n zlKS51mayeL;a@(GrKN;8*DVRo(@yBb#7sO=bRaEDws`&i+T?EIvHlemf{Kh<-aaWQ z$>sdSl}a?=*4feTZ?6VIUiB=nJ;oRTshCUSkW z5E~hEv*%_^d;zaYmT*@zF|*6c2f}~Q(dp^L`JEd5zwdT7IuE!9>*l2`pu{RLva@5O zc3fZh5ZWW;EgR;c19Wp|_p6F3;P?@>D7gVheMox8IHDn-UKP{R)y;AL`FZE)NT$JQ zcJ4_Bo6+vp6i2txBsE+Fx4nM z!jAj+@#B$lqlZ5J{xF3!l?@H>zHSIepre~?a%cAXGZUSD%c|meO-)0OPI9}9r}sru zsCWTz61A%EeF&erDXr=c>em{^)**=cSM#pSLxOLyk$%hDyrus?AoTVC@~_3Ux$ZrATf%6 zTYC(NQ5^?jH5DmF0lRK9t%P(!ScGhvr6Fbvk-1JHPVW_^t~ePO(A=#rp8sfYijCjH z=i}qM_23CX1Rgb(ib{Lhg^{^A{dk25esFNGl(cko{60QV*jqe7IIrt=h^WJF(lbBA z*bmN%wAU$*hRfI1*4F1c#E{FmxGrB^v_RrC{r2|p&i;PScE=T`&}T8AQ#hv{1kLU9 zk0BFC!-`*~LME6q3Z1O?eWScZE)gMFsGd9au^PIE=~`_UcGv?E+Dix{EA1n(S;5ctGK8PTa%5%FZe5E;OQ|5b@)I2 zDLa^A%2%ifL@9@u4sjH`_kzxS4z}mBvr}U>Mhg{nD@{@B9j5XcwQ?M%>$)lvv-es5 zx$nb7Zc2`tZk$2p^=q7boG&2%yVda@nI4;Q6+ru?MflI9f}@&f!@e;qca4vemTMVG z575zvBOgs^*wFDx3%&{Cw;#t*Oylf3|GTf&5fr#M@MV*TjEwAH;~R#E|B;loHfgy@ zM|pZ%IDNV7ZGL|ItV0pcwG_V5@{>lN;nzYMYRqrO%Z(`8+uLD>()I}6kvaZG&JSun>lAA$GZ!#E_}`(=}5_IA$3ws2N&s9tYUGX?F_sx3HgM| z@=Xa(dgo zvAgxv^O+e#NGLY}Sc`aV?Qknm@uPY(q&DcWsks)2Jsy~$T{GRSh&@RY0)*i8m(4nm zU*lxwBP=y6N2BX9dTU!7iECAUg|M)2rTqkFhG-zg;jb}bYK*RTPq}T5zRd7^N0FLq z53?oi82I*1C48;2y83BC0zN$h!|v_??f!`6ji%;i^Vw$4#(=-~_3P}Igz$h1qkX&c zSW?C>Vx2`Qre7BGP*qtOZ~Ua9zj*l_OzjN-6-7`A3=IuctIVZS?i!GSss>3bGBa~F zHv6iobOJCK>|?I7RFEoKTZK^`iHoDshy^_#NT6ll+OBjefHJt+_+k?m#uIV1Yuz#~@=h(>}l zb1*is263*S90lwPi?#2sx^;{pL*2k88LnmHyhaQx@&(YFoMCb@76Ch^`>^ z=|p~g=RMp}x61rFEs17GZ?9Cq{wMy)O0%%9RGyo@=1bqBsmwQC`FrPcTYSXHWf#fJ z%&c;ly6^FOT1yw*4}onO@09zN`eJiOo;+JEGVCMyW~~yIT9;ahBjvV)GW3XA(B~g0 zuWG~SMR@`bAND|bhL@Ji6!KK9v3?BWUtj55-d!F5{iyTP8-CZ_CFzWZ-gx{@GxttJ z1pik@pT037+DJAaY}o0ko#N82{`l$p_nXOg9(VUf6C)6hj(mL;k4hkfkU{45ojWqR z5qCblHa+jHXsl|+}vCQa6AnQOMLnAj?l|3s!Xcg!vg1p_0svPj%Xa|07K!okBPjw_3G@j z9A+8`0k46KQ6l2I_YaiU{{A@1aH}WZ%5ftSE+v?qV@9qN{WBuAnUzV7dL{Z|NUE$q zQF#3NE-x4CSC^4NrS$s24Qw(_DK)h!&a}F6;F;<7Jn4Zeg&!~{VPoi`GqQ5ua1YLi zP4_>RmQ4)TFOvyF$NdWB++%Yb7oI({K=jDN<3T+2!w8Fk_{E*Yp6+Ap#MtQK8xcX= zINPmf@euR}=t;>*yBEF1pb?RbUiILM^+H*=@(h+#e;G%~Z{8b42%NWO%Jp4&=FY}X z$!7;|`O^}!LT!`VWepuNUR=UbcLT;zZ4dCJyC}9qR!K$luhe8c4K4+5C%;Df>LK0+ zFU)ptS(HKg)xNN>yg$8AOaZ*ezt96>%&(*S*JCRyD>@byOaKIvH8%JFZKY(BQWOd$ z5{yN@Ixk?TmiSh(C6@c1uCTrh;31cf-ZP;}Vbwrq*C~J2(9p2ew(+UAzu$bJGZYgG zi)ge%r(U$PTku#Gk0x|`#w0O0lR+p3QIkii zEM%3kgvntLy)Wn_zgC(_&QWurBb1@Sm>LpX59G_Q@FirV(b3UKdC)F$auXL|R%}SHPLBJo1Xu-x&h~V{5)6o3d_`1sfY1a@am)p}4qswV3)XGD-{( zKBqnHho;k@H$_e^PO^Olx(6@Ea}~yjd$63fXZ2nnrqhu z{C<8+W!G(RqULj)ewLDQbHugw^T-q-w0@rNku-8-%WZ&)xpsLEBaPEAsm*(Pt__J| zUA>L%8!Dj3gLL{dHI+n3>ELXowalQw{KE@6_$;ZeLcgpZ0hGzsk1c;IRtyA3)5cSa z-tnLJo)085XmAQ|YirwTlRs0=7L98UJj3!WaQU$F^Nd>JEqtiv6CzC!(RAQ+7 z&QT9}Bcft#mZx#6@hgCUAlDNRpgaGYDA(r-(BoK914+Wylf5urnTN2xPc zG7?HM1584HUo6>3LG*dpCa6KKtXp|ofzc_?*egAxWMt6ShO@#z>y3`j<8}N|-}fPr zVWiF9yRGA4simu{t8Seg$xBWnHis|;M;KBM6tBHQ}$1>9DmN(1kf zaV+v&*=QE&ijTKTsV`x1h!E3~CCD!`|LWWM2rU+i{^#PBmW=VVVtCHZ&Uh97xVyP^ z*V=v~AR~(m2|y;Y{{&W5M#@LSC z(963;YWe7IRkDrq7D-STnV1%TICq3cMq&Uj%hsADVbkn<#bX2YoA$#rKa=2fz&fSg z>^}~~K?@J~dCs=E^Rc`88X&c$9fdDblar7u&|oSGN&{=|*DUbtGq=rRyjs_4jBe?k zjeFj`Wm~f=P-jW2och*bs`{2#kT9RqOccaX=jYGL9*n1ypqYFJkSZC0BMyPGv$H7K z+xwxTs+v#QFyWDxHs3GaqJd5(gNFt`cMTWwyg1TrM|1d?#+ASzJKUt@`L7osJ_kYw*2@)w8?=h2_pLrIKtNSH z{>g$2UeGJ$Q|G{`C`MnLYDw&E5nc0@ve9dmBIvIxCp<$+*4Gh$M>ha=1hQ?887rPD zm1!@x9nbanZ?{G6?6?ePiBSG%a8A4EC2^dhZKMU(&h6CgQ+~uigrJ}3ZF3~o8+<`t z`DAz5#mnnu*}IhLnwpV!DzsDrE{{q)$v6$8fO(qrMBw`EdeZOkV z%rYr3j!#xufF2UM*b_NaKh4D`@DGirUB2W`yy^o6b*w+3g{o$`W;>Z@C7(HExlG!H z@2F%whYk8`?2;lvffij4DP54B#$#i7=#6T9FPtaq0@EBWkmO9vtlZfpE+*OnLjPhI zzUZSzAsz`b$3SZg>K#J$%fuck0s6pzE&rk{yD3~SVD0L;0$!@+ru>zM&lO$io&l3V z2M8;RFe3oB#mE|1OUl-kId_KPEf zle4oSz7!vYV=A zQqB+v1(33_5_BKBdwmD;-(En2RR}Aw>x0~vkSq1zsZ(Dcp9R1$EIQ>GuyII%{AUN9 z%D*%gJKsU;?&-1GU`m4}G#|;6uKvACLb;EEDl8=x1*x3Fs8X|@Kd*K)NPL|X126SqG*<40K&SePuroY!(8{W_Qu1(-kkZw?b$))XT1=ES zO!*Y4Pib5x5!u<F@G)$x6>}WSOg$ zF9Wjm@bkDhZimTxh8;oFl9700#UdKeD%x2-plu|Il`|i}qwX6U(y`h&9LUmX=F<#L z1!lf5U1wi?B<%T1Gy1q;&dx{Qi#23l z1{JgbV_p3DlX>Xl7ic7Ln3O)8NS3OIO~&Yw_!7|_9G(5SbxO0`kUSEP`Y8}?2S-Ox zG_DuxRM0?WU)bElW@l%Ikukx@f?n@3xVgK7$TZ51Ah7l)uQ=un>g($vx+;xD`;#*= zo&)E_-e?QH3R+oN!Q8l8SFG`F3F>D`p^lsjCZ|y&qav4N{YU3Qj*|C}m6Q+)4Faje zo^b)K=*5A?aOOjum&W|gQVS=E%hd<;MB!*0q2-3nPo?)sfAwbR*wvl(Z9JtG@*tp& zy!ml*@)qnIX&;})&*y^Ct;ErSHNk7qYEt?hPp;^ovmdb%I6ORD>Ah{-W^{w_=1s;e z9tq&ppusX1G*GR5$xcWRJ(YWDd>MOzD3~xZ559GrZiyboZRlB4n)RU9I?o%!*i70_ zf3YLrq55FD(oaNPL)~gan(-Qj?$epL=T89@|3@cLGcJY&#l*pR27DhNhSUHZwQ8XP z36+osCeW&6N3Qlg)~^-V($9N35+zudkdnSwNVE>?X#T-JtPtxr^BbF|4_A(JmS_P;n*EZKu?gP=gTF8AXi6c@BxZnjh`Xle|kvg@dVN(IT1 z6}s#}nfvUKx>C+h;;!t#-yuI|Gg=_;7tBpgO?|iaYPQ8Y{3z{pbo32S&YnVXQ=HqJ zT(pR44V2vzjj-O2n17MTd66GR8+1bVR_PVJFYTxaJSHe8=*e_#@d{A%R*s?fQuKrZ zok@BMZdgHCzr(h+97fbGli{9_6f6CYoj~2t_MjRytFs&H21s+yV;y=~#v1`21m~ET z{m^W}zAWuYZ|LB*U0t4~i}=^C1WG9?D)Ovfx`7}v0NO92AKGTarY$vWSFkw}9=nbN zRPP9J(y{Gat02rL(~!(e!8|NcrTb51%~D;pJ!23v#e;&{R|2C}Ah$est9C~~QGtl| z5rzamKYxaxJ317$g&Sc7BrjjSM0PD~Nwv3143Qg&Z3pL#B%cHm?NMJI&;sXq_}8vjuLI{h63XCMa~uAf!WoVJo#Z5>OB%VYMbVEBP~)=#r8W@#C}~fEk&@ z!~ti#!<=c79i=(tWM;jKVGO#{h$ zvf8!A@-P|+_GgeKs!k@PV?8ud@ zLe~E3exkbLRHfc%$4>_bhf2pEd|@+EQ?s+whz>e>mgzmGw)N?HF$@xSxgSDk05r_T z?qgnu`D)zjf3GKv@!!AS4Q)a*8yjXl{5&!H=~~vH(+y^Mf5Wx_62ghpmQ-9d`CI>w z2yf0$JjP_3@a zFQcW6O}=7l;7HWSUQt8-!lC%gK(})S2=dKHS62iL|x~_124{ zACvWtlW5yp1q5zEYl7*0a%yTgSeOi3eF#DDdn6%o4UDX&wzkESzZqASR#(G8=%D9R zZVtNvHn{#DjyTR*cQ+ys{hn=&b*G=mhFcE0#_8KUDtkZoO(voU87hIu4kpCjVT%Tl zY8lYr$-y_3D%<2*vfhg2g*mjMCGG3~6}Dok^p?hSU^u<-HKvjZY|*nVp5fQL*tWK# zSvw~-5Pi@_2ywVb`2aQ~K-;pwE}0BMDLw9EZu=jH$_;NrUQ2I3?E%f1NjNP1U4$M)OX z%F4>G3MNK5+9g$Ps|pVsCJB6fN4J>CgLtXHl83mAu5B&48V^A#&ZlunuFw?ZN1<;W-BNxyG}g`lsx#jz4bMn+Q*dXSH%Yi-f|{rwT- z2hveD#G}>V?bndrflzVSCWOq_E9hs-;Zd2|PKCRhO}1GyKo-gYQ~>~PIGsC;88<1f zc+8GNw-N=Y$4%;0T0mC2Ln`ixnVEMX0lEBWkZZYdSgKcps4MdR>oH%%uBf(K_v1O* zn!SF<1YMjCjw+I!oSbwH4$4=bf`N;kSNiq9&BMXZA(_>`rJ+X}1td6EI+pYaR6Xb* zzfC(cwYIi4|GT%kb8zr1EsgBuU4sZj+NwekzH0S^?ErI(4zm%4{Eo{co>?X3uSaaX zQicE_Z0FR{%fp?`M(;Fcq9mtf6vbF`3mVhK^YEA-wMIZ~;JRD9b}68&_VEFR<}hie zva73}dkd{dphZ~){w@Tpvtj8Nm>q79tHI;P+YM9|!qXn0dKF|5XvoV?4?rHFSo_<<<&`%jO4$3nYcal#~6+Rv}~1=Vy4 zSQJf6Of-wtubTwyUJtsu@E%Dt-hf8j$xyOz1%Gf08xfd9bdANG-6dG=}X; zl0Ja+7lBKuT45{#-RtGO)uB8FTcZ-~GDf58ltff{lYy_JV)Sin(7>S)z6IF*Yph5i#{NIQy_;N?ZNLKWR(0)&#J22@RaXz zaP(G752?Q3Ix4@HI1^7JL_ZaD4{%4dvu?RPG!v1|3q1KG&K`V=&nbAZfW3ntGcF-? zu?lRJPBKDH`wEN)F+ZM4+(7Czq~Q_n%SG^#Vq#)GLK-5~R*DYu?M78+mf_Ey<-pd{ z?FedHXGxl@vnR8gD31eZ!T?5652`Y_aX(-T#**NJ1+}0crp!LnaY_Yw<*pzKz!!em{z zxAN9+NmUDw5wT76y#n^ypFqnc?-)1+%>bmG1Re{>6gS`NR9t3P9PjLOf*|C&G0KF{ zcc4J`na1$J-OvjogLypv;5ulxnP))AzkBa8cl}nM*Y=#qb4q@^&!0b^oNiVi#-?0f zQZD1?_+sZ!T0Tx^>nOnM$qvL*@2;kq{5rSe0Dcf~_PZfzOw4nuz_Kp7px~Nn>EXx! zc&rn>rLP>md={Ck^~ztr6}-5)Ih6cHZu>6O1rRpXhnGqD>iJHr7KOpWtPd|M|0(@G zHGfbCoxJ1aMIki^@km=ZDLL8XTpwClYOq~EFTbJmmKI>d;@aAsL0b=Sh%9tCT_67R zsm|Dd?C!2n={Nr{#4Q8e24urSkDtxnSxihUV7HGf=5Ge$Qz#^e;0m3ZsQA5U04qop zfb#RCtsXG)sMe6FiT3L-@hAmE77X|+y(@}F@&6#Eac2U>4&f-@5OBCX(kLRNUJbuN zd}pC$yPX(<%(X^hY*sL4jqhPf0kW?j(5yrS4O$O~zs)5MoLV8kAil zdDrP-0vnr~^I*$z1%X)bN|Nwy6_i{E5!a*ABmDa;0os`0;cwJ-9rJTE0(X0u6?Ph{ zmr3!`*C!8<`Oz*nj0UcbcqVx5zP|_{`I{x;e-GrdFdAdjFOg!j0Xw0}+uJtg=GUMZ z3BfLxbUHphUZmCXlCdsY0lMdCkw;|PUz*&qdPe8~8|gNiM(6Q$P;#691H4gc;C9j{ z5Ine@W&}pKjRk1k@P0~uiH#R$e3d+)tl%a7z^wb9!6Q=o(RygfD%Lws%8QPJm4Mho zrh+E$q5lzw-|-(@Z*Om?$B(LIt167!Vvum6h;wtQj0M+XXyDmVt~B;+M-{+5)f9Fe z<)rC%@ruXCLW!CJoqo8X507sPvFUp}Cqu`%719@*T9+uCNChbOU21Y;Z67pwMzig% zs)*=EkgfTv@d4R5bns8MYQ8WQKV}SvB)$w3CaK`)6D2>Wa%}RBMtK!y`-r0s)RSj5 zH9UwiS@tJ675F8LOjXT)KSmY$!$`LVvIr@)G&_VBw|Ot7yq%bW&$FV3iAmq@Bw=Cb zGTo%5O!#e359vn&fL@i|7#sL;05w}459D6|{R5m&*HPe*RcM?&e^k79fhV9cc`r2) zzk?^b`uYm$Z{*nK1NP$>6P}WQ?mIK3S~fApG$=n974w{kT2dXdOq-&8V-=uzEJiCJZuJ(;>kpL<~oZ$FAQ){J8*9Ub(ELNH1!ei#`Cn({G3PR z33$ydEf$dbg)d*@{6}H{+6kC4HvSrlfam#5IL~lL2t83d6JL;7-UtHnIgN-ulAPWf zw+S_SZ*$83cBhL76eoAP(`!m&?{~CCj))X*AHT^1egz5p!rsWnu*C}(j2uLa->E^f z?VfA%9|6bPh+1tqC^tx*XDp`nyYt<&eO^xNRxDnQVmz&2{2TrhSDSqJf`HG??XBOw zZvQ04#o;25AJ!LJte(Q>l4Y^AZ(q>xPMa#Q2JD~n0iK;hFdOr?uV{vbhkK#zmH6Vt z?I~jcx5~P@aL9-h{7w!p-t^)_DfU0w8u6Qb2vAmjnm9~k>ZrTv-U#8dMz>WgbbOlU zAc2?zlST#yu2QYiii@>3&K`a}XZ%)B*KsNNSgfVnZ${wL#sjstZF6!{zyD{xC4tRJ ztJe6992S)+$+vIJD!V^UALm)1__QxsLJYXLy8{xC6nFoD(_RwBpz^m;4iynOi*8I7q_*dUQxbtw^tCt)pEO zNE0+dQn_=hZ&6Y*+`f$hTI@|IPFY!5ARDoEch`z7;EE7;qmpjmh)U=xZR%7=BEH^R zC|S;ivxv~o9d+{^*zCa46$+n*1o|J*?W!R)$eCj+<3ULU#e*j(Dk>`ScI;|Tp0L2b zLSWw3$9AxMf(+ZBi2_h3szj$ECZ2(^PCqUb4MRcwY$;qZ>AO~QtQpx~fp1rq*4Ewg z^RzG|#DT?W++OvI?myUWnyVIR1r8qwgdew#c@g7)8lQf!K0h5 zRj%OaetXy~rM`f&NrK2UUVRiJ+$bmr=m0Ye!n#_oW0NkFHOvuFqmg|MUj+V@XFnzGj}e){z3*BToY#Mc~4#ud@g(ea|Kf=%oFGr;X;U@5@F#~%REG7;!C zbiuAxWxc%kKm!T`xmzh)lp4Tg2s90~?<2Gd;O;ktyGDpcCy$rF0tZSCcjoJi(~v#U zCIO<#Ol&)|5IX2=gaib)H!^YP1I^6Mp8{us{*buG%~F%L#lB2+dL#G4Q4;xIN9!YK zg^HB@=wsk5X!QD2seDJo^H+-aMOGn2e+1=ZbUlBCY|d?yGv>gDU*WUD$h8gT$ zAIawqJoV5!^8>UFKF+APxIPe(kmC2f%zz9If%9}d&C8+G$5(Ku=V zLx79mrz$W#kR5J21H;_&uQ*Z_o6}mhoH=J8I>{R`O?L!$tYb>BtXAC-1R9~ZcWZGQ zy`FyQy%bstxOM6I_z=fik$O0#RtFwfiV>%VHCKH|;qtZzlCQa93J+5QuUYUJ~pOuqWCZtB=u^vWj zhY(Mrf*^VJ0Y;D-=#1dq{Exo`T`d~m<_u;>?qM^itq5fr-((vDk}WMu(ETC^5zwBD z7DSJ4&b9dCPfbnfSCnX~mkMZ-swY+cB;Cr3Y=k@4$6-%sZEbX~YL9AjX`qZVL%fTkuto6w#BM51g0e!~uX zuhv+nxZuRO2ph-hONAK7w2GU&;8wx4rY&W*RUtUL4dDU;Wi<3h+fHmiA3pdqO9{%Z zG$bt03HN16q7O2`Py*;T4pOcBTnVBtgIM)BTkL8Sbs0#{cO2Vre(BK1zQSP(3^f>9o?V5eTYc8yWb$%x3mejCo9zJxGg zBJ@3rXY>U2%2ce#n50>PmH+2fKZ@e}<2L}=E;l>&_x2>9$(om!cMs53nImVp${nTj z+h-POz)$+2TvY;H0SJtW(tf_D2m-~2*OG%m9_zOUErufQ-(#NbM;%vW6jkU2d$aUF zCj|Jy`Z^1g_Rsr31wd$jW)0`e`a|0yn#k}r-aaHURHdM#r2M`dW+@;nBEs}{*z4!Z z2VvBO(J4<v; zi~fVulm4AKM?7@1clt7QxwyE(1Os2-s6dd_8T0HZGs1RnYpw|13@ zvxP+%piTxhHZ1V>NY_|@s?Cy51GyttA{g>2KBL~@NPD1v*#x6{Ov8MTK~gguID`TkGl@}^wDqtgj>Hu@%DteZx&Hi2jp$53 z(e>rtB4VqwY|horxPh~LwThc2BOL2mW7h=0Ja3zk>4kHmt;d7C>yO%CqHb zTLm0^LF`2ENSsh;S812((hY9h?elb*7hhR*O+ZyI7r4QhPRVQ6tKliXEnnrV9*_}a zqN>2112%dnD(#Gw7odJLl zh3RMJWzstNRq}WLCjvhucnHX^LD1pQiW=%(L8IWGOo6+lVk0GTuHvkH7>@LXiRK}N z+wAlOx6b;6L^<0NujgAYw#k=m-`d}T4FJ<9aID_Z03rCg!Ss?mpr|6Ob~D&?8+C4sQF`>r1D{*Rs+*o~ z_#EFKzLrw>1`X`82_^9Jo_jd3_Vw8XKVt5?iVWU|ENL-OZiJjTl8L7(_CA}O0|ReQ zBz|OUEcRRF%#Qxe*57=N?CjwlJWW8-hV)IBOK5EKmdt; z5sc{s<6@$mG-+IhMB~}(^KeQRIm5E)dH7e2GEYpdiuo~^Ta##*Y}?9-K)Sxos&>}V z07Uvp+gb^7mp`0y%G;M|9`I9G;ie5qx-=284hWjPFR=ZsrrGj7i&?v`{EY~tkP z1VaW6l60S!w-0<_u7CHeG6Y<&LA{-539LqJw46rGIl%rAKlSk-QD;w&4a6{Kp9K^Z+g*1WnLst~DB_2szYt3oJsA z!EXyCbrl)4)Wbg6?94a_gSj}`o?_ei>d(#KjU_pbm0a*+f9b`)st*0V13=kgnbyzMfwC^$QEymI!P(+L{8tebTy| zeri@$d^k2)H|Wyfb?bsok+kfnzq+tQ`s+PiBti7$VCZrm|5?`Vy=!(641KIy4GBg|OWvk+DVDUfdr6-zuSfw2Z zaGGm-_&G}?7PdwnoL=#3Fj**6OuOf^V|q^Oe@v}CR&{}U?!T_};_Xwpfom+7Ue9Bm z-X`TRjc!Y0AvKS!nz%)*21kbTn#R*}MkaC1Q{J+eq7}-kfXv-K^$#ng(yytJi^K{O<>rJH9Xq1qB6F zJw4VZN`SABAfQNI?j42>o1dTG(|(RXJ+_nWx3^kZg6Mpdtg_k1YHc+T;~7Y>y4999 z;Hd-6jN+iWU_!bJg(1NhBSEIG=9Gss@x_F;(@7_@D*|*y4rrUgJ-@@iAaD8d&2po+ zyN8Dql*sgzb^^~(u8FmD2G<@tD=Q`+rFdeVS4!wme8er-ZepdRq+n7c*TuwObu}b! zY;G#Ph5Y7(1UH-m`j4A&#5Q48CWR)Ns24Wg@AZd+?KM1qm4mHqAFMZSAB}F?-#)bLZ(m z$}}2N^k!UjMY|uRqoX5&0H7@NfIkQ_F>|q?9#;6ZcgmR(z+6E!?f+>xhLX7X341YE zOi&qb_4n_%(`;3xB>wB^S4wiD&l(1z<_^xo>bg{(l`lKG;uuKbLyd&cBg znSstuIv3`7P<3ww{}@B^Ad>LGnnougLJjV>u=aM*&FX&+{gk!a{0<2yC}QB?!8jA^ zb)tzk=Fz;vf*Y!X=-LN=W0m&!;5=90>48}i%=UZ0>=sGKZZlT$p9L0EFrqOmiTKCi z9i=FAxeDsSU-TaK!%0{OJxgcj1aOL4T3VVec85Q8*0cHzbsS^>G(a5)JplnE%u_y3 zX30-u?F&c`m#cZM8(F`zokfQ(ym%k5ch)$NTqy>C6U`m=G8ZyzDDP8btd0(o!6R z!66L|D03NbzUs@MA2$62<+WopD&~Ju?M<0_O{|k9z$Xl;?mw^lOHD^-0H{U!igJ{S zDa?9EM+6)8CrD2JSy;w;FRc{ptFu9(Xp({VWjIOD+}y0>#vV30sxAx%N5E1q z4aQ)xOW%Wa!kYg>({~5-*uDQpl+`9wq)kzxiHf9wqCK<|2~ACrqBK+#rJ*!vPi?f5 zq^UyMTPYL4QoI4BEVXwOT-L*SjNFXkRznDtiYVM*Ki^5=AX4O-lUXzkOdDS=+Uiq<}l zC8(yRW`lYpP7{)rb`Zc&KeV=*ekND05bp!g$~QMNU_d2~>9=o>%M6WKgW6?)J|D_v z$QRx(@`;NVoOOTncXrmq($WvrsRB9;@)M4Z-uMahA+fJtv)r-9&V}}|AES%L4D;a5 zeNu<^s5Gc(%-FF}XfPImSE{9@MJJ4BSCM`op*D&55*>~= zrcc0hMz4lxL#`Q5pZ3D0N=|ii+ZH)-KP7jGA6x(S{A4v6tj7@%XAfChSqc8fx(k(3 zP{8v>AQ|F15fl_`9eX*1*SY{pNS1YvbX9fp_0P;ZcMd@BLE33J5&VuhjJ*W-O->^s zDw%&dhKh+kvlqG)jTyuD!9GC>w67vU1}Kh*r@3upPV`e;?hL`q!00(}tL{I#*dDDn2IuGee% z`W-1MX}8*wKQK|50Q=!g(}gRm?z5L_~y$R>xds?ChrhDotn| zw9{8kO5VKoA)@i{paz5Qx}hV!H~U7uvWm5~wl+cF4%cuWG-l7mZbl3a|6RSUqNPF` z$uxS6!}h(ZdhCuHQFc$-jVk5~pSZoKy}t_O6VE@fq?{bafAhbI6a{eHy`-f5?L6-_ zA)NUTxQ9qk59$}v!%1#ppq94+Z3xUQUJxnVU0uA&>7Hacjs;8HpLmH)1=dEeN8lu< z$AV0VR*${d>-xuG%tcbgz+j;it9v@WP_j+k&`{9%yn};7xmk`}zw7CK`>-R(Pk8X~ z;Q)YYo%gPyuq&c~C4IHe`St5p6MP5&7;*%CH!<=Zv9vflv-nK?F8`OZvnuDW1Umt+ zJpU({dCwjipiCf}b*{1OAjAkDR-#QpBgJ3sd)sNUlXzLlLPZCcBbay=)r6K^`Vn*( zaiGc-FI>24pq5Uocqo>wGlmyRp$~o%_4)MyolAsx$I`+7_JIK4iG!r|?DC>L1Yi}gVqR^CGBHpI*uQ-XfdYxu z5y%vJBAqY|GZ4D1_Pl(&N4xfZO6Fyxd+K&(1D3mpT0%ajr}*b;g-e%MG4Uzb*&QKo z3?K20pps2k- z5jVAk4Rn)V_Uvu6<<8%))Yo@!AjMzi;@w@P-9BN(#m9hx2cfO%MFoW~&S#KztO(R4 zS%AQwh)^hqUFM2`TEO(72T}a0_>7`dKd8-*?8aV79^r`v6a$My6=aBVZKDjIu#BL{ z-#W~fjb{cXm6rGgF;a!M%gS0>@{@!Fu-yB*9%}-WKyHU><83KlYp%gj&gpvxt4mqg z<~g{v_MA)isLmAsM0jyx4MgVHVW&xbO!irVN*6&NRpEs-C8=^fVwc&AVapWzW7=CX z@vKI?M|Cep6I`kPH4j@Rupupey0w*|Bv~nzRvN$xK^a?92-~HdG zEDm#`kE}XqxEL>eM+>kqsFty`d%p~f4$F}A5u5}%7)s0#=-K$e zd!v1N2;f)t^yxGI`e$({dDgTZecV3l9YR|xp4DR26C3>n{R2+_)|oBlXuC##6bOZU zh|&4g^>*idYC7JIs$$n!{$q~6e4w>9m8=pxdXx!kQTECe-f=Z)q_xmUOG~%TyzWs- zj1EzUwWE-K##lcv^#G#~yW))^GxD%3Ei0t`wr}6Qzbi`lfQ^j}2?wzKH+S=(Zq5eC zoAHucQPRlvgBRMYzsi?Hipu0xedJGZzG;)pRxU6DS?wli@afXQmu_e(xg z!&;SDTUKv+J~lSi)b^}>+rjYjybGuQfXv&l_Nyr64MYk!vPrdIleF7_mc!g2_$B&A zUvTDeQ1_9wg!4K%aF5GQMwuD6tsHz>!PdsvI`4s_oRdnVhdap&|L#=m#Vo-yB82os z3$>YL20sL^ZNlS)fTX|r9<&y2CA=4O*Wk1t(9w)yDu9dKcv}8{+nO!q;&p#)xC9;a?`xy24H@Ztm#xrLmIR*Z8XBeBRB6=*S*qZ z8%3{}wqH#6)$#jJn2#Rq%M@SUd+x;LBfCMc2a-NsQgSy`F`oJPSwc!W=gyw3fHaky za41izF_qxRxXOPs(QKo6nfwZaa3GUk0;^8=&+t}lraZt|uCAX%+)9pc<(E;0Or7^Bri|bBt?W z%NMVno0s{s*Q_P3J-J0Gz!k7McgpWsoJ>W!*?>gTd4_|M%D^z{Y$Xeq9z95Mc0RCt^ z`0+_v9fLmJ*Z=7e&>8sn`Ef=BRW-g%meY2#YuWdcig{wREiF@Ygdj9c4L)5$g$Z@<>ZpZK1*JEjAtV>zqic|du!^?pSXxOVi}OdfceT6Je^E_OX=F`?Yxo^09|AR zgA#C)CXW=xw(6@fcRmz9DzNM<6y8QdlRW%RVNvfxvKS-H!PS$s$-xK-D>sXHe)f%r zxz(xHCJl7lYP9$x1bBdkMK?^g6~9s#IveCdm;iApbh=RZ?-+jizt7cVY(Q}UpM2iV zE9TUcG-=k^Z(Khs7-j}t?PrzG&a9_TpBAz1W>Zm7ArToK9_vtMRdscJVJO_r%-oOC zh3pNx^!z_<-mYzc&7OxFp!pjAfuz3sHv%;ETWc|m#0`| zIbsCcDo`0t3_5s?=2|1-J#P0=l>IXfq-A6T!d#+iQ1m>k1{Ge4dG_Fjpl|?)*y5+4 zSeg39#wRAXcYpn>#go@mGoyQj0TVyLQHe^pd2b|BG*|^t^qv@+-UxaXg5fqppY;u+ z8)1T*nl2)hp`HJVo?gVswiR}1N`I!KwPIO&rQGD+OIDhSsVGl$7QJadUF+2gBMG2s zPE6f<_wH?KT9^vDeCEtXBz0v0XCuc<>%+!GkeQ&=pUb$fQkTw=1{xM?uaxdgIOukP zD8nGooT4c(Iy&k$bsLQ;BNG#m>0&l{==$ZNVAw#&1?f}B|7vZm%G1fkKG9&+p_}Yd z0QA(_)|NapsG(gc-|kt1W=sL+Y=pSAp!1DvR)Dx@fVI+pOWF^g&(r=FjDzC>IzsL7 z+WC_n4k7hZHR zyWiiQ|A2lNp#(LSH3#q~<>kG5XLa>-f&2|T;QUUdWktIZF8rybj9*ajgXhMr&)a*U z{)GDp17m4NPik!JIvl~Idrr+PArn*0oB+F5jhQVAx^0c^{Cy@nKvu42(PH;Aa57e-Fs zJzcJ9VqxKfXVH(+A>#PNY_Sc5(dQ^hCQ7Pp z_g=rg@~mVH1{=@Dw&2>!S(f|jy(Rf*`t{oPy*xohlSUSAqb?JXPUFBT<1WA^fWH*d zrHk>yZKdJQpBqDj>=P8E01R$J($ot0lLt6c`%tmiZy0tJ*;8W}KQtZDEsusDngt#b z+XI=4UZ(L8F|iMjg)jix2C%tRW9aSfUAv4CVTMoyMuV9x6ku_aM-txiM5y27)-tKC zuHK9nS2c`Y9N6JfWrC>3Gc`a9=-xi&1dsAprkqt&Ec^et6R-{LM5$lvoyUx}#qc45 zK5ot4+89)4EBoXIrT^R(%yNhL>E`lgp+Y7;zVmkC@F7f3Pm>w7_fiFTWrjU_3?^=} zXcG4%7BdHCXMEYzmdGbqBaD(a2Twy*z`)KP1fkL9Rms~fF3@McmamISl{GSACuUJ( zsAap(T0Zx^MOX6Tg~79YlPy0DyB}I#mQdN>9>9WySQQ{v0Z|Qm{Cp&hHc#&#svWMSlT&yFLcQ!*!s{oY)0SrBz$qQ&6k^HSgkALv(m%M*k@~Q za-uPB-q=42yPflQWxglAu<*I7AqH3|2AR5~O~LU(Cu3H2Z=Gi~!g?lGvEd2B1~~c+Wn8QNu4^zbe4~i|>S9!pLV;gaxzm z7|r-{O;GaifCj7Y4jnMA=jptAC0YQ#XXqDkI_uYYw{%Ne-Q-%{k_PEQAB0GrHJV!Z zQWa3P>xNAm9#pXMQHADD?8Y|=a1q;f9j3q(xVFf`NMp}PV;;y9j4!tsG%EcILEEbJ z+DzCjz_b#hzXC^3yb$yH$a!FFOaO7xXU`H@?~ShF9r&k2#C*#kwcsh(#?mwRVCj}g z8JGb3QLV00^ojqU7QjNWPdOc{8X^Eosrh;sNYN>NK$A=~3pzTR+?RGAz=5JMGbGcH z7!jm?lQwV;%dc(-=QZOA!5Uu}4UYYp@ha64=WOa_V7g6>7Ky@UvQv`N_E|l!8n{d! zKvCZ7FH~Y|&~T}C$PS1f&daC#0s&ET)?VOE*b|!sDOzePYRT~@YM#kT`Vk&NsrTbl_M_J zYhQe+cVAgD|HiKyzBfXokeJacEU9u3`xBrkNCaeJmk;>)+8UVYv@)%3YzJ(=At?C< zA&g$W-1jszR5tb^+0DcngKwb|Hb;k+=em9#zvOl zPy(ay*y!Zo&ZRp#+Z-}7(3Pt-N&+0`O)PsJ5kZs&nSZwJr=+BGoBMthrJ@4e{PjG# zHFyGBS-mi^5*=dF@P<`AIF`hFG#1CPOo`kIxO*=Oxh%kaEORY%naRTfpM_qMmuhKg zX=7tYe_|5Q+Xm7to$4R_xI{BnS=MxNs?c4YGID$#J(7cnehMO8 z_vLvU{_<#;9*6NoSDK)}elFhdDj1<#P%&-Zt9?l!^5dp;|69ko&3B)tXJ8|!$^`!a zjeY%V#;b^#-@pwY98iD#ZvOh;zkjum3h2m@BU4B;iHH5*X$n^&FFYtDi`e{C%5AQO=8;yN1xiVyd1dhei!;YlFcO%FT2&?X;QX`nu&?Uq#Sza8IF%Bc28F|BO< zDoaePB}6)Oe}8?Sc~PJG6+kt^u3bKW2M8+vH056=FqYocJAe2NW$I+FM=FejO)mw| z@Y5$^j@aE&3jkKq=}dW!0+QCYy?>NhCp1qjEiDnXZPKtCD;D18Nb%qG?(HotB$4Y0 zJ|sw;a_#j{#HzpFZ1F9N1JYZSLp^U>GmX~R*W9mPziu|xnrtn7HR4T?g|Mio7hvAD zsEr%EDeXJolAQJ<;pe9cOPBxnV}}Lifo^5=P30HJx-n7vxeFI*yp+~@@CuC$=i$Ry zpJozJTZvHyo0McKwi-FEp~N9SfoJ*zLg8$joF006Q^BcEIOEY#3sls5nG#E^nnm3< zpOk}X4tAt&uY!9W4RvdeGg{fNmVr+n^QuH`f=H2=VNg=O<(O~H4p|Chla%G2d`tc# z3k!>eeMudPCw7q%Ni)^j{o z{AkZ{W@HA*;;aei$IIwL-6hr?7*@_+uI_(J1gxv8tL)3ipjd>uk^^`ZLGj^6+pod5 z*Xq#6<@X~JvA$-%pOjhV+{zcLD(M(R9o3jwTv|$LWv%>*C`=Ux$CE*OrILpFy94Jg zF6|WhDD-oru=ILo?&e&F+>J8pj$+sfDKNXQ~5RkTzfk5Vj5^ zinq7-;lqcW?O!$m&mpE)5*q>}?X;WQiP@1iU*TUeO0NtgObGPMgd)Ogt%C0`0I2rX z5=P}4`Yx3I>WnQnj8zRicv?3*CNy>b>v?rB&-PW|M|*myZqy zsT*LA+1#A;76@b95RiItKN-wOy=*FEQ@8}$1J6a!x$~I3gRvRk$WaLM#h(PVdmrnM3UJ zj_ghoGWRit4Ok!pa$nARG89c7s@*2C z^EjH6T+4G;c-9DdfN#v1eXYoGf(1OH>cxv?#oL=NA$JqY)TgQ)<2C4<|0G#5?t7s< zzo@R>P-7W>-n;#Qmb4w)=1+@}b9)a4hVPu&k_Jm@$|C5hq+uq1{8~`uF?!P3FQk)F zEHcaZ@93TtWv_YPUSdYgX&WCOZ`)U~kuzH|Fc)u^!FRlGNHsn7i`wZi*O2gVUo^#x zzRHy(nH2G+%Qsc7mZ+lv>*mb~57yV&NfgRdI{ zw7*!N`1&;!aO@Px)ccN<=QLRbFxkIcdNb17d-BlEd8=GjogG8BGOgL>Bd%V*V47Ix z{qP}^Z=Ef7byZa_PAoao+j&~`x^bCBg+*m$P4^UUn3r@TUGm9NnWMP|RG@D2T~4jq za-xVvz=0``)|^BkeEfBYam)8W{h$8z+K@!KYs|D|8pT*jXZOau zv5b?N3U<67Jz#iLL`3dfW~iJgJH+>R`EsWAYzH8;;$zfSKgSfEF6CRL#SDaM^rXcO zEq(ncwW#QMF_OLnq&_~lawYXFKy>umCQGvKanulLDTo>pW|DhDY1lfE9y5DKzI9#k zw!l>8pQ2g&WqL8AV7@WP4ci?V9h9m%d!Xa-42zdGG;2shh1G#pN zAZ3}6eGYWYX8J{T8%eYS{Of1L`Ra<4%tW$ol>PUKY*&~!zsw01&sq(f^L>=kq0@(l z)6&|S5D^4jN~m7`A8s)|BH~n3QQ>8b9C(lqgv0dfK*n7I-zrTpN7}ipyaFCZI19cI z^Zb)bomB#3LK!Rh?Pu*Ra)lPW*+Vsz0ZQQk!j*}hX4x8Du zZ(`L<@6cJ(P*al?jnNVOnA>b+oc#Zv2zGAl#r;XcgN0x5D32}P;$*x8zz>}=URBg% z3^dtS8~1W%*MF|}d9jfE$jz-*bcVzpm}Xxi?sp_=P9b|F`Pa`L_W~Ga4_?ZDz)W78YzqjHl+0bv+ZDqz~K~sN3%1(VyF+~vU-_X zN2P2L6%`#54|LnXT%*Pp(@-^>NqifmKgH*{NOB1O+tu%nyUZ-gyMM`6SFo^rQk3~9 zFz^EqDxa#?XHca9YAYbu7RZNgSmgsW+9dw&Kk)CB9*&B`*4-yCJ@(bGyMvado@LQ1 zxK3#xRs2RDil~eh@G^bAC@x}*uDh^GJ|iutt{bU z;2Tip&Ogt4dL+ZZr%Fp}iE3$T^<$*YGGI8xe(MxaRG8sCg-VwhaoDHT#lFTuCeaq? zJgbVIvV1`U435SI@F*tFI7~II!k^ z0nH&%3%u=9Q&WF&Bg)$eIn%bINjtMO zuZdfCS3yO7j$7=eo}S)w%osQd4%_z2)%Nfqj%F{hu48}!5&Q**EJ@P`_emP`*z|Pe zgJF5fTq5=k9LzBTioyB?r(XQ2|)uz00|cZ0e;s!Rorj?1^(%ySpKw*1+!!V`S!ZVnI5X%#9JdeAHy7HPfuN24re#hs+MG(=lkxe$ zp<2-_3!|j!?yTmvS8oe+f6+*(S-3Ztt`({C(V-TYRlNK=eBVskARvKP|eE9gUd9&zC#3)}d{jnBmidd*Eu zWsp8TiHPun;zKDzc-{$98B$(2^EKy7s1%cy=B*LC z=`E;$$y8DzgC8%#C)(zUvBkXx=@-7$VSXj$D?Zg3X=zmu-0-Z}HI5(>%P+05vY@lXtUwa@J8n5d zL`1Nl#6sQa4drYZ0Q2tdZvJeksXHVC5dc1;e`a#B(k&jYnr6#g(WThP&kdd2m0T@<>bV=NbVhMo?!T;iaFxa3M&M zHv7$+H}_w>*n^aYe?e;{&`u&W$$52IGFtkMA6m@;VBT$hQc#Sg>E&&KNzIMwOX&&c zDGG>=xQlOg*JKJbe}BfN;6Ip8Z+Y#Dfp_}F{c=)4KBN(PIEft-W65-s^s|DKU5bJ; zcUeok9y77h(9mq4qvePoIU@#dStFYBrnv2YFIHvKQ1a`W|*(ppTOz zlPyxGA6U?uC#0v-khI<(KjJ~s9TpKub9@9PDAsbQc;@OW2&{nlRsnGE8ER^8mtT9l zTGemQri^nJYGCz7rGFgx$1F0pskMFZ!<$M=OG_HU(5}N^d>$9GmNQVQUkC0J;aMK)R)_4 zrbChlfB3$L_)GIvhcm997ooJTy^4Nq$A}xi1k9J-+)X^Pua_#Lx3@m z)8wIn?m$P%y0UxdN2ZA;HEBBDXBgvl8D84Ku^o+3B1E>22pT#2)>I?9RVhlJ;m0|u z0}2d1Y9~+;p6&53Z)O5Ug00S2Z-R=jN=Z$R4<&-mo+qUCW#R>=p5o`)#%Kjp8^a$z zJ}H&Bt7$pS-_P$qsUSw6T=#k1w8KM%DK^)e*(Q$X^F?q0IRLM664YAriKwx&7cMB+ z*c=8`)_kI}<`MnGFAejikFOb~`{q%e$sHMI&zX>La}RC(+bay8CDa#$gxCmbixqF#eM*w z${A79@tR?oa>aMJSE3^U^K`j!d581D6i1s|+tAOS07-!LVxHLA5inU7r4J3 zqTlj%-m8-5_NSIl!*GFax7aRA%V4+85sl~E?s3dM1LfH% zUESSJzQHq`Sj^K4SgLB(z;YZ|1b=q@!?{LDBadodgQj~W7RGJ&ENG#H1pdc);DE2i zUKIzDLqtu>wlBH{)qysUwrVEH&#LQftZm4Lsu>KWlxRn)W^7XW#xqMl-~;-OOrsmQ zdR?gBMIun_ni!h(LG!Cu)zPdQ8r~8zgiQUd)9=?2Z}`!5LaImsm;`%4erh=Af1L4# zfJJH0SD5);hGwSV>Lv1zFp5L$uiO%Fu!GWYaT}$|FC2bTwU3gk=+wbDcxPq`0bM#R zLdSOp$u`{5a=RCbNP&@@*D}@7Ls_uBQ%t``NYuB5b1mXocRp*CH%%oUxB~w zGt&I!OJ!AZh|fr$1T&yo&~0%M7k&w3b>!bXw;c4Z6x1-FcTdX(I$dZR2^+C6ZAN%A zK)?8?^tlaS9JVm0@)IqdsF5ad@KUTUy?=h#WIc(8K{!ODVp=I&};&l!1nPD#md%ZB+PsC3-5yt)c) zDWP>Z1ALELoIL;~q^k9SrF39w@~P9*szojh2xkD!zMy2HpJ!0wwwvUhgTJ2Ek4`_) zTx@W?-$g^Sr?(`_>ay~QMx0P2EdewXV`H^a9o(+OQUKj7Q{zzY=)HS}Qsn7tk*8nq z66Tft`$@b-TU6VQ?Q*LVt)=y_oNiCG!m}5)8~o^GW&Re-2+8t7i^0LqpQ2R+YCvvT zBdSz=|8~-7V07`|CW$wEXzW246xqSSj46`!pMM(ukjQuq znS-!nzYc#9R4P7?AJg|MJh5+i^7QEjMB{GXxs$2!Rcflg@YB0HHJ$-9=2dy2Xs$Dh zO+^rM09y3;R;R(#6MZVO1^SE7Rtfhp9V^|+R^!L*UVJUHY<*SfmQ)40r56k6?)#zJ zdL2FALy}3VYHHl4#<41U2L|rrPj^CnBwqx;439`V{&#vZ+N@rbD!|J1*w!h3C5?)2 zZN?LY$6p51*?tXqs);sjtaM&pqLn_Omv>WnVqp@e6{m!RPRr4G2@`aZn_nDvk_W~8 z%*~89a7c)Kzm4UuM;>^UwL6%YC?Un`uIiT_1@HJDEp*d?ePMdvw~ilbwbiz1ia8$D z{qlsAY_->Vn4W$Jwxi?`2;umV&6hNC=MWFiMtCDq|9r*hM381^aIr%510uHPYQH_O zeG4or-k%}|ok;dR_MILi3=U)4^$M&=PJcgOsR#UAd`FLlSeD>Do>cemJ`l#n_rN6n zq59kKRSXis2+?-RSU*&VCZiI-805C`!HsW2#HGjnFg(*|qi>bjWOXP)y>%fxMTy@;BRjh;dK)q3Up z@(;l8s5%$pCtiR+CAu02qv@HMwbFU@FJ7capkC^WH)2FfN~pF=VlguAfn{Z7ETa57 zwrnJVWb|jf13@zKdU`A#TWVi+<%$W%|2tZ3E87G(>gmszi`Ppgk$Vj^XlM1DgNi=j zH2Ph;6w_VIEwA`B5B%(LN(Rm0T^k#c{Nfvc5nX6?Ju{aFSGk})B$D;~KR7MvLS8HL z-d%sV#@7Si2Jim$Q}#I+{**+Gl((^pJ*qu$1x}JmzzWI3ZfJm@NI^QDL8=5?O5|n+ zh}g2=i{($ZYXOIZe08SW@1HR$iS3Ggt3kNb z`E^5-{KTnMs5C~q-ikvfro_X}cNZ%H`8Ip-K$C`|*p6)+W*%<+W6O39q{O|2GDBXzyR0iwUA8h63OGoxxg^EuP!DUXL|t-t%f%6QyO|Ji!UXI^4y5k z0T0EQ$^SG)52Ao>5E#R_5fCXB8yfVFj}EfVnfZIASDws`e+?4PmVj)&9P1KTd|c=o z`>zelPt{dkDdu~aUo*!mLByWgulq4bCVSI~Gm3}}eFYPxkcopc#viIzdfzo%18^RB zn#h+b2XNT4=m1v>r20H+l@HU5N(p-DJk`4{n++E_5H$>L^zo?@0xAoto~X`2gD};q zvf35B`*45t`X|p)-GQgy#?z%}(plB&iU6kpSDLyn#3u0*{KPI0NT(d+FZ+j1?pl~W zX^BaIRr<iW(BJ3{Fkd|!y}&c_5kr(05}DhEpS>8cJ=XSrT7dgfA5>Tr4zXkP zL3BXFs*59DRrS=JGxEyL&d&P|AAYR6YUIAM17(2Z_`Xz#hGL2Xk}9a(F$feH+x83r ztbyOc_4ilA3B)+>`Hi~HfUAFuG0J+1X+fedjNB=tw|IOKD@BDZD=+tOjvo8e&>#;v zU|UouO*;B1iP)cLkh$;D=5G#qrtaZXfd*e)<8zx$w|i+V_| zF2dq_7#Yb5r`7?RSHJUd+X?b|O6RW=LK|44TFPiCk()xWSoZzT2J|JjrGlzAL@6qobqMj&KdI=wcvgwaYR7pRP)4 zoLx#vs@;663bYAGb|V$)O<6eDu=l5M@sKeXV@NDL;fTla zq#YkZb)A$)NYGpVXx9A84+@5!w$@rrqSoempEvp?4f`wR=CNRTs`91m`!A}gc|uTP zit7Md?SmpkqL&u7Ojbh5A?#XVks^r;*AWL31OuCDeO>9^hbIeh=0%l!29 zs?1h9d^U0q3-RdyPCH$Sf+3ae1dVWA>IB@4N7X6M1Myia)Ny{sJEP>b;hpk=;f*!4EMVm6y#Owu(EtF$gFH9ImWP$AZSPK zkhnqvpqN0&A`o*B<2ore(P6y&bTfW7>iI_sjcfG-ONaW-7KpgkwC|B{c+{=WO(Ai2 zSpp4t(s0@VFWGhY@KI8?LmdvBjm4Y}U)hZStqNlA$8A%sVY>vt+(K*4UDn+E#NmLo z1JXG}tj;@qcbw`qUcFbP)Z*X2Q|Iu=(ayS8GJgxPiis!A*s7smgkJ!Y7DOMW@VB;J zIl5}FHHi87TbsQzs_XRIo|f|0v^0kGJD%mA?Zk{hpk!cxNh8A#-ati)QzD?Yb_Ude zPLAc~TeoiEe@L{D;If|~Df!N)V6ne(>CbtzfqUj8zY^_cWb=NmF(a-F3_b%pjNFEWy$bn;77(hAP z-WMAi+s=buAohAB$@4A-jI)@P2REt~2(HBF1~PFeiD$8V@3>f6L}HLIVVoDedUF;T ze%J)&2HyKIc9}p6gwDnw-3&#MT(_B(|Jq&l^$~Jy7$~Od;zxAHkRj9N28{50H#5*A zywT?c&e9j0fz)CtUyfDA7P5on^Dgxq3Jmr%&cX zuR7+~K-E3GivaU+m#C2bd)H@5cQY(eP_m%Ab^F__K*aqaEZfF+_0O1ZZ7%ccp|o>!ezL?f2lmrADuT2Tdr62X&St-yC8j_np8!Io$BVAIGq8vd8TLfLX-g z3wH3T*o7R!6;~|a1Ly0{hYyZCFf+gD^(r;2{NwX_<5|F;xt48PaBILxTU+4}mO>}= zNNi9}_yL1LXFwmhrRYR+Ay6k4i<8Q76zw{ zL71*Q*H(VJyIFl$`--%cWweE7vom9=)7TXFij|!M&1#E$k4mrH5EIE02_MAstAQ99 z!v5OJ-FxPZ@atr8BOs})P-q-Yt;C7zuXS*^USM-}Zcdda&sJk&i!$y~eZd;y8Gq+u z|LTt8;|P=@vx*0s$%<_G@+G{DKxZ4zG4JnMXUV2;e~?v2CEzFfirZN0fmbJPs=z0W z$PzhY<9*|5&m%EfK`$+PW9S@4oov`>Ev{c@^35cK7sHMnUic_)1Ye!i=`=oe%-89q zRLzs#_6nLWSGqVHVhgB+P>JFyQyEI3yJVlqf{FBzETcm;o{+&(FAIWxp}kqO9=^ z|I4b=pwepJ{nm-@zlKD66J(NP*8|UPDBgaBY(&Hb()Z+(Yj;VAX;af#O5&?2g7IyWMd-^2cU5* z=-&Ch=%w9cF=^9IHEC<|yS9f-QrRHFv^It3a9ZW$-Sgl%F_v1iCJ~Lo=K^8%?HCWy zCd9*`2LR7hkKAh*>Yly6L3vcDtXIOEW05NKKcQx7*H2r~X=v`$8xL#;wEPPg5CmOm z=VH&|MUm?e&?qJk{ldG&7ttPPqJ5?ede|0n*5}~|8h`vsNZ=l$Q^Pd#dDz~D?K)Hx z3xD5yZ)!JrtColGLewJ#P|8G`@H$V?00}66DOOQSiNSr>uB>pHljPzMDAznmOVc<37Yl~#ck^V7UB*w*^Fse8>?BjnCL@ZJ4~}`0e9qdIb@+{=eNpImx0zk{cbtLq2to3=W2C z2ZJ~w0GYw$ToFrH`Ay#MP_d@lE4~^{kFz3KotIoMHiicWqZ_4O>%h;P=8~G4$4(Ue15pq-Y)7J z7`K5p)m!D7tJdFx66n^?mW_Y`6x7rh$L*eW;OGJXKn0H!fi~=lq8yYcD8SQwzI4Lq zr(v#5-c{Ac^;<*l(&8X$e?>t7D5vSIll8*lBFC{~5e|}P55cyD)V_O|09NNq*J9tj zBfnxbqB7t3fYHxdTg_K6=!6Xmo)3%-0`wUj@&KllzWE;a8sL*JV`IyU*~&3|n1DEy zaQyXrfBqC|HoB^Q5LpOCH8%)+Nla!?(k(13WC^~K2fRw6!p2+-I`xxA1|@`ZoN{YA zri9KMZPkjsxQ~-_J=zL%%@st_<5#foiSyVo7RY^NNlRzdb&RNp9F(kY{che9BlM4? zu%w;q+m+n&Qo7x3Wh2H!bAwN;z?MA<3g#m@27oD~ol|3hCxGCqgs#M6S2eKia4D$y zlqcXa<2R6Uiibr9Cta3Pg8TOOIo4du$KgwHTO0}_VXe|jqg?Gnt$H}{9zTEXgVD|3 zs#+aVVRC6LiAjVGJFPBx2ax^cg@GUmTmXW$wC>2fL(9 z;L6eHpL>3rj`B3+XQRKnPh4`z5gcMiOf{KEMUZHM18gLbx#T|TJpg|4u5%GSck3%F z#nkM4b*}E0m&rUCBlL*Sc(%B;tK$BuRutM=C9B(~P>o3W26$KT>Fna%HKJKY*Fka- zaNv9>j&f>gYa>_Z+QR;VOz&*L#E#s&JO*ZFZzNz4V8=l+??ar&P8hmh@ba4C7&aKW^dvdFAiGKZ1l^f-ZfPGiHT8{e zS?d7dko%=uI$w4mn+z`m*I`s3&>%LweoiEVuKDZN8raJoW23{TSMlxJa|fk7G$P(; zjMN&(JEA~mP2L1b3MSw}(_16!_E+yTL3PmXJ+TRefSg(2f#W1pgI?qN5J;Z5onclX zMywOJ=N>ueT5HxM(GDMqcqlgUBS+ASDYjH=*vt4^l1ZF?xHiTKs2@4uB!$?n65TEq z=EvfLDRB4P1MVA-7fOsDaATZYX&p@gigwE4+pSyU-2n~<*b;LuQ>3(p8kX{~g=&R9 zsN+bCi(79dy;u28&ztOQ;mMxT%)gh)rMb~s0}iSJCwk_MkP(ar2$m!K516P!pIC#& zmT&-NLkNIlX6yIw-_z<`Dgh7R;eSAwpRuWFMKRl{L&)UAu=p}Uoj1f}yy52IjMQbC zlYv|ZmV*2j9KRIo7dT{Q@QGR!>z33s^cU~mz2lx8Hb5aba9}gJ5fQLS$ZL0H2~o!n z07pzLufXQ6vYDHY*Q_$E?|)`V>hGXNacYhtBNT@SU$O1(JQyWC;gtFR!K^#F=E@4P zbMj@sbzU$rPj@@6BN3SUZ+_BjDWQq~PWmU2EQ;P#(Q*2ndlaO8le*)3Q$tf#Uw?U+ zY7Q>Z*0qnRu!6yKk3wCEG~AT-fYS zlzT4eI3~J2IB1}p=X@%O3=q=JsIHV@&k=m}33?zv>y#MgNao7i++5nZlzdOm^_a)| z0d|qr7H_qzIKgt7?r+VMFc-Ij1dT#>{KKHBp_IJBNS82&1DaQijqf4J?Ojo~$h8)^ zYmS`n<`D1@1zjQ0^WzA$K{MRWqj~Q5@44q9HyJUP>4a6-##OQE{HDJxOl9OgEjs%S zV}2F#AxWy`_pHd2wcCog5 zas5oOYj^=5QJNr*U`=9Sx*!V}@JVHHnm8P&sI}?h?u`Te{mrw3_@6mu19@x&;bHUe}LPyKzEYpASm2Ox*KpZ5^S4f^{2WY2T+_czxt1Q zsKWSewGT3?5tvgfO@XlVlJHLZQnnMPU&EM&=vik3y_OBTQ_ez6ND3S1N+m_C*$f@L0Db3($Ue8Bu1FV zz2f7|!r7<^R|ZP}W>9irJrQz~K@SvzKZ0Po7J72!9Uif)@vx*W4va*GXE_fKC1fVAoBclH=s;}QWFT>^1!Q_8Zk z4g(v%WN+PceBanGKknQ4U`9E9sKj9Ekf6cEHQ@?0v1$56Y7^s(PedTqOj3LGDU~;- z_}lj%CT(k4X#Rf>y$x*1*(jTDW|xB$r$EvCQzRUfo}VL=`#^C-f7zW{@y$X}j*Az$Dwv#t za#h*fJl!__IVSTsZbMkpjf{-^H|8+h_%#ZxIj~4Mz6cHLmK@DqJ*Dt*TSSqSo^arEsHADKe*GI-czIiV*RIj7ARX7b_6BC~Q5AnB zznB;`8{T5$e32NInNinerK zhc#AhVh3P%Z;p4Ob9-}x;l!A$PvB|Sk8pn7q54}6%(-{)7xyvRXB=S0Xbq0_|9I9@ zo~XptZ0qya+fXdaEkeZeS>E%=al)rY2l2HSW45Zq!+Vfcf4$51lgf(s>~ww3na+S$ z@s{m&)lpvdP4V-5hmq91=i%R|$hWM+*naG{ep8_wG}|gxv!xz0?f7+Vm&h%8%z1pr zXrCB9q1?n@&zJwZb6u#`+MTxnVz51sfy_pzKf2?q%GtA?iHUsZFWO4P7*+~^)1Zo_ z+%fp)H@8dT@;>)0UjEZ?9Zg+p*;Ic?M8VXQk+DCO0{;*Ic_=OZ?AgspV~;z0kjt_~_g~0`+x-KE>|1q_MeOC(UGc$z zm4TH>;MkS}A91Bq*KJ3Ie+_$#P2*PUTzt0gxO<#UX4RT2Ztof2K-n!vAoEV7I~M<= zrpp-7Uw9x5s)Nk3?>jv^77h;8Z*M@GR}r^)FknB%PN>g}40KDyI;)wlAc1%Bs$3dgwv3MQg5b z&o=IKtfsxND0n-#T$hvb>#tVPt4PeID`AsiIkc=d<$OeScOPw<+R{qZZ=Lryo;}Wc z@#2Lo2%VDaiU}OVUkNUDlkShy=$)?{!#OVBY7_qd1DaYrs(33`idiMmLi zR>ob%?b`qs?Eqi8HnyyK%>@(Ob*AVN&3TM=9Xd)JqG0hVOxhhcTAraB&4$eYG5 z+@=~7_rT5lr2AE4V~QT9J0Kf&Ei4xFt7x`trlO)s>eHiKo%m6Px1t&pkED8`W1-z4 zwU;fLk~r4aY>2xvLYtMJ&%DQ1QOJfmbp2|<6{)~I(!7@^uvWQ%p@)VRx9#F?5hHBd z$P1?jX*aK2@y?5E$4&GaAD86*y2AD=;k3jy_nYR!7YW+i+T!3Ba({R3z1dN4#wGGk z+yMQvWPGJ$-~GETkXeIgFFL;Bo5OfT$R3mN0;sC$1vqIgTUu^eb6mCP$`{QrD)N5+c8>Fi z?27o)vB(q^&FNF~R?Z{uos4n$J64$&O$qEA6!n-TQ zkMn4@ZEMQD&c|_`N%iN)%SRSOu5F0n4Y1++C8o0K$hcETf3VDH$C1N_Pu`cOX)eBb zUF1e9Jzh;57sF-_1Y&A7vKr35Be^P33lkdzqa=f%t!!?-<$a#_eqtD(Uct=(-V){S z`}taqxVk@}rot|&feGC%;B54a5RfmTp+75Kka3sp#I(6ou zALwfuy@k97${TTqx6i1M^Mi}0tR}5&?42s#``ngomjSg z6I2SfxH$u^;7WtBSzc+u)uHkF?^|*8DbpV10bM=4IMpv7Eap_yoyC)|$pnuvG92(d zp0#Sz_iN)pgIu|9OSq+079-{7&(5n6ihDq4_fAd*LYT@ie!NJ+Z2C|2a$kU=0?_#0 zyMuS4WNz=>+32-TR8;d8cK`~*s^*tZ_3y=u=6y8w;iC#h9S_=iRcPMCSkFV@|@@E-y&Xj&fGTn9o=2(&W?)%t6(7Fx_pQ84%4n(`_o)DQb3>C zOJ^&0OpZ6?eMhsD#pph6UT)5VBHK*Ft;u~PA8XrVc8iJaxY7IN8@1u=d)1nFT5ASw ze#$mWjnjE7ZBy6Qq!n=oRC;6qz2gkCl~=bc?gbciwluRcq5bXJJ(cpCCezjM-I>RV zHMZ34Mo|*3Y~=2;{1SaZ1q|%C*yi9t$|uqbxO$6(=9!FNx^&5`&AW}9Q=uL{t$e6n zeFeXJ8zznyvb(Sc?L7e^G?C_z zvvDhS6a@v*{{{F~ulU?9bpI_K7azS(ke3++%QIwE8~~fd+rqL}5l8jAEMr429nwfq z^F98}_wO!N9d{EShAO2W}ZLXu=z1tUTk=g3pfVgD+oLooZzsm1SXjSxhDsh62U&igKSrc2#|->c6IcBAQ30a^`B|^ufj5kU6!6 zHdeK6K*OB%rr>`1`#p#n?NjU8-5@BKC1{$&Bnu74b-^b<&XX4 zghZke3J=#s_NpAn;G82zRUfbAlmqj6=;>ME-WD10|BCw#cP!gK?z@yEDyu{qMn)QB zl!|cMm6VliA)`m6L<42qW|5IfvR77U7$G4mk(CN1S!D|)-p{Gu^StkW@OC`M@fPw78mNWtE-1+ZT(WZigsBx|ZP9hV61-KDB?pzP>@qRD&}0 zt^iC^8)6PB8W_lk?=gN+3BT6)vAegu=j4J9_4W1f$t`r%UtnW{VRP|;R%>(Hag^6t zq}tZa&dnn!vmurMvwhHT1y{KVYCk0uf7*-yFqdfLdO`BATkgd!jdAbVRS=t439 z>nQ_6gTKfwi7MZiE6cDP5qPlpE02X+KMVWy+hS{%Mlm9d29%bXB&N7Rt)FBfq7P zMgT;Eg~etMI*yms6&rr+cUj9r2VqbJm^UOCMFfkn|6TGL^j%6SW!(+F3=TeQ|NYE- zxnQxJJUOT>Owp{(z}X)uZcSWJ;8uZ8N39}=LGTX)A*1ooVe0rtZfKVb{o)6Ov|7-mv(J5)jZd;W(kMo32{BiPi`hve z`2|fOI*?>Z;%$wKe~9mN?$IEENdBLnB-kI*1_qeQ$uJUb3s@F$DJdlLFo?AEV7>5? zy__8>-SL;RZsJ?RS%jCjX{Ehscxa*Tewm8{_zOKEtKuud3P2biR?*@32AZ=jQFqs4ns*20Md6jgs@;C%!OEE|X+3339s%qcs59+6p# zznmGl^%=(}(*mYX{q_r9LJ<-cE`zC}BQi&k5a)Fgnj*}31!O9>A9TCAbaAWu-{-MQ zW%Kv%PsysRdm@bP9f^4a=f)2;4--E>U{Xp|mnyK0M9cPLx&6JVZ_Ma4mZDB$n!iHp z=gca)G`196AEnc$6VOW9=3=TtEMXR(2Zh4K#5C&Kz5Z5hZ(RKUK6E2K)V8%~Lx=O3 z?YJg1(ggkiPJjkLE9yhR1&}_5gHZL6#Q4U-6^5S-|9d8C_NKyS-QAw&E;_E`=?OA8-_JEe~JnGr6(mR3l=P}U{4mI{>^XGC)?-X&G*9M8mMd=`9H#(Ei0%=rh8 zt7EW^P#X`NDfrIX!?=!&HjgAMz z18cSbXLU#gWamZ|zxMVb&{|qib~7V7ivJ#`gjBZn!y#Xz&+pn*oC8aq133h^?gQ|` zKUg7wh_07xzB(CFDVa4lcj|NTbQgjh|6Xe!u5~HMl;ul(%4<5*ox@59O$@V7fc7MA z{WMg`rP!(@2HUq#_G&womTsl{?d`fzSINMr&u^1F|1le664IU z7%O4AB$4TAX>NOcrO6Smll%7I1}y%XT*|F4qWz&*%58c<+d0r3hJ#dmF7b)PA3;hq z81~>0U|nQ1_%OGoaI5+){+u%pey%m~)OxfJtUNs?-~$tJHk359V1-FtoSOu(P120n zDN|#2q5tEOYxCFsyHNl3 zF-mdnaTNXP^c<^o@t2z~^CNL{YX@JCMn3G&RF&CCFtQ2x0Qk1Dqhn70UMk5On46n} z^#dJNWi2FUd}x1)j=27J+d`QRsoBWpXguA?^*p}+!hxa#TD2JwB+0J)_ZqXFUqNve zMTmd+M7DlJGGYO^*@C>l36nPXGvUhOV@;Tp?yWwnR8{I{A$Th)Wb3~#oO(iXqQyez zpTu7uk4tCgsiC?ie1*WkAgam|iv6cNj^Ecl;Z@>(UQl2Tlo9hZRvzz3RYK{fqa$Oq zMy<{?l@ZOiKs6f0&Y?=Li;>jC;j{Q_>sQKks_(IUOef$K9v^JYLpC*(K)3GPq6um> zA}UrF%``DSgab7^(oQ&UY@$OdZ9jCtWU?v)2g4t4*ZrZNV&kC$P^d34&3!uI{4~ek zO-(R5+B4s}Z&N~2foP;he_Ae)e#(>guEg{=NSHGGjJ@a@TVk( zOys(?ZY$5&&zO>ZPi6Hcc|-gA|8BG|`w{8@#|=4$`IF9pdT4A(%YH89>lT?B?(ncM zQ-oxb;Ti^JN>y8VPJm%Y)PX=OX#wxPTLq%hQ4VJI^7NdEd_9@x{JrDJiGS}&?5hQ5 zU7t7iWrC{KY{on94{2Od-TkyNx_9WP8DKJpIWYq9npi*^p6R}^hKLGCgE-mGex*`^E22;wM=1v}wu zeVlAAP;F$pyAS*mv9=mb<~Pwft|u3t#Klu6ynMWllWV!F|1M#fPovZko0iFL8u2>weA{p%vg#cbGzu<`&Skdivtz<_L=oh@S zySMx2RC;S{0<~|azrf-OIezD8r^1XT%V(BLPkRe@Ki$2ark}nXVTH5iQ9tqn@fC`Lq%U+Od|@G;Gh`y9zh=9gV@! z|98vd>z`XKN`dQqxzEUgpiE^+bJ`D|RQVHT=C-`}79xm<#vq*}sLa7TJg(=KkNW?W zkAPaQ?|lDwPIg`?rk=+ta{TcLXqueP?O$AkjVAp{bgL-;7#4ckMIs||Y*+r!GmDqa ze!In`Sa}k)$uJFPq}j~qXTbGqd3+^aqsI6QDgqd1XXL&b2W5`}U6V`r?RI$s9m3jz2mii31!0t34oKXJVSPy%A$f2GJyi z7t}=CUM2~A!r_=bbiq12O4y#?32O3PnwI_VtArX~7Wg$nwdhO9@l({GaR81=m~GEnM_e{v4}K$karxgP9y4=<56Tqj#VEDG~Nmc$Z8~38?@Fq%}f9GOzCM_;ylDM4`J z{V-AN<1ObhJRiEsqj}-rQF;u~IAOM)dHWD&=BzagoN2+-#B;wUZHTop#&i|1@t{^| z`6ufc)fw+zK^hip*`vdzAB)*gul{cx-Cpu`C_`*`(=fwbX^r?kNlRE6HGXth%d%;! zjDM2|0;mXH2tH|ceoJTN{hb)+l!8P?j4qa3T$JEpIswloLZSMfI%2e zn!oRF{6O#8=@PeyIi||WZRe)XVUGwR15bE{)7&-&dCeqafFu9|3}~+^F}WSX)Di>3 z@{SGzXVKyaNViex#yNDoAU-$XR8v)s--XpdgY3aEz!_X0ifX{cZrk(iOz-Y1e;?0< zcfWZ+3O;?>Yu~C8W#%?6d~F?Y@-Lq4@{9g(5fA@3OtCr9IU#(J4if)H$4LdKxv(91 z;kDj^%v$g?ho!9QAB6|BJ4wGDqoOGkKD&#N4^f46L#~ZtZ60L28vycz>0a{sDI}RyI~872y+8gDr%sNK#d#a@8SbTn)ib8FUBd zz*NGL4G7jw>U169xx%t{DY_4Gqp{U*yBX!>mAvxb%H9TL+FGS_yI-c&R=_oMq@N*6jOcUL1tr7;+4e z^tF)}zju=8V1O5mIn8kZD`R70K?^H`@4F9)5`w?7vuOU~$4_3~@w3QFdS7JS_mBOD z$4CBqI0w8uC z4FSkT39SxUblo7*JcBn79Q&zNtd%YG96j4^`esCD;LEW($u83zHGT z$t8U@aO{NOp>4PQf{)vZX_{wG-V>m?vhvCJE0g$Xc!^+OegivA(XR%WB*(=U>*BZv z-6aSN)o$!`WCl)t3kqvvqr`Q*N>!QBKn6AQt)3b=YfB_)-cNcOWck0(G^HDoo9zEY zx7e5aD3EEQP5HLDi!*ong}7>g|Kl^VWRVI$CJZoni$m-sxely;SgPtgHU@DJ2i+)M zYBC^|mEDBNe3mRIvXBwn0A(orQE~vNQfqfx@fQtU4#1bfNcN7*Ka8QbLs8@}UPhCx zz3HD7n5>PRsEl{a#WEB6?)2L7N{JJ*_?}5SsZbGkal(_0d^lJ{D@L8(F5Kff1wsnS z2D;J5Av4zH{)G-<@1C7xyMhLJ@dP+-i#qGhdWrRBv1b3R)Pqvl>Y#wGMWN=ccW_su z7CT||wAAYMRJIJ^PYKt7SxcI)r_Zzcg&08*Dr-{GU~wA0{%_YHBfol!sx!k8J)DQ> zk(m$W<9&ooUKI83WrSa#(!}&##hsCSya%o;CaBrrX!ow(lT=#%PSKg&`|OADJ;9r2 z|F^)R`GNhtxZC&xq<#NzV_^kH~v<}1`TCpOAz*~0IxN`jm%_}E@|8B z;q6^v2kwd7=D)M+3Wz8iLAB76zBCbZh4)7leZ+OlB$eKN+;Zp6U0N`&8urqo8~1zG zb4!i!FgESQsOw?Z!};u;S$99r4z640wrb+~x7fc>O0gbh_Qd-Abq5fmOJiS_W33aY z2IuK%YwI4=w3p^)!~kDvKZyWc4a`wfz=E?Iuv%Y%SEU`1nuh|OnC{)Vqq^|G7OvKp z5Zl0bf+ai{@)HPk1XE#6AHNrQ&Hik~@1fDr$}v~+wnd|v4W6X9`s78BjR{soeD4t9 z5?&Mw4*(DNC77atoq@qFNIs9QCr}gqu{Tvah88!e{y}E`5m5^A%_|FZ>{#6RP}1|Z z>*ZCEUKCF>E?)KG^c$nP=vhg;5oDQCK#T(GFQK1v;kdp&4IE8W;KY)X=rwklym-{S zCmEb&D3{eT!H`e^he)SGe|r!~J%W5GbO?eMW;}!8v@Kh0+cJZ|YF5j~^GG?7yc%Rl zo%@4RaBJ3rF_yP2L^0hzGG5$^sjsWsjqxSZ2JwWtwjksT07b}#bw?-VXo6*XY3OUr zA}ckcDP*|ee;W6H@5LF;Yn??L``+(Ep}Yw`(PYN;i|PCC!3dSJlQ7z=yUXQ;2?yHO z{xx?yO5LJyA+WAn2VCJ0T(@6NVMNTp%=bo0B_L-IYm?3pO1=dwjS<`xW>4^}G zMD?NH%+JK6hm*GYVMeCWa~~ZIJ=>|mYk)m|$UG@en@Vqt)llK&9L=Ij)g*KCPiX?2 z>vkKa-_sj&9J{lB!cHoSrYa6jC6RYQHO2`8d#oXjw1$QT(90ek-vIerV(aEj;J@#B zj=2gLdsY+vc^x2iHG&)8DCUJ_CP_9)Oz6{!@h3pgKq7l($vtjugYAv-rKb6KTTbt1>bn#SIHta=F{9W+18>eg@3a^9GjP^?=1a^I?3 z45*nF$uP%=i`@$7gE%WBhn^jOL zYu}-%{sDB^nrXC(oLySYZ(wprU>|aD!L*wed;{CDIWPngrS+E_z)}ndSiPgfMNaB$ zJHL#Nx^}u2bMCi>$^@I+ri+A#CNV23E6%;nYa<>RGh)t&y3qgu*;a?6f|JKI$qMHo zDX@m{lf_%9oAM9DaIfp?!ixSOLVZNxR8J*tjjScP2#G%8ns+5u4h&rB@yLrwPEP(R zKiZLoTTV__qz5E9K0UH#gZMIHSO!83cqnnwrgR$1R}b&^sF&+kW?Mx8UE<}J-mbV> zU!$pUqpinxVDGo8zxVl`Wx(4U4HfU3m1p9RNx$r>B%5YWdl7HkW3ANV0zk`|5QvkQ z2~lVT3>LGy5k?GLX&`kNbXIuL5c&Z}Z#8c}+A9*IY1{fpSjNYoXkq?0k;;G| zK|mLh^@YP3+@rN9WQ}hyi*oGCo~AsR%RcGM6fU;i+UMGhU!Q*m*^zPZB2B|DFVJwO zuls&?QIo=@7J@-H6a`i^hG+vr=E!})Xg=XjtGS<>yNCEad)p#%`8xOy>c+XaCRCz# zzW#celb^3Mc*k5`-m@w91x+Fd{INxNRyk@2P6@%A4l-iehDHkDG#es+Ga7@Wc&}E_ zM=<_C$9&4!bX%(lEb-$SJY@Cr%_PAFfCS}Zh>`;t;bWSuUtqPtXE{?_R3*o#%7m@$ z+Alp{$a6i|2$wBvl!?tTS^l2G5P|8O>C>|T$!8T>uUm#Cm_tCLqJsM+p-2dQu=H;f zt2vAwi3EFQxG8>o^JX=$OP?DzhOcbaNLbZgdOYXP~1r;X!a>BALus=k5VsYSYjBQiWxO1Ycs?2yDUIR{7?pjOK?E=&4AyOz6;pI_RtzZm8F{-i40_?5MOueO1|XKoi3~ z2P?y_IAJEj9cZ#BGs!~v4IGeLePzTr!ei`$Y#NW zO~laJ!U8isI-*;Jc~nz}gScf4J3_G!#ok@Xwypb~!;6rjZveX*5gUo}UE>-(g=Enq zXD9dTFA_2bKtkPe%kg|PVrWtn5*tL3r~m`60Qf$H%St26_`+bbR?0TWesQX*XZ*&f zEEZ>%`oW$o)OqKik%p$1_^yyB0ay&6lSky-a-c#G-IoKc-C>aD0jNp6wZ6LA6OH{Q z*()ibeJml)fNRBKDrGtM*gVpWo{hjPh9Pp7u`>GA14RpmoHvRn>O`k~xd9yW&E=8) zIjttrY#P5cJZ)(O0uYt)c#iyDm3e~ADH#j(0IQAeU4PnbMU zQ{8t!LBEomX-elyi;se26^=V8;Fa;NqY%(pozFfV& zHwuBxU%zpTj_WE(WvRwoa&`R-?JGNvqA*T02yFA48vKHTm4QDKQ5d{;A2!!-rx0eU zOV`yEdU|@qMFvz$b<2VF96spV(wg_sR9!!MCT_#SFt>fHmz}HkCqwow#80cX_9>j3 z>}Gkhy6HF}9DG>)qx*MeR?QPLyBoPBF=cmq?ZW1*;8Dy{Og9t*u`PI|BC|<3Amw1h z28(39&mD;2A!#2Gc{?evab!Y!tNZLteLXXjO`$HaaG5VhxH;dKY6k^v0KriX* zV%&7$AQ)kQBhmpXn6~{il5t%LaztYutey~V^FL*L=pd{t;Fy+h&L~km9HXu!*bmi) z5cmqla)JCNadNKM9e&j1pmrb2x7AUb!e}i;H-ig2745qLH1(S*3@t+B^hs_|`1E##AY0SZ##TfY9(s-lq;n>)U1sWjCg@{O}%yQul3Q3;6;j z4C>Y3`Ispc-<@f$dP=7_zOL_Xtv}{S3Eb{dF;5CafvW?$5h(3VXO}@lRtkuVv{8a_H}62tTX@w>=Fc;Q=6iULhfvi zCSYOKH7O~HF!)I|U=v+bbb!1nXil)unqwci;Avn44b8si`dwj#D^D8j&jtzD1I$#I z28(DZ#LPS&#NR`d22V6!;GuAqC20DK>BZHjxQMdrY~AULX7+)lQ?|Kr=sM-QcOY5A_9Y z*rV(;G1zbcCDT$7z05#DKta4E7|u0tO5&H!LLc@P5xn9K#!E`ES&~>P0?RPAxnc9h zF^`eV_8X_ElO}jfyIt0}1l~KaskJw;KJl%N-%3A*Rm_U*^`{t$S!$MKvV!NvfJ*Xh zir*UBmW#LNj(BGlI1MoBUVEz0=deZIgvQY(gz6cA>h8y zA=t^$KyWS@n>I2uTnl!$Q*Vu$8?jnMkv4lFM&g0YMbjm_`gTfUug7#KY>w%|_fj-9 zfH;C*4$axXLKeC5j}i=o?@HKQ$M;Z6`vdd;Y>c8g1bO3{-Zo^&aq;sWSh{DMW|ddg zwz#z0d7jq`UdM*gfj~%jgvfqd>)5xGOjY1&aDY}sv`39BlAw%-cYho9G06XPtSWak zpxjB@;Bem6BXVB#a`w9Y>cDI)byAMWHw}#g71t4uae(fL4903AckN2O2Kf>Rf9smL z@f*q=+;|GH!oUmm#~W-;Qrp89DCh-4Dk)j->A|`CjvYt|bY{_Nr`#xbaX()6-+rXC$U z>gleIkU0qch{98iG=lmdFXH{3$m+U`Y_>)mzSZvuhzeDMMy6ns4k`o&CZ@2tkqjBt zeZkYoxD%`Pg}R`?Q$yZYkPPqfO}O$nWQ%uY>EBo}Jv=mJ_^1hkz;n({Uh%j2IvxJZ zr<-UVQB$%%%w+!H74OgLT6g7xZjT~zCoNMkW!<}Pe|*|`9sDac?Om<=-BWi0f|D+o z$HkbA%~f3D!l0U+x9LQd-CUTD$W4h%ghZh04?FPo6Y3BE3FXitnEbgL8@p9E(@=Qd z3DA9B%#CYQPfBTa`)9^(o$B@=3 z2||G$93`Pcet8wdeuCJzY}s-sR))CU!SE9N1G5bRx3OWa22LJo>+tcJCx#6if+EqN z=653+jODQui&{B-1ic&1`=ldtjGh)Mv6(JLjgEQ5Z~eZ}{mgx@&H#{|NX` z3F8M)9#!F+V=Hr4o5J_F17jn2B$*<%9b2Bpn{kY=@*7IFvf2PFC8J<)iSWvn3TQDECb?F*%I1liN76=34)ueMd>Zi-Lo1eytHe_Z_=Nz z)CSW;TlAMBd&Ev-|7Umh0zpx|c@p$UQjZ{T_GLcKnR56;*KFY+X2(!^>5Lzm#^G%a zF9Q-Bfp&+#k8_U|lfw;x;!uQ<;18?Ia228dx_`ix6{=;+TZixB!RZVbeW(x)4 z-n88-Sq5Y_P#&ZYvYI0R;SJX3|?T^x0x3Q@yf4o(!=qjo^};k z1^}}JvUc3AK9;V#15aB0S|yfa@2i)fk$M>iM9_@i!Q3|-7QJE7m=oE;sh%^a5 z^Zmkf3NM}ouqI?E4Vz@50i|@qIRRK<=|{ty09Qm7za=O|$+cqbn9Z9uWscUnqI87z zdwxVSY~~7u77(C_o{b}ukM~anpO*o0CD+?UWR*RC*Ed#?vdh%kK~RP@q;lW+K_;op zg(WAWP6G4|S(mOA@AGyFEkz()gtlx?|87z{zp?)smO zrqwS;vYo0KNr7(%O)N=`=G<-SVQ^Q^y#QlRsk0pkPo_K~3qP*gX_(R~=_di)C4iqN z-VXKw;2LVt`>|UlCR?Fs&#xnl`iT+7kxZHs4cgvj=ubJc^Zwf$aw(y?bAcXfg8lQ+A{=fY>#|zsAe`dJ){7Y6qIN)%rv_#3@n^%t6c6;h8hobEgiHnf zIu>DnW>FrNDIvx^+m2Le%Kam6{Lcg2Kucb{=T?UwcxK#t!n^CHdxM{3}hV#F1U87kg{Mv%zd}jB7HZ3!pXo;ggO- z+tK~0jA5f}sA8vDGTMC4a1CA4Fa3UCQ)}YA=FJBnRSHB4&Wp)UB(q@Zj^SuTbuN&= zeb1u%cMviT6tCM2`@Vk%SZEa{AGeTHw}XbmTI8?-^_K@eWs-Mld25D2Kx$9YsQy-) zd>lOAKR%)JELZtbm%7KkhBc%!^;qmua*(@px~iPDI|?)ph2M$U^D2m{gnMMTT%>9w zN$AGg$=HUf5@?x(&<(0XB+jkpt(e?;tIWXvY?JM(sw6ESgHN#-l+q|DWLX`#7l=fde znzTR~J2@^<>&6q`p6V%#bwK9zftZh&w&1LYgLgWPlF*ow&z&qu?@1VVU#*4Ae{|%7 z{I>-aWZYyfTmVNwNlM$o5ps?Amk`4<^!7s9ZE%5y`ke_&OgR4ZLPSW&*5?t-qP)l1 zx%J(61qD}-*W-3c^r5yjg>e>bM|VR7!xPXS4sbQ+YOR!E(YX+n<$kIuMEZwOr$9po z0>LSzEiD{)|ES1SW@1jf`g;mQ+Bo<>lOR9!$Hhmm#>i2RdJqbMr)KV*MXrb&*3uH^ z{X`5z$>1Iqa>t*I6`PhVUAAHc-_D(xflYsmz;6UDBT#&_8RZ-kD@(}E9u|dzw?h_J zwE34vwsT_#xR>)AE4$G@vHy5|EWUCpMw<&qSwoJx!Q&55SP5?TGx&pq z$3prnG!=+>fv9njzLFnpvI>&eG2lbOhSrvr-hii{FtHXJgMEfdN}#1RT~D*ZhNjvE zN@MaD^PbU9FCAF+e(w$PuKBn{fxm+AQvPW%VA{Nw>G$-q_$?)eAm)e@Uk{@T%t?^E zsgdT6s#B}j?E*)#TP_~oXPhLVLjchm%6?E;Nwd@B&4{j=ie064OXHB**_y(Ff|qrH z@keMWlkKHV=b`S@e`>o!nR(4=zJO+4v8^oIBOhIAIj}=il%2Nkaz#azGNB{zbwc z5#Gw`>i#b`U;Q=7au@ox98V>R$Jd0@k51*U>!GXq+&p&MUgTDdfS`ayPr>Hh|9sWI zzwd&NdlgMJ3&DA-Q7T4ie*n(Tku1#Z>RKcpp?Z>l{;+po&phwwScVWt9eTg{9{{aG z?f%ToY2TrWVPY~;JiQ5p1^fK5wm>o7U;Cx9`yFtzv#n;i$eleUeHP|-Y5l4Ry}TpJ zrl0RG=iDbj@m;g=n-;z#1?B3@kEdPyEr7`MQ@NS_R4+sALfZGHX-$|H9jm>cijq(@ z^K4sYG~;cdN@SH|gN@YY=HbcsB0<&WvNvtCv&7j3VuaYQfL%G3J?jp*Z~I|n-lU0n z6gox!EbF?mNws%GPPE!ukoTAGVxN|amlN7r|95Lck_s@fj@V_Ac`h22I&fb`3yU6c z)u{zMgTQsQ)T(!MKkdu$z-E-f&zAaeB zeWx3_p=}4E!83E^?Kv{U`{z@b6q_fuEVyKVuS$O_}#Q+V(dH~d5WmXu+wc7om^)x(oR~* zjtll{w%cuQY*eN5g0^vtugbBviQ}5QAg_pkW$?g<_I7fl+7y5-2neqmMiXFDw1S0B zMto}dnAw(Nu7lL**e}`+a0nEbO;WbBy2gUOqmF)6_u5Dh~oPatGnjZh7PIP&Gd zYP{4To)gw@dM5q4#zsBAj4-gW4D3gtU!4#8400xPbYptDsOTZUzSev%JXqs`LCkyK)zJNY#M%@yFsl)X z8}5Zt5C|$dONj6R4|#TJo)?748y}v&+}q|)QzatmP{VuC(HSrKsR=vCUIMkh+9p|J zU5tiDaR{4F_BVzOCL?DM2wqQPyo$)tpAOit?;O1RB%uRd9o6g4tqmE+*A9n@gtF^3`pcp>iT}rFI%SifbSCeRuH;V_p-2rujAHF za9T5buoRl5>{;IGKOdJ+3JD zx>9#Cu?Pn;i;A4c5z8T`=(Rt+dd-P|Y3^jVPf=ZVqjS8JSOK2OiGt*oS9 zw{lEkSeVRF<`0%ZUvMsUcqx?T=dw<41FL;bRB2`iSYGTA7Y}ozXA!>1EZVf!^|>qAmvMV26qH=e&KWCR8f1X7Do$~= zn4v@3oA^x_v$n&NYzN$CIC1}I3?%`tyr_*iG+N#p>?V!y{78I2B#xj3#G+#r(#yQ> zAG!pl#k~|4UbkLQ0g%DA3smE6ptchKB=|-j0#+aH77VE&Zd@ZaBdU@T!7ho!j~Dh1 zh-U_02ve(asIOM9UX3lE(cp=_A5L0K1r!C`Bjj${v4&i-Hw~%Wj_W&3IBTgkL|x1hmuPL2v3RWRz%*bXED?-1?UM(>m=Eh6+bkF%(m>oDWxz4{icEjTG1 zhSCAwmBaz=0AteT4tO)Mn2}}Y<+1bhhNE3Ly>6HFsEIJ$0OB<{4FCMK_CjnqapnvUPV$L7R zx(w>n0|5a(Vc`wnHPCJbsTkUeVrUx@6(TINiG?NgJr*3XVZumJwfxnqSElGcW{@BV zrNTWBP{?2p47!$rk@5uzID?{PhhT{6{`QR?Yg`+~q4MSmyx{pkof}m0=K+Xd5NxIB z=kR_P>4;ZY&K;IzN(bi>m=nhWYSTY;3W}4ox{^{@Ky)h&t^%cbD{kN}-24aBS;-5r>^_ediMyCYCKZ#11xY5sxx z+ncG!%Un*sZonHfcxVE6B?YD&R9H-^;I5rym4qd!<3p$W44`?htyq4Kojz;_zmdB930jb9DckDfLY%K1y?xKEWoB`vt@A&_ zF7LC%fmQJR?!!f2o;;hX8}2YPy8N zeg^#uMkPmJhXwuRINtR*!6n=uySq&X_-5dqhq@pfGneL}sS9!?##w#9WC7o4rnL+f z#H@J~?XjGa9UKuENuqYJyOCYxJt8CEVI2k6!Sx53XB04k2cJ2ie?v)X;~9js@&oN? zKwB~a1wzBMZ_p#2$4fK$^XE4}V`$-jeYaj3<5ReHDaGWzK}H0=QJnQxR3SDJT=*xo z#TH0>HOfna4Bf_e^L7X>eS=|7>)bPpAFlioJH`rI@P&7Fbr@XAmfyWu2xtfnCQ&dJ zla#wyEZ5OyFSQ4jdmtrEPEYqC(+p>fDctL1t0&rQ^FKo429T)^U%lhUPeE5>)2kQw zT}>t#C=|+!3;eF%!^uq~Tph!hT!6Z`Y%8!ZHvgGL Date: Fri, 18 Apr 2025 07:08:53 +0100 Subject: [PATCH 052/137] Move asset --- docs/source/artemis.ascii | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 docs/source/artemis.ascii diff --git a/docs/source/artemis.ascii b/docs/source/artemis.ascii new file mode 100644 index 0000000..cd00669 --- /dev/null +++ b/docs/source/artemis.ascii @@ -0,0 +1,33 @@ + + -/+o:` + .hdddy-/o` + ydddddd+ys + :dddddddmo + ++syyyo:+ + .y` oy + +d` dd` + ym` .Nm. + `dN. /Mm. -//:-..` + .mN- yMm. .-:/+osssssssydy. + .mM: `dMm` ./shm/ `oNm/ + .mMo .NMd` `-+sdNds+-` oNm/ + `mMy :MMh`:+ymNhs/. // + dMm` .:dMMMho/. + yMM- ./ohNmyoyMM+ + oMM+ ./sdNmy+:` dMM: + -MMy -/sdNdy+-` `mMN. + `NMm` -/sdNds+- .NMm` + hMMhdNds+- :MMy + `.--:-. -+hMMy/- +MM+ + -://++ooo+//::/smhyo+MMy oMM- +:+::-. `:/++/mh hMd sMm` + `--.. .. .sNo :MN. yMy + `/ :ymo` mN- yM: + domh: +M: ym` + `o/` `m/ ss + +/ /...` + `:+o+:/ .shhhy/+: + :hsss+--s- dhhhhhy/y+ + yssssssood ohhhhhhhhy + .sssssssho /yhhhhdy. + -:/+/:` .-::` From 347bf4b57768b242a1c32628f615e4ee235f20c4 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 07:17:56 +0100 Subject: [PATCH 053/137] Change filepaths --- CMakeLists.txt | 20 +++++++++---------- {src/fortran => app}/aspect.f90 | 0 {src/fortran => app}/default_infile.f90 | 0 {src/fortran/lib => app}/mod_tools_infile.f90 | 0 src/fortran/{ => lib}/mod_intf_generator.f90 | 0 src/fortran/{ => lib}/mod_intf_identifier.f90 | 0 src/fortran/{ => lib}/mod_lat_compare.f90 | 0 src/fortran/{ => lib}/mod_plane_matching.f90 | 0 src/fortran/{ => lib}/mod_shifting.f90 | 4 ++-- src/fortran/{ => lib}/mod_swapping.f90 | 2 +- src/fortran/{ => lib}/mod_term_generator.f90 | 0 11 files changed, 13 insertions(+), 13 deletions(-) rename {src/fortran => app}/aspect.f90 (100%) rename {src/fortran => app}/default_infile.f90 (100%) rename {src/fortran/lib => app}/mod_tools_infile.f90 (100%) rename src/fortran/{ => lib}/mod_intf_generator.f90 (100%) rename src/fortran/{ => lib}/mod_intf_identifier.f90 (100%) rename src/fortran/{ => lib}/mod_lat_compare.f90 (100%) rename src/fortran/{ => lib}/mod_plane_matching.f90 (100%) rename src/fortran/{ => lib}/mod_shifting.f90 (99%) rename src/fortran/{ => lib}/mod_swapping.f90 (99%) rename src/fortran/{ => lib}/mod_term_generator.f90 (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5dd1aa8..c99ea0e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -59,24 +59,21 @@ set(LIB_FILES mod_help.f90 mod_misc_maths.f90 mod_misc_linalg.f90 - mod_rw_geom.f90 mod_edit_geom.f90 mod_io_utils_extd.F90 mod_sym.f90 - mod_tools_infile.f90 mod_terminations.f90 mod_misc_types.f90 -) - -# Main source files -set(SPECIAL_LIB_FILES - aspect.f90 mod_intf_identifier.f90 mod_plane_matching.f90 mod_lat_compare.f90 mod_swapping.f90 mod_shifting.f90 - default_infile.f90 +) + +# Main source files +set(SPECIAL_LIB_FILES + mod_rw_geom.f90 mod_term_generator.f90 mod_intf_generator.f90 ) @@ -86,7 +83,7 @@ foreach(lib ${LIB_FILES}) list(APPEND PREPENDED_LIB_FILES ${LIB_DIR}/${lib}) endforeach() foreach(lib ${SPECIAL_LIB_FILES}) - list(APPEND PREPENDED_LIB_FILES ${FORTRAN_SRC_DIR}/${lib}) + list(APPEND PREPENDED_LIB_FILES ${LIB_DIR}/${lib}) endforeach() message(STATUS "Modified LIB_FILES: ${PREPENDED_LIB_FILES}") @@ -96,7 +93,7 @@ set(SRC_FILES artemis.f90 ) foreach(lib ${SPECIAL_LIB_FILES}) - list(APPEND F90WRAP_FORTRAN_SRC_FILES ${CMAKE_CURRENT_LIST_DIR}/${FORTRAN_SRC_DIR}/${lib}) + list(APPEND F90WRAP_FORTRAN_SRC_FILES ${CMAKE_CURRENT_LIST_DIR}/${LIB_DIR}/${lib}) endforeach() foreach(src ${SRC_FILES}) list(APPEND F90WRAP_FORTRAN_SRC_FILES ${CMAKE_CURRENT_LIST_DIR}/${FORTRAN_SRC_DIR}/${src}) @@ -105,7 +102,10 @@ endforeach() set(EXECUTABLE_FILES + mod_tools_infile.f90 + default_infile.f90 inputs.f90 + aspect.f90 main.f90 ) set(APP_DIR app) diff --git a/src/fortran/aspect.f90 b/app/aspect.f90 similarity index 100% rename from src/fortran/aspect.f90 rename to app/aspect.f90 diff --git a/src/fortran/default_infile.f90 b/app/default_infile.f90 similarity index 100% rename from src/fortran/default_infile.f90 rename to app/default_infile.f90 diff --git a/src/fortran/lib/mod_tools_infile.f90 b/app/mod_tools_infile.f90 similarity index 100% rename from src/fortran/lib/mod_tools_infile.f90 rename to app/mod_tools_infile.f90 diff --git a/src/fortran/mod_intf_generator.f90 b/src/fortran/lib/mod_intf_generator.f90 similarity index 100% rename from src/fortran/mod_intf_generator.f90 rename to src/fortran/lib/mod_intf_generator.f90 diff --git a/src/fortran/mod_intf_identifier.f90 b/src/fortran/lib/mod_intf_identifier.f90 similarity index 100% rename from src/fortran/mod_intf_identifier.f90 rename to src/fortran/lib/mod_intf_identifier.f90 diff --git a/src/fortran/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 similarity index 100% rename from src/fortran/mod_lat_compare.f90 rename to src/fortran/lib/mod_lat_compare.f90 diff --git a/src/fortran/mod_plane_matching.f90 b/src/fortran/lib/mod_plane_matching.f90 similarity index 100% rename from src/fortran/mod_plane_matching.f90 rename to src/fortran/lib/mod_plane_matching.f90 diff --git a/src/fortran/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 similarity index 99% rename from src/fortran/mod_shifting.f90 rename to src/fortran/lib/mod_shifting.f90 index 982b6c3..6394c8d 100644 --- a/src/fortran/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -14,8 +14,8 @@ module shifting use interface_identifier implicit none - real(real32) :: f_scale = 0.5 - real(real32) :: g_scale = 8.0/3.0 + real(real32) :: f_scale = 0.5_real32 + real(real32) :: g_scale = 8._real32/3._real32 private diff --git a/src/fortran/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 similarity index 99% rename from src/fortran/mod_swapping.f90 rename to src/fortran/lib/mod_swapping.f90 index 13577f0..91d85b5 100644 --- a/src/fortran/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -12,7 +12,7 @@ module swapping use artemis__sym, only: sym_setup,check_sym,sym_type,basmap_type,basis_map use artemis__io_utils, only: err_abort implicit none - real(real32) :: tiny=5.0D-5 + real(real32) :: tiny=5.E-5_real32 logical :: lmirror type(basmap_type) :: bas_map diff --git a/src/fortran/mod_term_generator.f90 b/src/fortran/lib/mod_term_generator.f90 similarity index 100% rename from src/fortran/mod_term_generator.f90 rename to src/fortran/lib/mod_term_generator.f90 From 1566d41a4bcd823171732a85d45e9d0ea76a1faf Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 07:49:17 +0100 Subject: [PATCH 054/137] Rename files --- CMakeLists.txt | 4 ++-- src/fortran/lib/{mod_rw_geom.f90 => mod_geom_rw.f90} | 0 src/fortran/lib/{mod_edit_geom.f90 => mod_geom_utils.f90} | 0 3 files changed, 2 insertions(+), 2 deletions(-) rename src/fortran/lib/{mod_rw_geom.f90 => mod_geom_rw.f90} (100%) rename src/fortran/lib/{mod_edit_geom.f90 => mod_geom_utils.f90} (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index c99ea0e..ac5bbb9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -59,7 +59,7 @@ set(LIB_FILES mod_help.f90 mod_misc_maths.f90 mod_misc_linalg.f90 - mod_edit_geom.f90 + mod_geom_utils.f90 mod_io_utils_extd.F90 mod_sym.f90 mod_terminations.f90 @@ -73,7 +73,7 @@ set(LIB_FILES # Main source files set(SPECIAL_LIB_FILES - mod_rw_geom.f90 + mod_geom_rw.f90 mod_term_generator.f90 mod_intf_generator.f90 ) diff --git a/src/fortran/lib/mod_rw_geom.f90 b/src/fortran/lib/mod_geom_rw.f90 similarity index 100% rename from src/fortran/lib/mod_rw_geom.f90 rename to src/fortran/lib/mod_geom_rw.f90 diff --git a/src/fortran/lib/mod_edit_geom.f90 b/src/fortran/lib/mod_geom_utils.f90 similarity index 100% rename from src/fortran/lib/mod_edit_geom.f90 rename to src/fortran/lib/mod_geom_utils.f90 From 137754e33182a0b6aa330f8b4842ad94fbb8a459 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 07:49:55 +0100 Subject: [PATCH 055/137] Handle private --- app/main.f90 | 1 + src/fortran/artemis.f90 | 1 - src/fortran/lib/mod_intf_generator.f90 | 33 ++++++++++++++++---------- src/fortran/lib/mod_misc_types.f90 | 1 + src/fortran/lib/mod_term_generator.f90 | 5 ++++ 5 files changed, 27 insertions(+), 14 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 093c3ae..8e1a129 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -6,6 +6,7 @@ !!!############################################################################# program artemis_executable use artemis + use inputs implicit none diff --git a/src/fortran/artemis.f90 b/src/fortran/artemis.f90 index 5c2ae81..992466e 100644 --- a/src/fortran/artemis.f90 +++ b/src/fortran/artemis.f90 @@ -1,5 +1,4 @@ module artemis - use inputs use artemis__termination_generator use artemis__interface_generator implicit none diff --git a/src/fortran/lib/mod_intf_generator.f90 b/src/fortran/lib/mod_intf_generator.f90 index f5e06e3..0dcf794 100644 --- a/src/fortran/lib/mod_intf_generator.f90 +++ b/src/fortran/lib/mod_intf_generator.f90 @@ -25,11 +25,11 @@ module artemis__interface_generator use swapping, only: rand_swapper use shifting !!! CHANGE TO SHIFTER? implicit none - integer, private :: intf=0 - type(bulk_DON_type), dimension(2) :: bulk_DON + private + public :: artemis_interface_generator_type type, extends(abstract_artemis_generator_type) :: artemis_interface_generator_type @@ -257,6 +257,9 @@ subroutine generate_intefaces_from_existing(this, basis, & integer, dimension(:), allocatable :: seed_arr !! Array of seeds for the random number generator. + type(bulk_DON_type), dimension(2) :: bulk_DON + !! Distribution functions for the lower and upper bulk structures + !--------------------------------------------------------------------------- ! Set the random seed @@ -326,11 +329,11 @@ subroutine generate_intefaces_from_existing(this, basis, & end do atomloop1 end do specloop1 - min_bond = ( min_bond1 + min_bond2 )/2._real32 + min_bond = ( min_bond1 + min_bond2 ) / 2._real32 write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond write(6,'(1X,"Trans-interfacial scaling factor:",F0.3)') this%separation_scale this%axis = intf%axis - call this%generate_perturbations(basis,intf%loc,min_bond, print_shift_info_, seed_arr) + call this%generate_perturbations(basis, intf%loc, min_bond, bulk_DON, print_shift_info_, seed_arr) end subroutine generate_intefaces_from_existing @@ -477,7 +480,9 @@ subroutine generate_interfaces( & real(real32), dimension(:), allocatable :: elastic_constants_lw_, elastic_constants_up_ !! Elastic constants for the lower and upper bulk structures - + + type(bulk_DON_type), dimension(2) :: bulk_DON + !! Distribution functions for the lower and upper bulk structures integer :: ntrans,iunique,itmp1,old_intf integer :: layered_axis_lw,layered_axis_up @@ -801,7 +806,6 @@ subroutine generate_interfaces( & !!!----------------------------------------------------------------------------- ! call getcwd(pwd) old_intf = -1 - intf=0 abc="abc" if(this%match_method.ne.0.and.(any(miller_lw_.ne.0).or.any(miller_up_.ne.0)))then call err_abort( '& @@ -1223,7 +1227,7 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------- !! Saves current directory and moves to new directory !!----------------------------------------------------------------- - if(intf.gt.old_intf)then + if(this%num_structures.gt.old_intf)then iunique=iunique+1 ! if(this%shift_method.gt.0.and.this%num_shifts.gt.1) & ! write(6,'(1X,"Generating shifts for unique interface ",& @@ -1234,7 +1238,7 @@ subroutine generate_interfaces( & ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique end if ! call chdir(dirpath) - old_intf = intf + old_intf = this%num_structures !!----------------------------------------------------------------- @@ -1249,12 +1253,13 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------- call this%generate_perturbations( & interface, intf_loc, avg_min_bond, & + bulk_DON, & print_shift_info_, & seed_arr, & t2lw_map & ) - if(intf.ge.this%max_num_structures) exit intf_loop + if(this%num_structures.ge.this%max_num_structures) exit intf_loop !call chdir(dirname) ! call chdir(intf_dir) @@ -1283,13 +1288,15 @@ end subroutine generate_interfaces !!!############################################################################# !!! ISWAP METHOD NOT YET SET UP subroutine generate_shifts_and_swaps( & - this, basis, intf_loc, bond, print_shift_info, seed_arr, map & + this, basis, intf_loc, bond, bulk_DON, print_shift_info, seed_arr, map & ) implicit none class(artemis_interface_generator_type), intent(inout) :: this type(basis_type), intent(in) :: basis real(real32), dimension(2), intent(in) :: intf_loc real(real32), intent(in) :: bond + type(bulk_DON_type), dimension(2), intent(in) :: bulk_DON + !! Distribution functions for the lower and upper bulk structures logical, intent(in) :: print_shift_info integer, dimension(:), intent(in) :: seed_arr integer, dimension(:,:,:), optional, intent(in) :: map @@ -1457,8 +1464,7 @@ subroutine generate_shifts_and_swaps( & !! Merges lower and upper materials !! Writes interfaces to output directories !!----------------------------------------------------------------------- - intf=intf+1 - ounit=100+intf + ! ounit=100+intf ! if(this%shift_method.gt.0.or.this%num_shifts.gt.1)then ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),k ! call system('mkdir -p '//trim(adjustl(dirpath))) @@ -1471,7 +1477,8 @@ subroutine generate_shifts_and_swaps( & ! call geom_write(ounit,tbas) ! close(ounit) this%structures = [ this%structures, tbas ] - if(intf.ge.this%max_num_structures) return + this%num_structures = size(this%structures, dim = 1) + if(this%num_structures.ge.this%max_num_structures) return !!----------------------------------------------------------------------- diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index e55a9f0..ef22d58 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -38,6 +38,7 @@ module artemis__misc_types end type tol_type type :: abstract_artemis_generator_type + integer :: num_structures = 0 integer :: max_num_structures = 100 integer :: axis = 3 diff --git a/src/fortran/lib/mod_term_generator.f90 b/src/fortran/lib/mod_term_generator.f90 index 99cf6f8..4a8f2fe 100644 --- a/src/fortran/lib/mod_term_generator.f90 +++ b/src/fortran/lib/mod_term_generator.f90 @@ -18,6 +18,11 @@ module artemis__termination_generator implicit none + private + + public :: artemis_termination_generator_type + + type, extends(abstract_artemis_generator_type) :: artemis_termination_generator_type real(real32) :: layer_separation_cutoff = 1._real32 From 35fbfce01f43a6f7ee9fd443223b7fb66ab39988 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 09:17:17 +0100 Subject: [PATCH 056/137] Set up python library --- CMakeLists.txt | 125 +- fpm.toml | 4 +- kind_map | 18 + pyproject.toml | 75 + src/artemis/__init__.py | 56 + src/artemis/artemis.py | 2018 ++++++++++++++++++++ src/fortran/lib/mod_intf_generator.f90 | 32 +- src/wrapper/f90wrap_artemis.f90 | 4 + src/wrapper/f90wrap_mod_geom_rw.f90 | 865 +++++++++ src/wrapper/f90wrap_mod_intf_generator.f90 | 726 +++++++ src/wrapper/f90wrap_mod_term_generator.f90 | 91 + 11 files changed, 3996 insertions(+), 18 deletions(-) create mode 100644 kind_map create mode 100644 pyproject.toml create mode 100644 src/artemis/__init__.py create mode 100644 src/artemis/artemis.py create mode 100644 src/wrapper/f90wrap_artemis.f90 create mode 100644 src/wrapper/f90wrap_mod_geom_rw.f90 create mode 100644 src/wrapper/f90wrap_mod_intf_generator.f90 create mode 100644 src/wrapper/f90wrap_mod_term_generator.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index ac5bbb9..a82bafb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -44,7 +44,9 @@ set( CMAKE_BUILD_TYPE "Release" CACHE STRING "Select which configuration to build." ) # set options +option(BUILD_PYTHON "Build the python library" Off) option(BUILD_EXECUTABLE "Build the Fortran executable" On) +option(REMAKE_F90WRAP "Remake the f90wrap signature file" Off) # Define the sources set(SRC_DIR src) @@ -203,7 +205,7 @@ set_target_properties(${PROJECT_NAME} PROPERTIES VERSION ${PROJECT_VERSION}) # set compile options based on different build configurations target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${OPTIMFLAGS}>") # target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${MPFLAGS}>") -# target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${PYTHONFLAGS}>") +target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${PYTHONFLAGS}>") target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${DEVFLAGS}>") @@ -220,7 +222,7 @@ if (BUILD_EXECUTABLE) target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${OPTIMFLAGS}>") # target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${MPFLAGS}>") - # target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${PYTHONFLAGS}>") + target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${PYTHONFLAGS}>") target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${DEVFLAGS}>") @@ -231,3 +233,122 @@ if (BUILD_EXECUTABLE) set_target_properties(${PROJECT_NAME}_executable PROPERTIES VERSION ${PROJECT_VERSION}) endif() + + + +if (BUILD_PYTHON) + + # # Get the directory where object files are generated + get_target_property(OBJECTS ${PROJECT_NAME} EXTERNAL_OBJECT) + # Print the object files directory + set(OBJECTS_DIR ${CMAKE_BUILD_DIR}/CMakeFiles/${PROJECT_NAME}.dir) + message(STATUS "Object files directory for ${PROJECT_NAME}: ${OBJECTS_DIR}") + + # Include f90wrap + find_package(Python COMPONENTS Interpreter Development.Module NumPy REQUIRED) + if(NOT DEFINED PYTHON_EXECUTABLE) + set(PYTHON_EXECUTABLE ${Python_EXECUTABLE}) + endif() + + # Grab the variables from a local Python installation F2PY headers + execute_process( + COMMAND "${Python_EXECUTABLE}" -c + "import numpy.f2py; print(numpy.f2py.get_include())" + OUTPUT_VARIABLE F2PY_INCLUDE_DIR + OUTPUT_STRIP_TRAILING_WHITESPACE) + + add_library(fortranobject OBJECT "${F2PY_INCLUDE_DIR}/fortranobject.c") + target_link_libraries(fortranobject PUBLIC Python::NumPy) + target_include_directories(fortranobject PUBLIC "${F2PY_INCLUDE_DIR}") + set_property(TARGET fortranobject PROPERTY POSITION_INDEPENDENT_CODE ON) + + set (F90WRAP_EXECUTABLE ${PYTHON_EXECUTABLE} -m f90wrap) + set (F2PY_EXECUTABLE ${PYTHON_EXECUTABLE} -m f90wrap --f2py-f90wrap) + + # Run Python command to get the extension suffix + execute_process( + COMMAND ${Python_EXECUTABLE} -c "import sysconfig; print(sysconfig.get_config_var('EXT_SUFFIX'))" + RESULT_VARIABLE result + OUTPUT_VARIABLE PYTHON_EXTENSION_MODULE_SUFFIX + OUTPUT_STRIP_TRAILING_WHITESPACE + ) + + # Check if the suffix was retrieved successfully + if (result EQUAL 0) + message(STATUS "Python extension module suffix: ${PYTHON_EXTENSION_MODULE_SUFFIX}") + else() + message(FATAL_ERROR "Failed to retrieve Python extension module suffix") + endif() + set(F2PY_OUTPUT_FILE ${CMAKE_BUILD_DIR}/artemis/_${PROJECT_NAME}${PYTHON_EXTENSION_MODULE_SUFFIX}) + + # Generate f90wrap signature file + set(F90WRAP_FILE + ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_term_generator.f90 + ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_intf_generator.f90 + ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_geom_rw.f90 + ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_artemis.f90 + ) + if (REMAKE_F90WRAP) + set(KIND_MAP ${CMAKE_SOURCE_DIR}/kind_map) + set(F90WRAP_REMAKE_FILE ${CMAKE_BUILD_DIR}/f90wrap_${PROJECT_NAME}.f90) + add_custom_command( + OUTPUT ${F90WRAP_REMAKE_FILE} + COMMAND ${F90WRAP_EXECUTABLE} + --default-to-inout + -m ${PROJECT_NAME} + -k ${KIND_MAP} + ${F90WRAP_FORTRAN_SRC_FILES} + --only artemis_interface_generator_type artemis_termination_generator_type basis_type: + DEPENDS ${F90WRAP_FORTRAN_SRC_FILES} + WORKING_DIRECTORY ${CMAKE_BUILD_DIR} + COMMENT "Generating f90wrap signature file" + VERBATIM + ) + endif() + + # Copy f90wrap edited files from edited_autogen_files to ${CMAKE_BUILD_DIR} + add_custom_command( + OUTPUT ${CMAKE_BUILD_DIR}/artemis/python_copied + COMMAND ${CMAKE_COMMAND} -E copy_directory ${CMAKE_CURRENT_LIST_DIR}/${SRC_DIR}/artemis ${CMAKE_BUILD_DIR}/artemis + COMMENT "Copying artemis python files" + ) + + # If parallel build, need to add the parallel flag + if (CMAKE_BUILD_TYPE MATCHES "Release*" OR CMAKE_BUILD_TYPE MATCHES "Parallel*" OR CMAKE_BUILD_TYPE MATCHES "Debug") + set(GOMPFLAGS "-lgomp") + else() + set(GOMPFLAGS "") + endif() + + # Create a Python module using f2py + add_custom_command( + OUTPUT ${F2PY_OUTPUT_FILE} + COMMAND CC="${CMAKE_C_COMPILER}" LDFLAGS="-L${CMAKE_BUILD_DIR}" LIBS="-lartemis" ${F2PY_EXECUTABLE} + -c + -m _${PROJECT_NAME} + -I${MODULE_DIR} + --f90flags="${PPFLAGS}" + ${GOMPFLAGS} + --backend meson + ${F90WRAP_FILE} + -L${CMAKE_BUILD_DIR} + -lartemis + # --build-dir ${CMAKE_BUILD_DIR}/Dmeson + DEPENDS ${F90WRAP_FILE} ${CMAKE_BUILD_DIR}/artemis/python_copied ${PROJECT_NAME} + WORKING_DIRECTORY ${CMAKE_BUILD_DIR}/artemis + COMMENT "Creating Python module using f2py" + ) + + # Define output files + set(PY_MODULE ${CMAKE_BUILD_DIR}/artemis/${PROJECT_NAME}.py ${CMAKE_BUILD_DIR}/artemis/__init__.py) + + # Create a custom target for the Python module + add_custom_target(python_module ALL + DEPENDS ${F90WRAP_REMAKE_FILE} ${F2PY_OUTPUT_FILE} + ) + + # Installation instructions + install(FILES ${PY_MODULE} DESTINATION ${SKBUILD_PROJECT_NAME}) + install(FILES ${F2PY_OUTPUT_FILE} DESTINATION ${SKBUILD_PROJECT_NAME}) + +endif() diff --git a/fpm.toml b/fpm.toml index 40d7aab..d5ed3da 100644 --- a/fpm.toml +++ b/fpm.toml @@ -1,8 +1,8 @@ name = "artemis" -version = "1.0.2" +version = "2.0.0" author = "Ned Thaddeus Taylor" maintainer = "n.t.taylor@exeter.ac.uk" -description = "A Fortran executable for generating interface lattice matches" +description = "A Fortran library for generating interface lattice matches" [preprocess] [preprocess.cpp] diff --git a/kind_map b/kind_map new file mode 100644 index 0000000..e6e5b84 --- /dev/null +++ b/kind_map @@ -0,0 +1,18 @@ +{ + 'real': {'': 'float', + '4': 'float', + '8': 'double', + 'dp': 'double', + 'idp':'double', + 'real32': 'float'}, + 'complex' : {'': 'complex_float', + '8' : 'complex_double', + '16': 'complex_long_double', + 'dp': 'complex_double', + 'real32': 'complex_float'}, + 'integer' : {'' : 'int', + '4': 'int', + '8': 'long_long', + 'dp': 'long_long', + 'quadint_k': 'long_long'} +} diff --git a/pyproject.toml b/pyproject.toml new file mode 100644 index 0000000..1313efb --- /dev/null +++ b/pyproject.toml @@ -0,0 +1,75 @@ +[build-system] +requires = [ + "f90wrap>=0.2.14,<=0.2.16", + "numpy>=1.26.4,<=2.2", + "meson~=1.6.0", + "cython~=3.0.11", + "scikit-build-core", +] +build-backend = "scikit_build_core.build" + +[tool.scikit-build] +cmake.version = "CMakeLists.txt" +ninja.version = ">=1.10" +cmake.build-type = "Release" +cmake.source-dir = "." +cmake.args = [ + "-DBUILD_PYTHON=On", + "-DBUILD_EXECUTABLE=Off", + "-DREMAKE_F90WRAP=Off", +] +sdist.cmake = true +wheel.cmake = true +build-dir="build/{wheel_tag}" +wheel.expand-macos-universal-tags = true +ninja.make-fallback = true +sdist.reproducible = true +# dev purposes only +build.verbose = false + +[project] +name = "artemis" +dynamic = ["version"] +dependencies = [ + "numpy>=1.26.4,<=2.2", + "f90wrap>=0.2.14,<=0.2.16", +] +requires-python = ">=3.11,<3.14" +authors = [ + { name = "Ned Thaddeus Taylor", email = "n.t.taylor@exeter.ac.uk" }, + { name = "Steven Paul Hepplestone", email = "s.p.hepplestone@exeter.ac.uk" }, +] +description = "A material interface lattice match generator package" +readme = "README.md" +license = { text = 'GNU General Public License v3.0 or later'} +classifiers = [ + "Development Status :: 4 - Beta", + "Intended Audience :: Science/Research", + "Programming Language :: Python :: 3.11", + "Programming Language :: Python :: 3.12", + "Programming Language :: Python :: 3.13", + "Programming Language :: Fortran", + "License :: OSI Approved :: GNU General Public License v3 (GPLv3)", + "Operating System :: OS Independent", +] + +[project.urls] +Homepage = "https://github.com/ExeQuantCode/artemis" +Documentation = "https://artemis-fortran.readthedocs.io/" +Repository = "https://github.com/ExeQuantCode/artemis" +Issues = "https://github.com/ExeQuantCode/artemis/issues" + +[project.optional-dependencies] +ase = ["ase>=3.23.0"] +no-ase = [] +tests = [ + "pytest", + "pytest-cov", + "parameterized", + "unittest", +] + +[tool.scikit-build.metadata.version] +provider = "scikit_build_core.metadata.regex" +input = "fpm.toml" +regex = '(?i)^version *= \"(?P.+?)\"' diff --git a/src/artemis/__init__.py b/src/artemis/__init__.py new file mode 100644 index 0000000..8f62bc6 --- /dev/null +++ b/src/artemis/__init__.py @@ -0,0 +1,56 @@ +""" +artemis package + +This package provides functionality to interface with a Fortran library, +including a Python wrapper around the Fortran code. +""" + +from importlib.metadata import PackageNotFoundError, version +try: + __version__ = version(__name__) +except PackageNotFoundError: + __version__ = "unknown" + +from .artemis import interface_generator as _interface_generator_class +from .artemis import termination_generator as _termination_generator_class +from .artemis import geom_rw as _geom_rw_class +# from .artemis import generator + + +# Use the 'types' module to create simulated 'generator' and 'geom submodules +import types +generator = types.ModuleType('generator') +geom = types.ModuleType('geom') + +# Assign the respective class to the simulated 'generator' and 'geom' modules +generator.artemis_interface_generator = _interface_generator_class.artemis_interface_generator +generator.artemis_termination_generator = _termination_generator_class.artemis_termination_generator + +# Assign the class to the simulated 'geom' module +geom.basis_array = _geom_rw_class.basis_array +geom.basis = _geom_rw_class.basis + + +# Add the simulated 'generator' and 'geom' module to the current package +import sys +sys.modules['artemis.generator'] = generator +sys.modules['artemis.geom'] = geom + +# Clean up internal imports (remove access to the direct classes) +del _interface_generator_class +del _termination_generator_class +del _geom_rw_class +del PackageNotFoundError +del version +del sys +del types +del artemis + +__all__ = ['__version__', 'generator', 'geom'] + +def __getattr__(name): + if name == "generator": + return generator + elif name == "geom": + return geom + raise AttributeError(f"module {__name__} has no attribute {name}") \ No newline at end of file diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py new file mode 100644 index 0000000..99a83dd --- /dev/null +++ b/src/artemis/artemis.py @@ -0,0 +1,2018 @@ +from __future__ import print_function, absolute_import, division +import artemis._artemis as _artemis +import f90wrap.runtime +import logging +import numpy + + +class Geom_Rw(f90wrap.runtime.FortranModule): + """ + Code for handling geometry read/write operations. + + This module provides the necessary functionality to read, write, and + store atomic geometries. + In this module, and all of the codebase, element and species are used + interchangeably. + + Defined in ../src/lib/mod_geom_rw.f90 + + .. note:: + It is recommended not to use this module directly, but to handle + atom objects through the ASE interface. + This is provided mostly for compatibility with the existing codebase + and Fortran code. + """ + @f90wrap.runtime.register_class("artemis.species_type") + class species_type(f90wrap.runtime.FortranDerivedType): + def __init__(self, handle=None): + """ + Create a ``species_type`` object. + + Returns: + species (species_type): + Object to be constructed + """ + f90wrap.runtime.FortranDerivedType.__init__(self) + result = _artemis.f90wrap_geom_rw__species_type_initialise() + self._handle = result[0] if isinstance(result, tuple) else result + + def __del__(self): + """ + Destructor for class species_type + + + Defined at ../src/lib/mod_geom_rw.f90 lines \ + 26-32 + + Parameters + ---------- + this : species_type + Object to be destructed + + + Automatically generated destructor for species_type + """ + if self._alloc: + _artemis.f90wrap_geom_rw__species_type_finalise(this=self._handle) + + @property + def atom(self): + """ + Derived type containing the atomic information of a crystal. + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_species_type__array__atom(self._handle) + if array_handle in self._arrays: + atom = self._arrays[array_handle] + else: + atom = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_species_type__array__atom) + self._arrays[array_handle] = atom + return atom + + @atom.setter + def atom(self, atom): + self.atom[...] = atom + + @property + def mass(self): + """ + The mass of the element. + """ + return _artemis.f90wrap_species_type__get__mass(self._handle) + + @mass.setter + def mass(self, mass): + _artemis.f90wrap_species_type__set__mass(self._handle, mass) + + @property + def charge(self): + """ + The charge of the element. + """ + return _artemis.f90wrap_species_type__get__charge(self._handle) + + @property + def radius(self): + """ + The radius of the element. + """ + return _artemis.f90wrap_species_type__get__radius(self._handle) + + @radius.setter + def radius(self, radius): + _artemis.f90wrap_species_type__set__radius(self._handle, radius) + + @charge.setter + def charge(self, charge): + _artemis.f90wrap_species_type__set__charge(self._handle, charge) + + @property + def name(self): + """ + The symbol of the element. + """ + return _artemis.f90wrap_species_type__get__name(self._handle) + + @name.setter + def name(self, name): + _artemis.f90wrap_species_type__set__name(self._handle, name) + + @property + def num(self): + """ + The number of atoms of this species/element. + """ + return _artemis.f90wrap_species_type__get__num(self._handle) + + @num.setter + def num(self, num): + _artemis.f90wrap_species_type__set__num(self._handle, num) + + def __str__(self): + ret = ['{\n'] + ret.append(' atom : ') + ret.append(repr(self.atom)) + ret.append(',\n mass : ') + ret.append(repr(self.mass)) + ret.append(',\n charge : ') + ret.append(repr(self.charge)) + ret.append(',\n name : ') + ret.append(repr(self.name)) + ret.append(',\n num : ') + ret.append(repr(self.num)) + ret.append('}') + return ''.join(ret) + + _dt_array_initialisers = [] + + + @f90wrap.runtime.register_class("artemis.basis") + class basis(f90wrap.runtime.FortranDerivedType): + def __init__(self, atoms=None, handle=None): + """ + Create a ``basis`` object. + + This object is used to store the atomic information of a crystal, + including lattice and basis information. + This is confusingly named as a crystal = lattice + basis. + + Returns: + basis (basis): + Object to be constructed + """ + f90wrap.runtime.FortranDerivedType.__init__(self) + result = _artemis.f90wrap_geom_rw__basis_type_initialise() + self._handle = result[0] if isinstance(result, tuple) else result + + if atoms is not None: + self.fromase(atoms) + + def __del__(self): + """ + Destructor for class basis + + + Defined at ../src/lib/mod_geom_rw.f90 lines \ + 34-42 + + Parameters + ---------- + this : basis + Object to be destructed + + + Automatically generated destructor for basis + """ + if self._alloc: + _artemis.f90wrap_geom_rw__basis_type_finalise(this=self._handle) + + def allocate_species(self, num_species=None, species_symbols=None, species_count=None, \ + positions=None): + """ + Allocate memory for the species list. + + Parameters: + num_species (int): + Number of species + species_symbols (list of str): + List of species symbols + species_count (list of int): + List of species counts + atoms (list of float): + List of atomic positions + """ + _artemis.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) + + def _init_array_spec(self): + """ + Initialise the species array. + """ + self.spec = f90wrap.runtime.FortranDerivedTypeArray(self, + _artemis.f90wrap_basis_type__array_getitem__spec, + _artemis.f90wrap_basis_type__array_setitem__spec, + _artemis.f90wrap_basis_type__array_len__spec, + """ + Element spec ftype=type(species_type) pytype=species_type + + + Defined at ../src/lib/mod_geom_rw.f90 line 35 + + """, Geom_Rw.species_type) + return self.spec + + def toase(self, calculator=None): + """ + Convert the basis object to an ASE Atoms object. + + Parameters: + calculator (ASE Calculator): + ASE calculator object to be assigned to the Atoms object. + """ + from ase import Atoms + + # Set the species list + positions = [] + species_string = "" + for i in range(self.nspec): + for j in range(self.spec[i].num): + species_string += str(self.spec[i].name.decode()).strip() + positions.append(self.spec[i].atom[j]) + + # Set the atoms + if(self.lcart): + atoms = Atoms(species_string, positions=positions, cell=self.lat, pbc=self.pbc) + else: + atoms = Atoms(species_string, scaled_positions=positions, cell=self.lat, pbc=self.pbc) + + if calculator is not None: + atoms.calc = calculator + return atoms + + def fromase(self, atoms, verbose=False): + """ + Convert the ASE Atoms object to a basis object. + + Parameters: + atoms (ASE Atoms): + ASE Atoms object to be converted. + verbose (bool): + Boolean whether to print warnings. + """ + from ase.calculators.singlepoint import SinglePointCalculator + + # Get the species symbols + species_symbols = atoms.get_chemical_symbols() + species_symbols_unique = sorted(set(species_symbols)) + + # Set the number of species + self.nspec = len(species_symbols_unique) + + # Set the number of atoms + self.natom = len(atoms) + + # check if calculator is present + if atoms.calc is None: + if verbose: + print("WARNING: No calculator present, setting energy to 0.0") + atoms.calc = SinglePointCalculator(atoms, energy=0.0) + self.energy = atoms.get_potential_energy() + + # # Set the lattice vectors + self.lat = numpy.reshape(atoms.get_cell().flatten(), [3,3], order='A') + self.pbc = atoms.pbc + + # Set the system name + self.sysname = atoms.get_chemical_formula() + + # Set the species list + species_count = [] + atom_positions = [] + positions = atoms.get_scaled_positions() + for species in species_symbols_unique: + species_count.append(sum([1 for symbol in species_symbols if symbol == species])) + for j, symbol in enumerate(species_symbols): + if symbol == species: + atom_positions.append(positions[j]) + + # Allocate memory for the atom list + self.lcart = False + self.allocate_species(species_symbols=species_symbols_unique, species_count=species_count, positions=atom_positions) + + @property + def nspec(self): + """ + The number of species in the basis. + """ + return _artemis.f90wrap_basis_type__get__nspec(self._handle) + + @nspec.setter + def nspec(self, nspec): + _artemis.f90wrap_basis_type__set__nspec(self._handle, nspec) + + @property + def natom(self): + """ + The number of atoms in the basis. + """ + return _artemis.f90wrap_basis_type__get__natom(self._handle) + + @natom.setter + def natom(self, natom): + _artemis.f90wrap_basis_type__set__natom(self._handle, natom) + + @property + def energy(self): + """ + The energy associated with the basis (or crystal). + """ + return _artemis.f90wrap_basis_type__get__energy(self._handle) + + @energy.setter + def energy(self, energy): + _artemis.f90wrap_basis_type__set__energy(self._handle, energy) + + @property + def lat(self): + """ + The lattice vectors of the basis. + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_basis_type__array__lat(self._handle) + if array_handle in self._arrays: + lat = self._arrays[array_handle] + else: + lat = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_basis_type__array__lat) + self._arrays[array_handle] = lat + return lat + + @lat.setter + def lat(self, lat): + self.lat[...] = lat + + @property + def lcart(self): + """ + Boolean whether the atomic positions are in cartesian coordinates. + """ + return _artemis.f90wrap_basis_type__get__lcart(self._handle) + + @lcart.setter + def lcart(self, lcart): + _artemis.f90wrap_basis_type__set__lcart(self._handle, lcart) + + @property + def pbc(self): + """ + Boolean array indicating the periodic boundary conditions. + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_basis_type__array__pbc(self._handle) + if array_handle in self._arrays: + pbc = self._arrays[array_handle] + else: + pbc = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_basis_type__array__pbc) + self._arrays[array_handle] = pbc + return pbc + + @pbc.setter + def pbc(self, pbc): + self.pbc[...] = pbc + + @property + def sysname(self): + """ + The name of the system. + """ + return _artemis.f90wrap_basis_type__get__sysname(self._handle) + + @sysname.setter + def sysname(self, sysname): + _artemis.f90wrap_basis_type__set__sysname(self._handle, sysname) + + def __str__(self): + ret = ['{\n'] + ret.append(' nspec : ') + ret.append(repr(self.nspec)) + ret.append(',\n natom : ') + ret.append(repr(self.natom)) + ret.append(',\n energy : ') + ret.append(repr(self.energy)) + ret.append(',\n lat : ') + ret.append(repr(self.lat)) + ret.append(',\n lcart : ') + ret.append(repr(self.lcart)) + ret.append(',\n pbc : ') + ret.append(repr(self.pbc)) + ret.append(',\n sysname : ') + ret.append(repr(self.sysname)) + ret.append('}') + return ''.join(ret) + + _dt_array_initialisers = [_init_array_spec] + + + + @f90wrap.runtime.register_class("artemis.basis_array") + class basis_array(f90wrap.runtime.FortranDerivedType): + def __init__(self, atoms=None, handle=None): + """ + Create a ``basis_array`` object. + + + Returns: + basis_array (basis_array): + Object to be constructed + """ + + f90wrap.runtime.FortranDerivedType.__init__(self) + result = _artemis.f90wrap_geom_rw__basis_type_xnum_array_initialise() + self._handle = result[0] if isinstance(result, tuple) else result + + + # check if atoms is an ASE Atoms object or a list of ASE Atoms objects + if atoms: + from ase import Atoms + if isinstance(atoms, Atoms): + self.allocate(1) + self.items[0].fromase(atoms) + elif isinstance(atoms, list): + self.allocate(len(atoms)) + for i, atom in enumerate(atoms): + self.items[i].fromase(atom) + + def __del__(self): + """ + Destructor for class basis_array + + + Defined at ../src/lib/mod_generator.f90 lines \ + 19-21 + + Parameters + ---------- + this : basis_array + Object to be destructed + + + Automatically generated destructor for basis_array + """ + if self._alloc: + _artemis.f90wrap_geom_rw__basis_type_xnum_array_finalise(this=self._handle) + + def _init_array_items(self): + """ + Initialise the items array. + """ + self.items = f90wrap.runtime.FortranDerivedTypeArray(self, + _artemis.f90wrap_basis_type_xnum_array__array_getitem__items, + _artemis.f90wrap_basis_type_xnum_array__array_setitem__items, + _artemis.f90wrap_basis_type_xnum_array__array_len__items, + """ + Element items ftype=type(basis_type) pytype=basis + + + Defined at line 0 + + """, Geom_Rw.basis) + return self.items + + def toase(self): + """ + Convert the basis_array object to a list of ASE Atoms objects. + """ + + # Set the species list + atoms = [] + for i in range(len(self.items)): + atoms.append(self.items[i].toase()) + return atoms + + def allocate(self, size): + """ + Allocate the items array with the given size. + + Parameters: + size (int): + Size of the items array + """ + _artemis.f90wrap_basis_type_xnum_array__array_alloc__items(self._handle, num=size) + + def deallocate(self): + """ + Deallocate the items array + """ + _artemis.f90wrap_basis_type_xnum_array__array_dealloc__items(self._handle) + + _dt_array_initialisers = [_init_array_items] + + _dt_array_initialisers = [] + + +geom_rw = Geom_Rw() + +# class Geom_Rw(f90wrap.runtime.FortranModule): +# """ +# Module geom_rw + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 13-1907 + +# """ +# @f90wrap.runtime.register_class("artemis.species_type") +# class species_type(f90wrap.runtime.FortranDerivedType): +# """ +# Type(name=species_type) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 34-47 + +# """ +# def __init__(self, handle=None): +# """ +# self = Species_Type() + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 34-47 + + +# Returns +# ------- +# this : Species_Type +# Object to be constructed + + +# Automatically generated constructor for species_type +# """ +# f90wrap.runtime.FortranDerivedType.__init__(self) +# result = _artemis.f90wrap_geom_rw__species_type_initialise() +# self._handle = result[0] if isinstance(result, tuple) else result + +# def __del__(self): +# """ +# Destructor for class Species_Type + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 34-47 + +# Parameters +# ---------- +# this : Species_Type +# Object to be destructed + + +# Automatically generated destructor for species_type +# """ +# if self._alloc: +# _artemis.f90wrap_geom_rw__species_type_finalise(this=self._handle) + +# @property +# def atom(self): +# """ +# Element atom ftype=real(real32) pytype=float + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 36 + +# """ +# array_ndim, array_type, array_shape, array_handle = \ +# _artemis.f90wrap_species_type__array__atom(self._handle) +# if array_handle in self._arrays: +# atom = self._arrays[array_handle] +# else: +# atom = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, +# self._handle, +# _artemis.f90wrap_species_type__array__atom) +# self._arrays[array_handle] = atom +# return atom + +# @atom.setter +# def atom(self, atom): +# self.atom[...] = atom + +# @property +# def mass(self): +# """ +# Element mass ftype=real(real32) pytype=float + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 38 + +# """ +# return _artemis.f90wrap_species_type__get__mass(self._handle) + +# @mass.setter +# def mass(self, mass): +# _artemis.f90wrap_species_type__set__mass(self._handle, mass) + +# @property +# def charge(self): +# """ +# Element charge ftype=real(real32) pytype=float + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 40 + +# """ +# return _artemis.f90wrap_species_type__get__charge(self._handle) + +# @charge.setter +# def charge(self, charge): +# _artemis.f90wrap_species_type__set__charge(self._handle, charge) + +# @property +# def radius(self): +# """ +# Element radius ftype=real(real32) pytype=float + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 42 + +# """ +# return _artemis.f90wrap_species_type__get__radius(self._handle) + +# @radius.setter +# def radius(self, radius): +# _artemis.f90wrap_species_type__set__radius(self._handle, radius) + +# @property +# def name(self): +# """ +# Element name ftype=character(len=3) pytype=str + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 44 + +# """ +# return _artemis.f90wrap_species_type__get__name(self._handle) + +# @name.setter +# def name(self, name): +# _artemis.f90wrap_species_type__set__name(self._handle, name) + +# @property +# def num(self): +# """ +# Element num ftype=integer pytype=int + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 46 + +# """ +# return _artemis.f90wrap_species_type__get__num(self._handle) + +# @num.setter +# def num(self, num): +# _artemis.f90wrap_species_type__set__num(self._handle, num) + +# def __str__(self): +# ret = ['{\n'] +# ret.append(' atom : ') +# ret.append(repr(self.atom)) +# ret.append(',\n mass : ') +# ret.append(repr(self.mass)) +# ret.append(',\n charge : ') +# ret.append(repr(self.charge)) +# ret.append(',\n radius : ') +# ret.append(repr(self.radius)) +# ret.append(',\n name : ') +# ret.append(repr(self.name)) +# ret.append(',\n num : ') +# ret.append(repr(self.num)) +# ret.append('}') +# return ''.join(ret) + +# _dt_array_initialisers = [] + + +# @f90wrap.runtime.register_class("artemis.basis_type") +# class basis_type(f90wrap.runtime.FortranDerivedType): +# """ +# Type(name=basis_type) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 49-83 + +# """ +# def __init__(self, handle=None): +# """ +# self = Basis_Type() + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 49-83 + + +# Returns +# ------- +# this : Basis_Type +# Object to be constructed + + +# Automatically generated constructor for basis_type +# """ +# f90wrap.runtime.FortranDerivedType.__init__(self) +# result = _artemis.f90wrap_geom_rw__basis_type_initialise() +# self._handle = result[0] if isinstance(result, tuple) else result + +# def __del__(self): +# """ +# Destructor for class Basis_Type + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 49-83 + +# Parameters +# ---------- +# this : Basis_Type +# Object to be destructed + + +# Automatically generated destructor for basis_type +# """ +# if self._alloc: +# _artemis.f90wrap_geom_rw__basis_type_finalise(this=self._handle) + +# def allocate_species(self, num_species=None, species_symbols=None, \ +# species_count=None, atoms=None): +# """ +# allocate_species__binding__basis_type(self[, num_species, species_symbols, \ +# species_count, atoms]) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 110-153 + +# Parameters +# ---------- +# this : Basis_Type +# num_species : int +# species_symbols : str array +# species_count : int array +# atoms : float array + +# """ +# _artemis.f90wrap_geom_rw__allocate_species__binding__basis_type(this=self._handle, \ +# num_species=num_species, species_symbols=species_symbols, \ +# species_count=species_count, atoms=atoms) + +# def convert(self): +# """ +# convert__binding__basis_type(self) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1035-1057 + +# Parameters +# ---------- +# this : Basis_Type + +# """ +# _artemis.f90wrap_geom_rw__convert__binding__basis_type(this=self._handle) + +# def change_lattice(self, lattice): +# """ +# change_lattice__binding__basis_type(self, lattice) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1061-1088 + +# Parameters +# ---------- +# this : Basis_Type +# lattice : float array + +# """ +# _artemis.f90wrap_geom_rw__change_lattice__binding__basis_type(this=self._handle, \ +# lattice=lattice) + +# def normalise(self, ceil_val=None, floor_coords=None, round_coords=None, \ +# zero_round=None): +# """ +# normalise__binding__basis_type(self[, ceil_val, floor_coords, round_coords, \ +# zero_round]) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1097-1147 + +# Parameters +# ---------- +# this : Basis_Type +# ceil_val : float +# floor_coords : bool +# round_coords : bool +# zero_round : float + +# """ +# _artemis.f90wrap_geom_rw__normalise__binding__basis_type(this=self._handle, \ +# ceil_val=ceil_val, floor_coords=floor_coords, round_coords=round_coords, \ +# zero_round=zero_round) + +# def copy(self, basis, length=None): +# """ +# copy__binding__basis_type(self, basis[, length]) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1229-1290 + +# Parameters +# ---------- +# this : Basis_Type +# basis : Basis_Type +# length : int + +# --------------------------------------------------------------------------- +# determines whether user wants output basis extra translational dimension +# --------------------------------------------------------------------------- +# """ +# _artemis.f90wrap_geom_rw__copy__binding__basis_type(this=self._handle, \ +# basis=basis._handle, length=length) + +# def get_lattice_constants(self, radians=None): +# """ +# output = get_lattice_constants__binding__basis_type(self[, radians]) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1210-1225 + +# Parameters +# ---------- +# this : Basis_Type +# radians : bool + +# Returns +# ------- +# output : float array + +# """ +# output = \ +# _artemis.f90wrap_geom_rw__get_lattice_constants__binding__bc9a1(this=self._handle, \ +# radians=radians) +# return output + +# def remove_atom(self, ispec, iatom): +# """ +# remove_atom__binding__basis_type(self, ispec, iatom) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1294-1336 + +# Parameters +# ---------- +# this : Basis_Type +# ispec : int +# iatom : int + +# --------------------------------------------------------------------------- +# remove atom from basis +# --------------------------------------------------------------------------- +# """ +# _artemis.f90wrap_geom_rw__remove_atom__binding__basis_type(this=self._handle, \ +# ispec=ispec, iatom=iatom) + +# def remove_atoms(self, atoms): +# """ +# remove_atoms__binding__basis_type(self, atoms) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1340-1403 + +# Parameters +# ---------- +# this : Basis_Type +# atoms : int array + +# --------------------------------------------------------------------------- +# reorder atoms to remove +# --------------------------------------------------------------------------- +# """ +# _artemis.f90wrap_geom_rw__remove_atoms__binding__basis_type(this=self._handle, \ +# atoms=atoms) + +# def init_array_spec(self): +# self.spec = f90wrap.runtime.FortranDerivedTypeArray(self, +# _artemis.f90wrap_basis_type__array_getitem__spec, +# _artemis.f90wrap_basis_type__array_setitem__spec, +# _artemis.f90wrap_basis_type__array_len__spec, +# """ +# Element spec ftype=type(species_type) pytype=Species_Type + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 51 + +# """, Geom_Rw.species_type) +# return self.spec + +# @property +# def nspec(self): +# """ +# Element nspec ftype=integer pytype=int + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 53 + +# """ +# return _artemis.f90wrap_basis_type__get__nspec(self._handle) + +# @nspec.setter +# def nspec(self, nspec): +# _artemis.f90wrap_basis_type__set__nspec(self._handle, nspec) + +# @property +# def natom(self): +# """ +# Element natom ftype=integer pytype=int + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 55 + +# """ +# return _artemis.f90wrap_basis_type__get__natom(self._handle) + +# @natom.setter +# def natom(self, natom): +# _artemis.f90wrap_basis_type__set__natom(self._handle, natom) + +# @property +# def energy(self): +# """ +# Element energy ftype=real(real32) pytype=float + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 57 + +# """ +# return _artemis.f90wrap_basis_type__get__energy(self._handle) + +# @energy.setter +# def energy(self, energy): +# _artemis.f90wrap_basis_type__set__energy(self._handle, energy) + +# @property +# def lat(self): +# """ +# Element lat ftype=real(real32) pytype=float + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 59 + +# """ +# array_ndim, array_type, array_shape, array_handle = \ +# _artemis.f90wrap_basis_type__array__lat(self._handle) +# if array_handle in self._arrays: +# lat = self._arrays[array_handle] +# else: +# lat = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, +# self._handle, +# _artemis.f90wrap_basis_type__array__lat) +# self._arrays[array_handle] = lat +# return lat + +# @lat.setter +# def lat(self, lat): +# self.lat[...] = lat + +# @property +# def lcart(self): +# """ +# Element lcart ftype=logical pytype=bool + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 61 + +# """ +# return _artemis.f90wrap_basis_type__get__lcart(self._handle) + +# @lcart.setter +# def lcart(self, lcart): +# _artemis.f90wrap_basis_type__set__lcart(self._handle, lcart) + +# @property +# def pbc(self): +# """ +# Element pbc ftype=logical pytype=bool + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 63 + +# """ +# array_ndim, array_type, array_shape, array_handle = \ +# _artemis.f90wrap_basis_type__array__pbc(self._handle) +# if array_handle in self._arrays: +# pbc = self._arrays[array_handle] +# else: +# pbc = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, +# self._handle, +# _artemis.f90wrap_basis_type__array__pbc) +# self._arrays[array_handle] = pbc +# return pbc + +# @pbc.setter +# def pbc(self, pbc): +# self.pbc[...] = pbc + +# @property +# def sysname(self): +# """ +# Element sysname ftype=character(len=128) pytype=str + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 65 + +# """ +# return _artemis.f90wrap_basis_type__get__sysname(self._handle) + +# @sysname.setter +# def sysname(self, sysname): +# _artemis.f90wrap_basis_type__set__sysname(self._handle, sysname) + +# def __str__(self): +# ret = ['{\n'] +# ret.append(' nspec : ') +# ret.append(repr(self.nspec)) +# ret.append(',\n natom : ') +# ret.append(repr(self.natom)) +# ret.append(',\n energy : ') +# ret.append(repr(self.energy)) +# ret.append(',\n lat : ') +# ret.append(repr(self.lat)) +# ret.append(',\n lcart : ') +# ret.append(repr(self.lcart)) +# ret.append(',\n pbc : ') +# ret.append(repr(self.pbc)) +# ret.append(',\n sysname : ') +# ret.append(repr(self.sysname)) +# ret.append('}') +# return ''.join(ret) + +# _dt_array_initialisers = [init_array_spec] + + +# @staticmethod +# def geom_read(unit, length=None, iostat=None): +# """ +# basis = geom_read(unit[, length, iostat]) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 157-212 + +# Parameters +# ---------- +# unit : int +# length : int +# iostat : int + +# Returns +# ------- +# basis : Basis_Type + +# """ +# basis = _artemis.f90wrap_geom_rw__geom_read(unit=unit, length=length, \ +# iostat=iostat) +# basis = f90wrap.runtime.lookup_class("artemis.basis_type").from_handle(basis, \ +# alloc=True) +# return basis + +# @staticmethod +# def geom_write(unit, basis): +# """ +# geom_write(unit, basis) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 216-240 + +# Parameters +# ---------- +# unit : int +# basis : Basis_Type + +# """ +# _artemis.f90wrap_geom_rw__geom_write(unit=unit, basis=basis._handle) + +# @staticmethod +# def get_element_properties(element, charge=None, mass=None, radius=None): +# """ +# get_element_properties(element[, charge, mass, radius]) + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# lines 1407-1906 + +# Parameters +# ---------- +# element : str +# charge : float +# mass : float +# radius : float + +# --------------------------------------------------------------------------- +# Return the values +# --------------------------------------------------------------------------- +# """ +# _artemis.f90wrap_geom_rw__get_element_properties(element=element, \ +# charge=charge, mass=mass, radius=radius) + +# @property +# def igeom_input(self): +# """ +# Element igeom_input ftype=integer pytype=int + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 24 + +# """ +# return _artemis.f90wrap_geom_rw__get__igeom_input() + +# @igeom_input.setter +# def igeom_input(self, igeom_input): +# _artemis.f90wrap_geom_rw__set__igeom_input(igeom_input) + +# @property +# def igeom_output(self): +# """ +# Element igeom_output ftype=integer pytype=int + + +# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ +# line 32 + +# """ +# return _artemis.f90wrap_geom_rw__get__igeom_output() + +# @igeom_output.setter +# def igeom_output(self, igeom_output): +# _artemis.f90wrap_geom_rw__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 = [] + + +# geom_rw = Geom_Rw() + +class Termination_Generator(f90wrap.runtime.FortranModule): + """ + Module artemis__termination_generator + + + Defined at \ + ../src/fortran/lib/mod_term_generator.f90 \ + lines 7-202 + + """ + @f90wrap.runtime.register_class("artemis.artemis_termination_generator") + class artemis_termination_generator(f90wrap.runtime.FortranDerivedType): + """ + Type(name=artemis_termination_generator_type) + + + Defined at \ + ../src/fortran/lib/mod_term_generator.f90 \ + lines 21-24 + + """ + def __init__(self, handle=None): + """ + self = Artemis_Termination_Generator_Type() + + + Defined at \ + ../src/fortran/lib/mod_term_generator.f90 \ + lines 21-24 + + + Returns + ------- + this : Artemis_Termination_Generator_Type + Object to be constructed + + + Automatically generated constructor for artemis_termination_generator_type + """ + f90wrap.runtime.FortranDerivedType.__init__(self) + result = \ + _artemis.f90wrap_term_gen__artemis_termination293d() + self._handle = result[0] if isinstance(result, tuple) else result + + def __del__(self): + """ + Destructor for class Artemis_Termination_Generator_Type + + + Defined at \ + ../src/fortran/lib/mod_term_generator.f90 \ + lines 21-24 + + Parameters + ---------- + this : Artemis_Termination_Generator_Type + Object to be destructed + + + Automatically generated destructor for artemis_termination_generator_type + """ + if self._alloc: + _artemis.f90wrap_term_gen__artemis_terminationdf16(this=self._handle) + + def generate(self, basis, miller_plane, axis, surface=None, num_layers=None, \ + thickness=None, orthogonalise=None, normalise=None, break_on_fail=None): + """ + generate__binding__artemis_termination_generator_type(self, basis, miller_plane, \ + axis[, surface, num_layers, thickness, orthogonalise, normalise, \ + break_on_fail]) + + + Defined at \ + ../src/fortran/lib/mod_term_generator.f90 \ + lines 31-201 + + Parameters + ---------- + this : Artemis_Termination_Generator_Type + basis : Basis_Type + miller_plane : int array + axis : int + surface : int array + num_layers : int + thickness : float + orthogonalise : bool + normalise : bool + break_on_fail : bool + + --------------------------------------------------------------------------- + Finds smallest thickness of the slab and increases to ... + ... user-defined thickness + --------------------------------------------------------------------------- + """ + _artemis.f90wrap_term_gen__generate__binding__2af7(this=self._handle, \ + basis=basis._handle, miller_plane=miller_plane, axis=axis, surface=surface, \ + num_layers=num_layers, thickness=thickness, orthogonalise=orthogonalise, \ + normalise=normalise, break_on_fail=break_on_fail) + + @property + def layer_separation_cutoff(self): + """ + Element layer_separation_cutoff ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_term_generator.f90 \ + line 22 + + """ + return \ + _artemis.f90wrap_artemis_termination_generator_type__get__layer_sepace78(self._handle) + + @layer_separation_cutoff.setter + def layer_separation_cutoff(self, layer_separation_cutoff): + _artemis.f90wrap_artemis_termination_generator_type__set__layer_sepae7ef(self._handle, \ + layer_separation_cutoff) + + def __str__(self): + ret = ['{\n'] + ret.append(' layer_separation_cutoff : ') + ret.append(repr(self.layer_separation_cutoff)) + ret.append('}') + return ''.join(ret) + + _dt_array_initialisers = [] + + + _dt_array_initialisers = [] + + +termination_generator = Termination_Generator() + +class Interface_Generator(f90wrap.runtime.FortranModule): + """ + Module artemis__interface_generator + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 7-1373 + + """ + @f90wrap.runtime.register_class("artemis.artemis_interface_generator") + class artemis_interface_generator(f90wrap.runtime.FortranDerivedType): + """ + Type(name=artemis_interface_generator_type) + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 30-75 + + """ + def __init__(self, handle=None): + """ + self = Artemis_Interface_Generator_Type() + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 30-75 + + + Returns + ------- + this : Artemis_Interface_Generator_Type + Object to be constructed + + + Automatically generated constructor for artemis_interface_generator_type + """ + f90wrap.runtime.FortranDerivedType.__init__(self) + result = \ + _artemis.f90wrap_intf_gen__artemis_interface_gen0ea8() + self._handle = result[0] if isinstance(result, tuple) else result + + def __del__(self): + """ + Destructor for class Artemis_Interface_Generator_Type + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 30-75 + + Parameters + ---------- + this : Artemis_Interface_Generator_Type + Object to be destructed + + + Automatically generated destructor for artemis_interface_generator_type + """ + if self._alloc: + _artemis.f90wrap_intf_gen__artemis_interface_genbc51(this=self._handle) + + def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ + area_mismatch=None, max_length=None, max_area=None, max_fit=None, \ + max_extension=None, angle_weight=None, area_weight=None): + """ + set_tolerance__binding__artemis_interface_generator_type(self[, vector_mismatch, \ + angle_mismatch, area_mismatch, max_length, max_area, max_fit, max_extension, \ + angle_weight, area_weight]) + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 85-125 + + Parameters + ---------- + this : Artemis_Interface_Generator_Type + vector_mismatch : float + angle_mismatch : float + area_mismatch : float + max_length : float + max_area : float + max_fit : int + max_extension : int + angle_weight : float + area_weight : float + + """ + _artemis.f90wrap_intf_gen__set_tolerance__bindinfd58(this=self._handle, \ + vector_mismatch=vector_mismatch, angle_mismatch=angle_mismatch, \ + area_mismatch=area_mismatch, max_length=max_length, max_area=max_area, \ + max_fit=max_fit, max_extension=max_extension, angle_weight=angle_weight, \ + area_weight=area_weight) + + def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ + interface_depth=None, separation_scale=None, depth_method=None): + """ + set_shift_method__binding__artemis_interface_generator_type(self[, method, \ + num_shifts, shifts, interface_depth, separation_scale, depth_method]) + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 133-196 + + Parameters + ---------- + this : Artemis_Interface_Generator_Type + method : int + num_shifts : int + shifts : float array + interface_depth : float + separation_scale : float + depth_method : int + + """ + _artemis.f90wrap_intf_gen__set_shift_method__bin4dc1(this=self._handle, \ + method=method, num_shifts=num_shifts, shifts=shifts, \ + interface_depth=interface_depth, separation_scale=separation_scale, \ + depth_method=depth_method) + + def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ + surface_lw=None, surface_up=None, thickness_lw=None, thickness_up=None, \ + num_layers_lw=None, num_layers_up=None, use_pricel_lw=None, \ + use_pricel_up=None, is_layered_lw=None, is_layered_up=None, \ + elastic_constants_lw=None, elastic_constants_up=None, \ + print_lattice_match_info=None, print_termination_info=None, \ + print_shift_info=None, break_on_fail=None, icheck_match=None, \ + interface_idx=None, generate_structures=None, seed=None): + """ + generate__binding__artemis_interface_generator_type(self, basis_lw, basis_up[, \ + miller_lw, miller_up, surface_lw, surface_up, thickness_lw, thickness_up, \ + num_layers_lw, num_layers_up, use_pricel_lw, use_pricel_up, is_layered_lw, \ + is_layered_up, elastic_constants_lw, elastic_constants_up, \ + print_lattice_match_info, print_termination_info, print_shift_info, \ + break_on_fail, icheck_match, interface_idx, generate_structures, seed]) + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 315-1111 + + Parameters + ---------- + this : Artemis_Interface_Generator_Type + basis_lw : Basis_Type + basis_up : Basis_Type + miller_lw : int array + miller_up : int array + surface_lw : int array + surface_up : int array + thickness_lw : float + thickness_up : float + num_layers_lw : int + num_layers_up : int + use_pricel_lw : bool + use_pricel_up : bool + is_layered_lw : bool + is_layered_up : bool + elastic_constants_lw : float array + elastic_constants_up : float array + print_lattice_match_info : bool + print_termination_info : bool + print_shift_info : bool + break_on_fail : bool + icheck_match : int + interface_idx : int + generate_structures : bool + seed : int + + --------------------------------------------------------------------------- + Set the random seed + --------------------------------------------------------------------------- + """ + _artemis.f90wrap_intf_gen__generate__binding__ar04c1(this=self._handle, \ + basis_lw=basis_lw._handle, basis_up=basis_up._handle, miller_lw=miller_lw, \ + miller_up=miller_up, surface_lw=surface_lw, surface_up=surface_up, \ + thickness_lw=thickness_lw, thickness_up=thickness_up, \ + num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, \ + use_pricel_lw=use_pricel_lw, use_pricel_up=use_pricel_up, \ + is_layered_lw=is_layered_lw, is_layered_up=is_layered_up, \ + elastic_constants_lw=elastic_constants_lw, \ + elastic_constants_up=elastic_constants_up, \ + print_lattice_match_info=print_lattice_match_info, \ + print_termination_info=print_termination_info, \ + print_shift_info=print_shift_info, break_on_fail=break_on_fail, \ + icheck_match=icheck_match, interface_idx=interface_idx, \ + generate_structures=generate_structures, seed=seed) + + def restart(self, basis, interface_location=None, print_shift_info=None, \ + seed=None): + """ + restart__binding__artemis_interface_generator_type(self, basis[, \ + interface_location, print_shift_info, seed]) + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 202-297 + + Parameters + ---------- + this : Artemis_Interface_Generator_Type + basis : Basis_Type + interface_location : float array + print_shift_info : bool + seed : int + + --------------------------------------------------------------------------- + Set the random seed + --------------------------------------------------------------------------- + """ + _artemis.f90wrap_intf_gen__restart__binding__artdb00(this=self._handle, \ + basis=basis._handle, interface_location=interface_location, \ + print_shift_info=print_shift_info, seed=seed) + + @property + def shift_method(self): + """ + Element shift_method ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 31 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__shift_method(self._handle) + + @shift_method.setter + def shift_method(self, shift_method): + _artemis.f90wrap_artemis_interface_generator_type__set__shift_method(self._handle, \ + shift_method) + + @property + def num_shifts(self): + """ + Element num_shifts ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 33 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__num_shifts(self._handle) + + @num_shifts.setter + def num_shifts(self, num_shifts): + _artemis.f90wrap_artemis_interface_generator_type__set__num_shifts(self._handle, \ + num_shifts) + + @property + def shifts(self): + """ + Element shifts ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 35 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__array__shifts(self._handle) + if array_handle in self._arrays: + shifts = self._arrays[array_handle] + else: + shifts = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_artemis_interface_generator_type__array__shifts) + self._arrays[array_handle] = shifts + return shifts + + @shifts.setter + def shifts(self, shifts): + self.shifts[...] = shifts + + @property + def interface_depth(self): + """ + Element interface_depth ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 37 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__interface_depth(self._handle) + + @interface_depth.setter + def interface_depth(self, interface_depth): + _artemis.f90wrap_artemis_interface_generator_type__set__interface_depth(self._handle, \ + interface_depth) + + @property + def separation_scale(self): + """ + Element separation_scale ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 39 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__separation_scale(self._handle) + + @separation_scale.setter + def separation_scale(self, separation_scale): + _artemis.f90wrap_artemis_interface_generator_type__set__separation_scale(self._handle, \ + separation_scale) + + @property + def depth_method(self): + """ + Element depth_method ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 41 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__depth_method(self._handle) + + @depth_method.setter + def depth_method(self, depth_method): + _artemis.f90wrap_artemis_interface_generator_type__set__depth_method(self._handle, \ + depth_method) + + @property + def shift_data(self): + """ + Element shift_data ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 43 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__array__shift_data(self._handle) + if array_handle in self._arrays: + shift_data = self._arrays[array_handle] + else: + shift_data = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_artemis_interface_generator_type__array__shift_data) + self._arrays[array_handle] = shift_data + return shift_data + + @shift_data.setter + def shift_data(self, shift_data): + self.shift_data[...] = shift_data + + @property + def swap_method(self): + """ + Element swap_method ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 45 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__swap_method(self._handle) + + @swap_method.setter + def swap_method(self, swap_method): + _artemis.f90wrap_artemis_interface_generator_type__set__swap_method(self._handle, \ + swap_method) + + @property + def num_swaps(self): + """ + Element num_swaps ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 47 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__num_swaps(self._handle) + + @num_swaps.setter + def num_swaps(self, num_swaps): + _artemis.f90wrap_artemis_interface_generator_type__set__num_swaps(self._handle, \ + num_swaps) + + @property + def swap_density(self): + """ + Element swap_density ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 49 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__swap_density(self._handle) + + @swap_density.setter + def swap_density(self, swap_density): + _artemis.f90wrap_artemis_interface_generator_type__set__swap_density(self._handle, \ + swap_density) + + @property + def swap_depth(self): + """ + Element swap_depth ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 51 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__swap_depth(self._handle) + + @swap_depth.setter + def swap_depth(self, swap_depth): + _artemis.f90wrap_artemis_interface_generator_type__set__swap_depth(self._handle, \ + swap_depth) + + @property + def swap_sigma(self): + """ + Element swap_sigma ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 53 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__swap_sigma(self._handle) + + @swap_sigma.setter + def swap_sigma(self, swap_sigma): + _artemis.f90wrap_artemis_interface_generator_type__set__swap_sigma(self._handle, \ + swap_sigma) + + @property + def require_mirror_swaps(self): + """ + Element require_mirror_swaps ftype=logical pytype=bool + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 55 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__require_mirr41cf(self._handle) + + @require_mirror_swaps.setter + def require_mirror_swaps(self, require_mirror_swaps): + _artemis.f90wrap_artemis_interface_generator_type__set__require_mirr3bfa(self._handle, \ + require_mirror_swaps) + + @property + def match_method(self): + """ + Element match_method ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 57 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__match_method(self._handle) + + @match_method.setter + def match_method(self, match_method): + _artemis.f90wrap_artemis_interface_generator_type__set__match_method(self._handle, \ + match_method) + + @property + def max_num_matches(self): + """ + Element max_num_matches ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 58 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__max_num_matches(self._handle) + + @max_num_matches.setter + def max_num_matches(self, max_num_matches): + _artemis.f90wrap_artemis_interface_generator_type__set__max_num_matches(self._handle, \ + max_num_matches) + + @property + def max_num_terms(self): + """ + Element max_num_terms ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 59 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__max_num_terms(self._handle) + + @max_num_terms.setter + def max_num_terms(self, max_num_terms): + _artemis.f90wrap_artemis_interface_generator_type__set__max_num_terms(self._handle, \ + max_num_terms) + + @property + def max_num_planes(self): + """ + Element max_num_planes ftype=integer pytype=int + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 60 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__max_num_planes(self._handle) + + @max_num_planes.setter + def max_num_planes(self, max_num_planes): + _artemis.f90wrap_artemis_interface_generator_type__set__max_num_planes(self._handle, \ + max_num_planes) + + @property + def fix_normal(self): + """ + Element fix_normal ftype=logical pytype=bool + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 61 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__fix_normal(self._handle) + + @fix_normal.setter + def fix_normal(self, fix_normal): + _artemis.f90wrap_artemis_interface_generator_type__set__fix_normal(self._handle, \ + fix_normal) + + @property + def bondlength_cutoff(self): + """ + Element bondlength_cutoff ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 65 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__bondlength_c21a8(self._handle) + + @bondlength_cutoff.setter + def bondlength_cutoff(self, bondlength_cutoff): + _artemis.f90wrap_artemis_interface_generator_type__set__bondlength_cbd11(self._handle, \ + bondlength_cutoff) + + @property + def layer_separation_cutoff(self): + """ + Element layer_separation_cutoff ftype=real(real32) pytype=float + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + line 66 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__array__layer_sepa90a5(self._handle) + if array_handle in self._arrays: + layer_separation_cutoff = self._arrays[array_handle] + else: + layer_separation_cutoff = \ + f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_artemis_interface_generator_type__array__layer_sepa90a5) + self._arrays[array_handle] = layer_separation_cutoff + return layer_separation_cutoff + + @layer_separation_cutoff.setter + def layer_separation_cutoff(self, layer_separation_cutoff): + self.layer_separation_cutoff[...] = layer_separation_cutoff + + def __str__(self): + ret = ['{\n'] + ret.append(' shift_method : ') + ret.append(repr(self.shift_method)) + ret.append(',\n num_shifts : ') + ret.append(repr(self.num_shifts)) + ret.append(',\n shifts : ') + ret.append(repr(self.shifts)) + ret.append(',\n interface_depth : ') + ret.append(repr(self.interface_depth)) + ret.append(',\n separation_scale : ') + ret.append(repr(self.separation_scale)) + ret.append(',\n depth_method : ') + ret.append(repr(self.depth_method)) + ret.append(',\n shift_data : ') + ret.append(repr(self.shift_data)) + ret.append(',\n swap_method : ') + ret.append(repr(self.swap_method)) + ret.append(',\n num_swaps : ') + ret.append(repr(self.num_swaps)) + ret.append(',\n swap_density : ') + ret.append(repr(self.swap_density)) + ret.append(',\n swap_depth : ') + ret.append(repr(self.swap_depth)) + ret.append(',\n swap_sigma : ') + ret.append(repr(self.swap_sigma)) + ret.append(',\n require_mirror_swaps : ') + ret.append(repr(self.require_mirror_swaps)) + ret.append(',\n match_method : ') + ret.append(repr(self.match_method)) + ret.append(',\n max_num_matches : ') + ret.append(repr(self.max_num_matches)) + ret.append(',\n max_num_terms : ') + ret.append(repr(self.max_num_terms)) + ret.append(',\n max_num_planes : ') + ret.append(repr(self.max_num_planes)) + ret.append(',\n fix_normal : ') + ret.append(repr(self.fix_normal)) + ret.append(',\n bondlength_cutoff : ') + ret.append(repr(self.bondlength_cutoff)) + ret.append(',\n layer_separation_cutoff : ') + ret.append(repr(self.layer_separation_cutoff)) + ret.append('}') + return ''.join(ret) + + _dt_array_initialisers = [] + + + _dt_array_initialisers = [] + + +interface_generator = Interface_Generator() + +class Artemis(f90wrap.runtime.FortranModule): + """ + Module artemis + + + Defined at ../src/fortran/artemis.f90 lines \ + 1-4 + + """ + pass + _dt_array_initialisers = [] + + +artemis = Artemis() + diff --git a/src/fortran/lib/mod_intf_generator.f90 b/src/fortran/lib/mod_intf_generator.f90 index 0dcf794..7964fce 100644 --- a/src/fortran/lib/mod_intf_generator.f90 +++ b/src/fortran/lib/mod_intf_generator.f90 @@ -191,10 +191,16 @@ subroutine set_shift_method( & case(3) this%shifts(1,:) = shifts case default - write(err_msg,'(A,I0,A)') & - "ERROR: The shifts vector has ", size(shifts, dim=1), & - " components. It should have 1 or 3." - call err_abort(trim(err_msg),fmtd=.true.) + ! check if length of shifts is divisible by 3 + if(mod(size(shifts,dim=1),3).eq.0) then + allocate(this%shifts(size(shifts,dim=1)/3,3)) + this%shifts = reshape(shifts, [ size(shifts,dim=1)/3,3 ]) + else + write(err_msg,'(A,I0,A)') & + "ERROR: The shifts vector has ", size(shifts, dim=1), & + " components. It should have 1 or 3." + call err_abort(trim(err_msg),fmtd=.true.) + end if end select rank(2) if(size(shifts,dim=2).eq.3) then @@ -222,8 +228,7 @@ end subroutine set_shift_method !############################################################################### - subroutine generate_intefaces_from_existing(this, basis, & - interface_location, & + subroutine generate_intefaces_from_existing(this, basis, interface_location, & print_shift_info, seed & ) !! Generate interfaces for the given basis @@ -424,7 +429,7 @@ subroutine generate_interfaces( & !! Copy of the basis structures type(basis_type) :: slab_lw, slab_up !! Slab structures - type(basis_type) :: interface + type(basis_type) :: intf_basis !! Interface structure character(len=256) :: err_msg !! Error message @@ -515,8 +520,7 @@ subroutine generate_interfaces( & allocate(seed_arr(num_seed)) call random_seed(get=seed_arr) end if - icheck_match_ = -1 - interface_idx_ = -1 + icheck_match_ = -1; interface_idx_ = -1 if(present(icheck_match)) icheck_match_ = icheck_match if(present(interface_idx)) interface_idx_ = interface_idx break_on_fail_ = .true. @@ -1197,15 +1201,15 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------- !! Merge the two bases and lattices and define the interface loc !!----------------------------------------------------------------- - interface = basis_stack(& + intf_basis = basis_stack(& basis1 = slab_lw, basis2 = slab_up, & axis = this%axis, offset = init_offset(:), & map1 = t2lw_map, map2 = t2up_map & ) intf_loc(1) = ( modu(slab_lw%lat(this%axis,:)) + 0.5_real32*init_offset(this%axis) - & - this%vacuum_gap)/modu(interface%lat(this%axis,:)) + this%vacuum_gap)/modu(intf_basis%lat(this%axis,:)) intf_loc(2) = ( modu(slab_lw%lat(this%axis,:)) + modu(slab_up%lat(this%axis,:)) + & - 1.5_real32*init_offset(this%axis) - 2._real32*this%vacuum_gap )/modu(interface%lat(this%axis,:)) + 1.5_real32*init_offset(this%axis) - 2._real32*this%vacuum_gap )/modu(intf_basis%lat(this%axis,:)) if(ierror.ge.1)then write(0,*) "interface:",intf_loc if(ierror.eq.1.and.iunique.eq.icheck_match_-1)then @@ -1217,7 +1221,7 @@ subroutine generate_interfaces( & &code is now exiting...") elseif(ierror.eq.2.and.iunique.eq.icheck_match_-1)then ! call chdir(intf_dir) - call err_abort_print_struc(interface,"test_intf.vasp",& + call err_abort_print_struc(intf_basis,"test_intf.vasp",& "As IPRINT = 2 and ICHECK has been set, & &code is now exiting...") end if @@ -1252,7 +1256,7 @@ subroutine generate_interfaces( & !! Generates shifts and swaps and prints the subsequent structures !!----------------------------------------------------------------- call this%generate_perturbations( & - interface, intf_loc, avg_min_bond, & + intf_basis, intf_loc, avg_min_bond, & bulk_DON, & print_shift_info_, & seed_arr, & diff --git a/src/wrapper/f90wrap_artemis.f90 b/src/wrapper/f90wrap_artemis.f90 new file mode 100644 index 0000000..2107ddb --- /dev/null +++ b/src/wrapper/f90wrap_artemis.f90 @@ -0,0 +1,4 @@ +! Module artemis defined in file ../artemis.f90 + +! End of module artemis defined in file ../artemis.f90 + diff --git a/src/wrapper/f90wrap_mod_geom_rw.f90 b/src/wrapper/f90wrap_mod_geom_rw.f90 new file mode 100644 index 0000000..abb63ac --- /dev/null +++ b/src/wrapper/f90wrap_mod_geom_rw.f90 @@ -0,0 +1,865 @@ +! Module artemis__geom_rw defined in file ../src/lib/mod_geom_rw.f90 + +subroutine f90wrap_species_type__array__atom(this, nd, dtype, dshape, dloc) + use artemis__geom_rw, only: species_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(species_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%atom)) then + dshape(1:2) = shape(this_ptr%p%atom) + dloc = loc(this_ptr%p%atom) + else + dloc = 0 + end if +end subroutine f90wrap_species_type__array__atom + +subroutine f90wrap_species_type__get__mass(this, f90wrap_mass) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_mass + + this_ptr = transfer(this, this_ptr) + f90wrap_mass = this_ptr%p%mass +end subroutine f90wrap_species_type__get__mass + +subroutine f90wrap_species_type__set__mass(this, f90wrap_mass) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_mass + + this_ptr = transfer(this, this_ptr) + this_ptr%p%mass = f90wrap_mass +end subroutine f90wrap_species_type__set__mass + +subroutine f90wrap_species_type__get__charge(this, f90wrap_charge) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_charge + + this_ptr = transfer(this, this_ptr) + f90wrap_charge = this_ptr%p%charge +end subroutine f90wrap_species_type__get__charge + +subroutine f90wrap_species_type__set__charge(this, f90wrap_charge) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_charge + + this_ptr = transfer(this, this_ptr) + this_ptr%p%charge = f90wrap_charge +end subroutine f90wrap_species_type__set__charge + +subroutine f90wrap_species_type__get__radius(this, f90wrap_radius) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_radius + + this_ptr = transfer(this, this_ptr) + f90wrap_radius = this_ptr%p%radius +end subroutine f90wrap_species_type__get__radius + +subroutine f90wrap_species_type__set__radius(this, f90wrap_radius) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_radius + + this_ptr = transfer(this, this_ptr) + this_ptr%p%radius = f90wrap_radius +end subroutine f90wrap_species_type__set__radius + +subroutine f90wrap_species_type__get__name(this, f90wrap_name) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + character(3), intent(out) :: f90wrap_name + + this_ptr = transfer(this, this_ptr) + f90wrap_name = this_ptr%p%name +end subroutine f90wrap_species_type__get__name + +subroutine f90wrap_species_type__set__name(this, f90wrap_name) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + character(3), intent(in) :: f90wrap_name + + this_ptr = transfer(this, this_ptr) + this_ptr%p%name = f90wrap_name +end subroutine f90wrap_species_type__set__name + +subroutine f90wrap_species_type__get__num(this, f90wrap_num) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num + + this_ptr = transfer(this, this_ptr) + f90wrap_num = this_ptr%p%num +end subroutine f90wrap_species_type__get__num + +subroutine f90wrap_species_type__set__num(this, f90wrap_num) + use artemis__geom_rw, only: species_type + implicit none + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: this(2) + type(species_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num = f90wrap_num +end subroutine f90wrap_species_type__set__num + +subroutine f90wrap_geom_rw__species_type_initialise(this) + use artemis__geom_rw, only: species_type + implicit none + + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + type(species_type_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_geom_rw__species_type_initialise + +subroutine f90wrap_geom_rw__species_type_finalise(this) + use artemis__geom_rw, only: species_type + implicit none + + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + type(species_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_geom_rw__species_type_finalise + +subroutine f90wrap_basis_type__array_getitem__spec(f90wrap_this, f90wrap_i, specitem) + + use artemis__geom_rw, only: basis_type, species_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: f90wrap_this(2) + type(basis_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(out) :: specitem(2) + type(species_type_ptr_type) :: spec_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%spec)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%spec)) then + call f90wrap_abort("array index out of range") + else + spec_ptr%p => this_ptr%p%spec(f90wrap_i) + specitem = transfer(spec_ptr,specitem) + endif + else + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_basis_type__array_getitem__spec + +subroutine f90wrap_basis_type__array_setitem__spec(f90wrap_this, f90wrap_i, specitem) + + use artemis__geom_rw, only: basis_type, species_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(in) :: f90wrap_this(2) + type(basis_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(in) :: specitem(2) + type(species_type_ptr_type) :: spec_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%spec)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%spec)) then + call f90wrap_abort("array index out of range") + else + spec_ptr = transfer(specitem,spec_ptr) + this_ptr%p%spec(f90wrap_i) = spec_ptr%p + endif + else + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_basis_type__array_setitem__spec + +subroutine f90wrap_basis_type__array_len__spec(f90wrap_this, f90wrap_n) + + use artemis__geom_rw, only: basis_type, species_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type species_type_ptr_type + type(species_type), pointer :: p => NULL() + end type species_type_ptr_type + integer, intent(out) :: f90wrap_n + integer, intent(in) :: f90wrap_this(2) + type(basis_type_ptr_type) :: this_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%spec)) then + f90wrap_n = size(this_ptr%p%spec) + else + f90wrap_n = 0 + end if +end subroutine f90wrap_basis_type__array_len__spec + +subroutine f90wrap_basis_type__get__nspec(this, f90wrap_nspec) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_nspec + + this_ptr = transfer(this, this_ptr) + f90wrap_nspec = this_ptr%p%nspec +end subroutine f90wrap_basis_type__get__nspec + +subroutine f90wrap_basis_type__set__nspec(this, f90wrap_nspec) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_nspec + + this_ptr = transfer(this, this_ptr) + this_ptr%p%nspec = f90wrap_nspec +end subroutine f90wrap_basis_type__set__nspec + +subroutine f90wrap_basis_type__get__natom(this, f90wrap_natom) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_natom + + this_ptr = transfer(this, this_ptr) + f90wrap_natom = this_ptr%p%natom +end subroutine f90wrap_basis_type__get__natom + +subroutine f90wrap_basis_type__set__natom(this, f90wrap_natom) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_natom + + this_ptr = transfer(this, this_ptr) + this_ptr%p%natom = f90wrap_natom +end subroutine f90wrap_basis_type__set__natom + +subroutine f90wrap_basis_type__get__energy(this, f90wrap_energy) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_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_basis_type__get__energy + +subroutine f90wrap_basis_type__set__energy(this, f90wrap_energy) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_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_basis_type__set__energy + +subroutine f90wrap_basis_type__array__lat(this, nd, dtype, dshape, dloc) + use artemis__geom_rw, only: basis_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(basis_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) + dshape(1:2) = shape(this_ptr%p%lat) + dloc = loc(this_ptr%p%lat) +end subroutine f90wrap_basis_type__array__lat + +subroutine f90wrap_basis_type__get__lcart(this, f90wrap_lcart) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_lcart + + this_ptr = transfer(this, this_ptr) + f90wrap_lcart = this_ptr%p%lcart +end subroutine f90wrap_basis_type__get__lcart + +subroutine f90wrap_basis_type__set__lcart(this, f90wrap_lcart) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_lcart + + this_ptr = transfer(this, this_ptr) + this_ptr%p%lcart = f90wrap_lcart +end subroutine f90wrap_basis_type__set__lcart + +subroutine f90wrap_basis_type__array__pbc(this, nd, dtype, dshape, dloc) + use artemis__geom_rw, only: basis_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(basis_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%pbc) + dloc = loc(this_ptr%p%pbc) +end subroutine f90wrap_basis_type__array__pbc + +subroutine f90wrap_basis_type__get__sysname(this, f90wrap_sysname) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + character(128), intent(out) :: f90wrap_sysname + + this_ptr = transfer(this, this_ptr) + f90wrap_sysname = this_ptr%p%sysname +end subroutine f90wrap_basis_type__get__sysname + +subroutine f90wrap_basis_type__set__sysname(this, f90wrap_sysname) + use artemis__geom_rw, only: basis_type + implicit none + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(basis_type_ptr_type) :: this_ptr + character(128), intent(in) :: f90wrap_sysname + + this_ptr = transfer(this, this_ptr) + this_ptr%p%sysname = f90wrap_sysname +end subroutine f90wrap_basis_type__set__sysname + +subroutine f90wrap_geom_rw__basis_type_initialise(this) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_geom_rw__basis_type_initialise + +subroutine f90wrap_geom_rw__basis_type_finalise(this) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_geom_rw__basis_type_finalise + + + + + +subroutine f90wrap_basis_type_xnum_array__array_getitem__items( & + this, f90wrap_i, itemsitem) + use artemis__geom_rw, only: basis_type + implicit none + + 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 basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in), dimension(2) :: this + type(basis_type_xnum_array_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(out) :: itemsitem(2) + type(basis_type_ptr_type) :: items_ptr + + this_ptr = transfer(this, this_ptr) + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%items)) then + call f90wrap_abort("array index out of range") + else + items_ptr%p => this_ptr%p%items(f90wrap_i) + itemsitem = transfer(items_ptr,itemsitem) + endif +end subroutine f90wrap_basis_type_xnum_array__array_getitem__items + +subroutine f90wrap_basis_type_xnum_array__array_setitem__items(this, f90wrap_i, itemsitem) + use artemis__geom_rw, only: basis_type + implicit none + + 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 basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in), dimension(2) :: this + type(basis_type_xnum_array_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(out) :: itemsitem(2) + type(basis_type_ptr_type) :: items_ptr + + this_ptr = transfer(this, this_ptr) + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%items)) then + call f90wrap_abort("array index out of range") + else + items_ptr = transfer(itemsitem,items_ptr) + this_ptr%p%items(f90wrap_i) = items_ptr%p + endif +end subroutine f90wrap_basis_type_xnum_array__array_setitem__items + +subroutine f90wrap_basis_type_xnum_array__array_len__items(this, f90wrap_n) + use artemis__geom_rw, only: basis_type + implicit none + + 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 + integer, intent(in), dimension(2) :: this + type(basis_type_xnum_array_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_n + this_ptr = transfer(this, this_ptr) + f90wrap_n = size(this_ptr%p%items) +end subroutine f90wrap_basis_type_xnum_array__array_len__items + +subroutine f90wrap_basis_type_xnum_array__array_alloc__items(this, num) + use artemis__geom_rw, only: basis_type + implicit none + + 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(basis_type_xnum_array_ptr_type) :: this_ptr + integer, intent(in) :: num + integer, intent(inout), dimension(2) :: this + + this_ptr = transfer(this, this_ptr) + allocate(this_ptr%p%items(num)) + this = transfer(this_ptr, this) +end subroutine f90wrap_basis_type_xnum_array__array_alloc__items + +subroutine f90wrap_basis_type_xnum_array__array_dealloc__items(this) + use artemis__geom_rw, only: basis_type + implicit none + + 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(basis_type_xnum_array_ptr_type) :: this_ptr + integer, intent(inout), dimension(2) :: this + + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p%items) + this = transfer(this_ptr, this) +end subroutine f90wrap_basis_type_xnum_array__array_dealloc__items + +subroutine f90wrap_geom_rw__basis_type_xnum_array_initialise(this) + use artemis__geom_rw, only: basis_type + implicit none + + 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(basis_type_xnum_array_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_geom_rw__basis_type_xnum_array_initialise + +subroutine f90wrap_geom_rw__basis_type_xnum_array_finalise(this) + use artemis__geom_rw, only: basis_type + implicit none + + 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(basis_type_xnum_array_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_geom_rw__basis_type_xnum_array_finalise + + + + +subroutine f90wrap_geom_rw__allocate_species__binding__basis_type( & + this, num_species, species_symbols, species_count, atoms, n0, & + n1, n2, n3) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in), optional :: num_species + character(3), intent(in), optional, dimension(n0) :: species_symbols + integer, intent(in), optional, dimension(n1) :: species_count + real(4), intent(in), optional, dimension(n2,n3) :: atoms + integer :: n0 + !f2py intent(hide), depend(species_symbols) :: n0 = shape(species_symbols,0) + integer :: n1 + !f2py intent(hide), depend(species_count) :: n1 = shape(species_count,0) + integer :: n2 + !f2py intent(hide), depend(atoms) :: n2 = shape(atoms,0) + integer :: n3 + !f2py intent(hide), depend(atoms) :: n3 = shape(atoms,1) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%allocate_species( & + num_species=num_species, & + species_symbols=species_symbols, & + species_count=species_count, & + atoms=atoms & + ) +end subroutine f90wrap_geom_rw__allocate_species__binding__basis_type + +subroutine f90wrap_geom_rw__convert__binding__basis_type(this) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%convert() +end subroutine f90wrap_geom_rw__convert__binding__basis_type + +subroutine f90wrap_geom_rw__change_lattice__binding__basis_type(this, lattice) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(3,3), intent(in) :: lattice + this_ptr = transfer(this, this_ptr) + call this_ptr%p%change_lattice(lattice=lattice) +end subroutine f90wrap_geom_rw__change_lattice__binding__basis_type + +subroutine f90wrap_geom_rw__normalise__binding__basis_type(this, ceil_val, floor_coords, round_coords, & + zero_round) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), intent(in), optional :: ceil_val + logical, intent(in), optional :: floor_coords + logical, intent(in), optional :: round_coords + real(4), intent(in), optional :: zero_round + this_ptr = transfer(this, this_ptr) + call this_ptr%p%normalise(ceil_val=ceil_val, floor_coords=floor_coords, round_coords=round_coords, & + zero_round=zero_round) +end subroutine f90wrap_geom_rw__normalise__binding__basis_type + +subroutine f90wrap_geom_rw__copy__binding__basis_type(this, basis, length) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_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, intent(in), optional :: length + this_ptr = transfer(this, this_ptr) + basis_ptr = transfer(basis, basis_ptr) + call this_ptr%p%copy(basis=basis_ptr%p, length=length) +end subroutine f90wrap_geom_rw__copy__binding__basis_type + +subroutine f90wrap_geom_rw__get_lattice_constants__binding__basis_type(this, ret_output, radians) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(2,3), intent(out) :: ret_output + logical, intent(in), optional :: radians + this_ptr = transfer(this, this_ptr) + ret_output = this_ptr%p%get_lattice_constants(radians=radians) +end subroutine f90wrap_geom_rw__get_lattice_constants__binding__basis_type + +subroutine f90wrap_geom_rw__remove_atom__binding__basis_type(this, ispec, iatom) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in) :: ispec + integer, intent(in) :: iatom + this_ptr = transfer(this, this_ptr) + call this_ptr%p%remove_atom(ispec=ispec, iatom=iatom) +end subroutine f90wrap_geom_rw__remove_atom__binding__basis_type + +subroutine f90wrap_geom_rw__remove_atoms__binding__basis_type(this, atoms, n0, n1) + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(basis_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in), dimension(n0,n1) :: atoms + integer :: n0 + !f2py intent(hide), depend(atoms) :: n0 = shape(atoms,0) + integer :: n1 + !f2py intent(hide), depend(atoms) :: n1 = shape(atoms,1) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%remove_atoms(atoms=atoms) +end subroutine f90wrap_geom_rw__remove_atoms__binding__basis_type + +subroutine f90wrap_geom_rw__geom_read(unit, basis, length, iostat) + use artemis__geom_rw, only: geom_read, basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: unit + type(basis_type_ptr_type) :: basis_ptr + integer, intent(out), dimension(2) :: basis + integer, optional, intent(in) :: length + integer, optional, intent(inout) :: iostat + allocate(basis_ptr%p) + call geom_read(UNIT=unit, basis=basis_ptr%p, length=length, iostat=iostat) + basis = transfer(basis_ptr, basis) +end subroutine f90wrap_geom_rw__geom_read + +subroutine f90wrap_geom_rw__geom_write(unit, basis) + use artemis__geom_rw, only: geom_write, basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: unit + type(basis_type_ptr_type) :: basis_ptr + integer, intent(in), dimension(2) :: basis + basis_ptr = transfer(basis, basis_ptr) + call geom_write(UNIT=unit, basis=basis_ptr%p) +end subroutine f90wrap_geom_rw__geom_write + +subroutine f90wrap_geom_rw__get_element_properties(element, charge, mass, radius) + use artemis__geom_rw, only: get_element_properties + implicit none + + character(3), intent(in) :: element + real(4), optional, intent(inout) :: charge + real(4), optional, intent(inout) :: mass + real(4), optional, intent(inout) :: radius + call get_element_properties( & + element=element, & + charge=charge, & + mass=mass, & + radius=radius & + ) +end subroutine f90wrap_geom_rw__get_element_properties + +subroutine f90wrap_geom_rw__get__igeom_input(f90wrap_igeom_input) + use artemis__geom_rw, only: artemis__geom_rw_igeom_input => igeom_input + implicit none + integer, intent(out) :: f90wrap_igeom_input + + f90wrap_igeom_input = artemis__geom_rw_igeom_input +end subroutine f90wrap_geom_rw__get__igeom_input + +subroutine f90wrap_geom_rw__set__igeom_input(f90wrap_igeom_input) + use artemis__geom_rw, only: artemis__geom_rw_igeom_input => igeom_input + implicit none + integer, intent(in) :: f90wrap_igeom_input + + artemis__geom_rw_igeom_input = f90wrap_igeom_input +end subroutine f90wrap_geom_rw__set__igeom_input + +subroutine f90wrap_geom_rw__get__igeom_output(f90wrap_igeom_output) + use artemis__geom_rw, only: artemis__geom_rw_igeom_output => igeom_output + implicit none + integer, intent(out) :: f90wrap_igeom_output + + f90wrap_igeom_output = artemis__geom_rw_igeom_output +end subroutine f90wrap_geom_rw__get__igeom_output + +subroutine f90wrap_geom_rw__set__igeom_output(f90wrap_igeom_output) + use artemis__geom_rw, only: artemis__geom_rw_igeom_output => igeom_output + implicit none + integer, intent(in) :: f90wrap_igeom_output + + artemis__geom_rw_igeom_output = f90wrap_igeom_output +end subroutine f90wrap_geom_rw__set__igeom_output + +! End of module artemis__geom_rw defined in file ../src/lib/mod_geom_rw.f90 + diff --git a/src/wrapper/f90wrap_mod_intf_generator.f90 b/src/wrapper/f90wrap_mod_intf_generator.f90 new file mode 100644 index 0000000..77eea3b --- /dev/null +++ b/src/wrapper/f90wrap_mod_intf_generator.f90 @@ -0,0 +1,726 @@ +! Module artemis__interface_generator defined in file ../src/fortran/lib/mod_intf_generator.f90 + +subroutine f90wrap_artemis_interface_generator_type__get__shift_method(this, f90wrap_shift_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_shift_method + + this_ptr = transfer(this, this_ptr) + f90wrap_shift_method = this_ptr%p%shift_method +end subroutine f90wrap_artemis_interface_generator_type__get__shift_method + +subroutine f90wrap_artemis_interface_generator_type__set__shift_method(this, f90wrap_shift_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_shift_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%shift_method = f90wrap_shift_method +end subroutine f90wrap_artemis_interface_generator_type__set__shift_method + +subroutine f90wrap_artemis_interface_generator_type__get__num_shifts(this, f90wrap_num_shifts) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_shifts + + this_ptr = transfer(this, this_ptr) + f90wrap_num_shifts = this_ptr%p%num_shifts +end subroutine f90wrap_artemis_interface_generator_type__get__num_shifts + +subroutine f90wrap_artemis_interface_generator_type__set__num_shifts(this, f90wrap_num_shifts) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_shifts + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_shifts = f90wrap_num_shifts +end subroutine f90wrap_artemis_interface_generator_type__set__num_shifts + +subroutine f90wrap_artemis_interface_generator_type__array__shifts(this, nd, dtype, dshape, dloc) + use artemis__interface_generator, only: artemis_interface_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_interface_generator_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%shifts)) then + dshape(1:2) = shape(this_ptr%p%shifts) + dloc = loc(this_ptr%p%shifts) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_interface_generator_type__array__shifts + +subroutine f90wrap_artemis_interface_generator_type__get__interface_depth(this, f90wrap_interface_depth) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_interface_depth + + this_ptr = transfer(this, this_ptr) + f90wrap_interface_depth = this_ptr%p%interface_depth +end subroutine f90wrap_artemis_interface_generator_type__get__interface_depth + +subroutine f90wrap_artemis_interface_generator_type__set__interface_depth(this, f90wrap_interface_depth) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_interface_depth + + this_ptr = transfer(this, this_ptr) + this_ptr%p%interface_depth = f90wrap_interface_depth +end subroutine f90wrap_artemis_interface_generator_type__set__interface_depth + +subroutine f90wrap_artemis_interface_generator_type__get__separation_scale(this, f90wrap_separation_scale) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_separation_scale + + this_ptr = transfer(this, this_ptr) + f90wrap_separation_scale = this_ptr%p%separation_scale +end subroutine f90wrap_artemis_interface_generator_type__get__separation_scale + +subroutine f90wrap_artemis_interface_generator_type__set__separation_scale(this, f90wrap_separation_scale) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_separation_scale + + this_ptr = transfer(this, this_ptr) + this_ptr%p%separation_scale = f90wrap_separation_scale +end subroutine f90wrap_artemis_interface_generator_type__set__separation_scale + +subroutine f90wrap_artemis_interface_generator_type__get__depth_method(this, f90wrap_depth_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_depth_method + + this_ptr = transfer(this, this_ptr) + f90wrap_depth_method = this_ptr%p%depth_method +end subroutine f90wrap_artemis_interface_generator_type__get__depth_method + +subroutine f90wrap_artemis_interface_generator_type__set__depth_method(this, f90wrap_depth_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_depth_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%depth_method = f90wrap_depth_method +end subroutine f90wrap_artemis_interface_generator_type__set__depth_method + +subroutine f90wrap_artemis_interface_generator_type__array__shift_data(this, nd, dtype, dshape, dloc) + use artemis__interface_generator, only: artemis_interface_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_interface_generator_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%shift_data)) then + dshape(1:2) = shape(this_ptr%p%shift_data) + dloc = loc(this_ptr%p%shift_data) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_interface_generator_type__array__shift_data + +subroutine f90wrap_artemis_interface_generator_type__get__swap_method(this, f90wrap_swap_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_swap_method + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_method = this_ptr%p%swap_method +end subroutine f90wrap_artemis_interface_generator_type__get__swap_method + +subroutine f90wrap_artemis_interface_generator_type__set__swap_method(this, f90wrap_swap_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_swap_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_method = f90wrap_swap_method +end subroutine f90wrap_artemis_interface_generator_type__set__swap_method + +subroutine f90wrap_artemis_interface_generator_type__get__num_swaps(this, f90wrap_num_swaps) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_swaps + + this_ptr = transfer(this, this_ptr) + f90wrap_num_swaps = this_ptr%p%num_swaps +end subroutine f90wrap_artemis_interface_generator_type__get__num_swaps + +subroutine f90wrap_artemis_interface_generator_type__set__num_swaps(this, f90wrap_num_swaps) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_swaps + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_swaps = f90wrap_num_swaps +end subroutine f90wrap_artemis_interface_generator_type__set__num_swaps + +subroutine f90wrap_artemis_interface_generator_type__get__swap_density(this, f90wrap_swap_density) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_swap_density + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_density = this_ptr%p%swap_density +end subroutine f90wrap_artemis_interface_generator_type__get__swap_density + +subroutine f90wrap_artemis_interface_generator_type__set__swap_density(this, f90wrap_swap_density) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_swap_density + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_density = f90wrap_swap_density +end subroutine f90wrap_artemis_interface_generator_type__set__swap_density + +subroutine f90wrap_artemis_interface_generator_type__get__swap_depth(this, f90wrap_swap_depth) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_swap_depth + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_depth = this_ptr%p%swap_depth +end subroutine f90wrap_artemis_interface_generator_type__get__swap_depth + +subroutine f90wrap_artemis_interface_generator_type__set__swap_depth(this, f90wrap_swap_depth) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_swap_depth + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_depth = f90wrap_swap_depth +end subroutine f90wrap_artemis_interface_generator_type__set__swap_depth + +subroutine f90wrap_artemis_interface_generator_type__get__swap_sigma(this, f90wrap_swap_sigma) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_swap_sigma + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_sigma = this_ptr%p%swap_sigma +end subroutine f90wrap_artemis_interface_generator_type__get__swap_sigma + +subroutine f90wrap_artemis_interface_generator_type__set__swap_sigma(this, f90wrap_swap_sigma) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_swap_sigma + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_sigma = f90wrap_swap_sigma +end subroutine f90wrap_artemis_interface_generator_type__set__swap_sigma + +subroutine f90wrap_artemis_interface_generator_type__get__require_mirr41cf( & + this, f90wrap_require_mirror_swaps) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_require_mirror_swaps + + this_ptr = transfer(this, this_ptr) + f90wrap_require_mirror_swaps = this_ptr%p%require_mirror_swaps +end subroutine f90wrap_artemis_interface_generator_type__get__require_mirr41cf + +subroutine f90wrap_artemis_interface_generator_type__set__require_mirr3bfa( & + this, f90wrap_require_mirror_swaps) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_require_mirror_swaps + + this_ptr = transfer(this, this_ptr) + this_ptr%p%require_mirror_swaps = f90wrap_require_mirror_swaps +end subroutine f90wrap_artemis_interface_generator_type__set__require_mirr3bfa + +subroutine f90wrap_artemis_interface_generator_type__get__match_method(this, f90wrap_match_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_match_method + + this_ptr = transfer(this, this_ptr) + f90wrap_match_method = this_ptr%p%match_method +end subroutine f90wrap_artemis_interface_generator_type__get__match_method + +subroutine f90wrap_artemis_interface_generator_type__set__match_method(this, f90wrap_match_method) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_match_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%match_method = f90wrap_match_method +end subroutine f90wrap_artemis_interface_generator_type__set__match_method + +subroutine f90wrap_artemis_interface_generator_type__get__max_num_matches(this, f90wrap_max_num_matches) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_matches + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_matches = this_ptr%p%max_num_matches +end subroutine f90wrap_artemis_interface_generator_type__get__max_num_matches + +subroutine f90wrap_artemis_interface_generator_type__set__max_num_matches(this, f90wrap_max_num_matches) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_matches + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_matches = f90wrap_max_num_matches +end subroutine f90wrap_artemis_interface_generator_type__set__max_num_matches + +subroutine f90wrap_artemis_interface_generator_type__get__max_num_terms(this, f90wrap_max_num_terms) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_terms + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_terms = this_ptr%p%max_num_terms +end subroutine f90wrap_artemis_interface_generator_type__get__max_num_terms + +subroutine f90wrap_artemis_interface_generator_type__set__max_num_terms(this, f90wrap_max_num_terms) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_terms + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_terms = f90wrap_max_num_terms +end subroutine f90wrap_artemis_interface_generator_type__set__max_num_terms + +subroutine f90wrap_artemis_interface_generator_type__get__max_num_planes(this, f90wrap_max_num_planes) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_planes + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_planes = this_ptr%p%max_num_planes +end subroutine f90wrap_artemis_interface_generator_type__get__max_num_planes + +subroutine f90wrap_artemis_interface_generator_type__set__max_num_planes(this, f90wrap_max_num_planes) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_planes + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_planes = f90wrap_max_num_planes +end subroutine f90wrap_artemis_interface_generator_type__set__max_num_planes + +subroutine f90wrap_artemis_interface_generator_type__get__fix_normal(this, f90wrap_fix_normal) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_fix_normal + + this_ptr = transfer(this, this_ptr) + f90wrap_fix_normal = this_ptr%p%fix_normal +end subroutine f90wrap_artemis_interface_generator_type__get__fix_normal + +subroutine f90wrap_artemis_interface_generator_type__set__fix_normal(this, f90wrap_fix_normal) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_fix_normal + + this_ptr = transfer(this, this_ptr) + this_ptr%p%fix_normal = f90wrap_fix_normal +end subroutine f90wrap_artemis_interface_generator_type__set__fix_normal + +subroutine f90wrap_artemis_interface_generator_type__get__bondlength_c21a8(this, f90wrap_bondlength_cutoff) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_bondlength_cutoff + + this_ptr = transfer(this, this_ptr) + f90wrap_bondlength_cutoff = this_ptr%p%bondlength_cutoff +end subroutine f90wrap_artemis_interface_generator_type__get__bondlength_c21a8 + +subroutine f90wrap_artemis_interface_generator_type__set__bondlength_cbd11(this, f90wrap_bondlength_cutoff) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_bondlength_cutoff + + this_ptr = transfer(this, this_ptr) + this_ptr%p%bondlength_cutoff = f90wrap_bondlength_cutoff +end subroutine f90wrap_artemis_interface_generator_type__set__bondlength_cbd11 + +subroutine f90wrap_artemis_interface_generator_type__array__layer_sepa90a5(this, nd, dtype, dshape, dloc) + use artemis__interface_generator, only: artemis_interface_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_interface_generator_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%layer_separation_cutoff) + dloc = loc(this_ptr%p%layer_separation_cutoff) +end subroutine f90wrap_artemis_interface_generator_type__array__layer_sepa90a5 + +subroutine f90wrap_intf_gen__artemis_interface_gen0ea8(this) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_intf_gen__artemis_interface_gen0ea8 + +subroutine f90wrap_intf_gen__artemis_interface_genbc51(this) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_intf_gen__artemis_interface_genbc51 + +subroutine f90wrap_intf_gen__set_tolerance__bindinfd58(this, vector_mismatch, angle_mismatch, & + area_mismatch, max_length, max_area, max_fit, max_extension, angle_weight, area_weight) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), intent(in), optional :: vector_mismatch + real(4), intent(in), optional :: angle_mismatch + real(4), intent(in), optional :: area_mismatch + real(4), intent(in), optional :: max_length + real(4), intent(in), optional :: max_area + integer, intent(in), optional :: max_fit + integer, intent(in), optional :: max_extension + real(4), intent(in), optional :: angle_weight + real(4), intent(in), optional :: area_weight + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_tolerance( & + vector_mismatch=vector_mismatch, & + angle_mismatch=angle_mismatch, & + area_mismatch=area_mismatch, max_length=max_length, & + max_area=max_area, max_fit=max_fit, max_extension=max_extension, & + angle_weight=angle_weight, area_weight=area_weight) +end subroutine f90wrap_intf_gen__set_tolerance__bindinfd58 + +subroutine f90wrap_intf_gen__set_shift_method__bin4dc1(this, method, num_shifts, shifts, & + interface_depth, separation_scale, depth_method, n0) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in), optional :: method + integer, intent(in), optional :: num_shifts + real(4), dimension(n0), intent(in), optional :: shifts + real(4), intent(in), optional :: interface_depth + real(4), intent(in), optional :: separation_scale + integer, intent(in), optional :: depth_method + integer :: n0 + !f2py intent(hide), depend(shifts) :: n0 = shape(shifts,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_shift_method( & + method=method, num_shifts=num_shifts, & + shifts=shifts, interface_depth=interface_depth, & + separation_scale=separation_scale, depth_method=depth_method) +end subroutine f90wrap_intf_gen__set_shift_method__bin4dc1 + +subroutine f90wrap_intf_gen__generate__binding__ar04c1( & + this, basis_lw, basis_up, miller_lw, & + miller_up, surface_lw, surface_up, & + thickness_lw, thickness_up, & + num_layers_lw, num_layers_up, & + use_pricel_lw, use_pricel_up, & + is_layered_lw, is_layered_up, & + elastic_constants_lw, elastic_constants_up, & + print_lattice_match_info, print_termination_info, print_shift_info, & + break_on_fail, icheck_match, interface_idx, generate_structures, seed, n0, & + n1, n2, n3) + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_ptr_type) :: basis_lw_ptr + integer, intent(in), dimension(2) :: basis_lw + type(basis_type_ptr_type) :: basis_up_ptr + integer, intent(in), dimension(2) :: basis_up + integer, intent(in), optional, dimension(3) :: miller_lw + integer, intent(in), optional, dimension(3) :: miller_up + integer, intent(in), optional, dimension(n0) :: surface_lw + integer, intent(in), optional, dimension(n1) :: surface_up + real(4), intent(in), optional :: thickness_lw + real(4), intent(in), optional :: thickness_up + integer, intent(in), optional :: num_layers_lw + integer, intent(in), optional :: num_layers_up + logical, intent(in), optional :: use_pricel_lw + logical, intent(in), optional :: use_pricel_up + logical, intent(in), optional :: is_layered_lw + logical, intent(in), optional :: is_layered_up + real(4), intent(in), optional, dimension(n2) :: elastic_constants_lw + real(4), intent(in), optional, dimension(n3) :: elastic_constants_up + logical, intent(in), optional :: print_lattice_match_info + logical, intent(in), optional :: print_termination_info + logical, intent(in), optional :: print_shift_info + logical, intent(in), optional :: break_on_fail + integer, intent(in), optional :: icheck_match + integer, intent(in), optional :: interface_idx + logical, intent(in), optional :: generate_structures + integer, intent(in), optional :: seed + integer :: n0 + !f2py intent(hide), depend(surface_lw) :: n0 = shape(surface_lw,0) + integer :: n1 + !f2py intent(hide), depend(surface_up) :: n1 = shape(surface_up,0) + integer :: n2 + !f2py intent(hide), depend(elastic_constants_lw) :: n2 = shape(elastic_constants_lw,0) + integer :: n3 + !f2py intent(hide), depend(elastic_constants_up) :: n3 = shape(elastic_constants_up,0) + this_ptr = transfer(this, this_ptr) + basis_lw_ptr = transfer(basis_lw, basis_lw_ptr) + basis_up_ptr = transfer(basis_up, basis_up_ptr) + call this_ptr%p%generate(basis_lw=basis_lw_ptr%p, basis_up=basis_up_ptr%p, miller_lw=miller_lw, miller_up=miller_up, & + surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, thickness_up=thickness_up, & + num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, use_pricel_lw=use_pricel_lw, use_pricel_up=use_pricel_up, & + is_layered_lw=is_layered_lw, is_layered_up=is_layered_up, elastic_constants_lw=elastic_constants_lw, & + elastic_constants_up=elastic_constants_up, print_lattice_match_info=print_lattice_match_info, & + print_termination_info=print_termination_info, print_shift_info=print_shift_info, break_on_fail=break_on_fail, & + icheck_match=icheck_match, interface_idx=interface_idx, generate_structures=generate_structures, seed=seed) +end subroutine f90wrap_intf_gen__generate__binding__ar04c1 + +subroutine f90wrap_intf_gen__restart__binding__artdb00(this, basis, interface_location, & + print_shift_info, seed) + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_ptr_type) :: basis_ptr + integer, intent(in), dimension(2) :: basis + real(4), dimension(2), intent(in), optional :: interface_location + logical, intent(in), optional :: print_shift_info + integer, intent(in), optional :: seed + this_ptr = transfer(this, this_ptr) + basis_ptr = transfer(basis, basis_ptr) + call this_ptr%p%restart(basis=basis_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & + seed=seed) +end subroutine f90wrap_intf_gen__restart__binding__artdb00 + +! End of module artemis__interface_generator defined in file ../src/fortran/lib/mod_intf_generator.f90 + diff --git a/src/wrapper/f90wrap_mod_term_generator.f90 b/src/wrapper/f90wrap_mod_term_generator.f90 new file mode 100644 index 0000000..caf22b1 --- /dev/null +++ b/src/wrapper/f90wrap_mod_term_generator.f90 @@ -0,0 +1,91 @@ +! Module artemis__termination_generator defined in file ../src/fortran/lib/mod_term_generator.f90 + +subroutine f90wrap_artemis_termination_generator_type__get__layer_sepace78(this, f90wrap_layer_separation_cutoff) + use artemis__termination_generator, only: artemis_termination_generator_type + implicit none + type artemis_termination_generator_type_ptr_type + type(artemis_termination_generator_type), pointer :: p => NULL() + end type artemis_termination_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_termination_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_layer_separation_cutoff + + this_ptr = transfer(this, this_ptr) + f90wrap_layer_separation_cutoff = this_ptr%p%layer_separation_cutoff +end subroutine f90wrap_artemis_termination_generator_type__get__layer_sepace78 + +subroutine f90wrap_artemis_termination_generator_type__set__layer_sepae7ef(this, f90wrap_layer_separation_cutoff) + use artemis__termination_generator, only: artemis_termination_generator_type + implicit none + type artemis_termination_generator_type_ptr_type + type(artemis_termination_generator_type), pointer :: p => NULL() + end type artemis_termination_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_termination_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_layer_separation_cutoff + + this_ptr = transfer(this, this_ptr) + this_ptr%p%layer_separation_cutoff = f90wrap_layer_separation_cutoff +end subroutine f90wrap_artemis_termination_generator_type__set__layer_sepae7ef + +subroutine f90wrap_term_gen__artemis_termination293d(this) + use artemis__termination_generator, only: artemis_termination_generator_type + implicit none + + type artemis_termination_generator_type_ptr_type + type(artemis_termination_generator_type), pointer :: p => NULL() + end type artemis_termination_generator_type_ptr_type + type(artemis_termination_generator_type_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_term_gen__artemis_termination293d + +subroutine f90wrap_term_gen__artemis_terminationdf16(this) + use artemis__termination_generator, only: artemis_termination_generator_type + implicit none + + type artemis_termination_generator_type_ptr_type + type(artemis_termination_generator_type), pointer :: p => NULL() + end type artemis_termination_generator_type_ptr_type + type(artemis_termination_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_term_gen__artemis_terminationdf16 + +subroutine f90wrap_term_gen__generate__binding__2af7(this, basis, miller_plane, axis, surface, & + num_layers, thickness, orthogonalise, normalise, break_on_fail, n0) + use artemis__termination_generator, only: artemis_termination_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_termination_generator_type_ptr_type + type(artemis_termination_generator_type), pointer :: p => NULL() + end type artemis_termination_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type(artemis_termination_generator_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) :: miller_plane + integer, intent(in) :: axis + integer, intent(in), optional, dimension(n0) :: surface + integer, intent(in), optional :: num_layers + real(4), intent(in), optional :: thickness + logical, intent(in), optional :: orthogonalise + logical, intent(in), optional :: normalise + logical, intent(in), optional :: break_on_fail + integer :: n0 + !f2py intent(hide), depend(surface) :: n0 = shape(surface,0) + this_ptr = transfer(this, this_ptr) + basis_ptr = transfer(basis, basis_ptr) + call this_ptr%p%generate(basis=basis_ptr%p, miller_plane=miller_plane, axis=axis, surface=surface, & + num_layers=num_layers, thickness=thickness, orthogonalise=orthogonalise, normalise=normalise, & + break_on_fail=break_on_fail) +end subroutine f90wrap_term_gen__generate__binding__2af7 + +! End of module artemis__termination_generator defined in file ../src/fortran/lib/mod_term_generator.f90 + From 0a97a80521e31ab6bd8c199a553daf903bf8d016 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 09:18:24 +0100 Subject: [PATCH 057/137] Americanise --- LICENCE => LICENSE | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename LICENCE => LICENSE (100%) diff --git a/LICENCE b/LICENSE similarity index 100% rename from LICENCE rename to LICENSE From d2edc9faf0776434e56f9d24900467dab02733a5 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 09:21:48 +0100 Subject: [PATCH 058/137] Update tools --- src/fortran/lib/mod_io_utils.F90 | 9 ++++---- tools/compress.sh | 35 -------------------------------- tools/version_number.py | 28 +++++++++++++++++++++++++ 3 files changed, 33 insertions(+), 39 deletions(-) delete mode 100755 tools/compress.sh create mode 100644 tools/version_number.py diff --git a/src/fortran/lib/mod_io_utils.F90 b/src/fortran/lib/mod_io_utils.F90 index 1e787a2..bc341ba 100644 --- a/src/fortran/lib/mod_io_utils.F90 +++ b/src/fortran/lib/mod_io_utils.F90 @@ -8,19 +8,20 @@ module artemis__io_utils use artemis__constants, only: real32 use artemis__misc implicit none - logical :: test_error_handling = .false. - - logical :: suppress_warnings = .false. + private public :: write_fmtd public :: err_abort,print_warning, stop_program public :: io_print_help public :: print_header + public :: artemis__version__ - character(25), public, parameter :: artemis__version__="development version 1.0.2a" + logical :: test_error_handling = .false. + logical :: suppress_warnings = .false. + character(len=*), parameter :: artemis__version__ = "2.0.0" !character(30), public, parameter :: & ! author(3) = [& ! "N. T. Taylor",& diff --git a/tools/compress.sh b/tools/compress.sh deleted file mode 100755 index 3caaf71..0000000 --- a/tools/compress.sh +++ /dev/null @@ -1,35 +0,0 @@ -#!/bin/bash -#executing this tars up the code directory. - -OS=$(uname) -case "$OS" in - "Darwin") - echo "OS: Darwin, MacOS" - scriptdir="$(pwd "$(dirname "${BASH_SOURCE[0]}")")/" - codedir=$(sed 's|tools/||' <<<"$scriptdir") - tarname=$(sed 's|/$||;s|.*/D||' <<<"$codedir")".tar.gz" - ;; - "Linux") - echo "OS: Linux" - scriptdir="$(readlink -f "$(dirname "${BASH_SOURCE[0]}")")/" - codedir=$(sed 's|tools/||' <<<"$scriptdir") - tarname=$(sed 's|/$||;s|.*/D\?||' <<<"$codedir")".tar.gz" - ;; - *) - echo "Operating system ($OS) could not be defined" - exit 1 -esac - -#scriptdir="$(readlink -f "$(dirname "${BASH_SOURCE[0]}")")/" -#codedir=$(sed 's|tools/||' <<<"$scriptdir") -codeend=$(sed 's|/.*/\(.*\)/|\1|' <<<"$codedir") -tardir=$(sed 's|/$||;s|\(.*/\).*|\1|' <<<"$codedir") -tarpath="$tardir$tarname" - -#cd $codedir - -#echo "tar -czvf $tarpath -C $tardir $codeend" -#tar --exclude-backups -czvf $tarpath -C $tardir $codeend #$scriptdir -tar --exclude="*#" --exclude="*.#*" --exclude="*~" --exclude="TODO" --exclude="OLD_*" --exclude="*.aux" --exclude="*.log" --exclude="*.out" --exclude="*.toc" --exclude="*.txt" --exclude="${codeend}/bin" --exclude="*.tar.gz" --exclude="${codeend}/src/archive" --exclude="${codeend}/obj" --exclude="${codeend}/.git" --exclude="*.gitignore" -czvf $tarpath -C $tardir $codeend -mv $tarpath ../. -echo "made tar file $tarname" diff --git a/tools/version_number.py b/tools/version_number.py new file mode 100644 index 0000000..6f308ad --- /dev/null +++ b/tools/version_number.py @@ -0,0 +1,28 @@ +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 :: artemis__version__ = "\d+\.\d+\.\d+.*"', f'character(len=*), parameter :: artemis__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) + print(match.group(1)) + if match: + return match.group(1) + +if __name__ == '__main__': + update_version(get_version()) From a41f7927a2d5cef11add6116b3be38ecdb8e4bf6 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 11:52:06 +0100 Subject: [PATCH 059/137] Handle get structures in python --- src/artemis/artemis.py | 161 ++++++++---- src/fortran/lib/mod_misc_types.f90 | 18 +- src/wrapper/f90wrap_mod_intf_generator.f90 | 290 +++++++++++++++------ 3 files changed, 342 insertions(+), 127 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 99a83dd..a25f7b3 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -3,7 +3,7 @@ import f90wrap.runtime import logging import numpy - +from ase import Atoms class Geom_Rw(f90wrap.runtime.FortranModule): """ @@ -1288,6 +1288,11 @@ def generate(self, basis, miller_plane, axis, surface=None, num_layers=None, \ ... user-defined thickness --------------------------------------------------------------------------- """ + + # check if host is ase.Atoms object or a Fortran derived type basis_type + if isinstance(basis, Atoms): + basis = geom_rw.basis(atoms=basis) + _artemis.f90wrap_term_gen__generate__binding__2af7(this=self._handle, \ basis=basis._handle, miller_plane=miller_plane, axis=axis, surface=surface, \ num_layers=num_layers, thickness=thickness, orthogonalise=orthogonalise, \ @@ -1458,7 +1463,8 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ elastic_constants_lw=None, elastic_constants_up=None, \ print_lattice_match_info=None, print_termination_info=None, \ print_shift_info=None, break_on_fail=None, icheck_match=None, \ - interface_idx=None, generate_structures=None, seed=None): + interface_idx=None, generate_structures=None, seed=None, + calc=None): """ generate__binding__artemis_interface_generator_type(self, basis_lw, basis_up[, \ miller_lw, miller_up, surface_lw, surface_up, thickness_lw, thickness_up, \ @@ -1500,11 +1506,20 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ generate_structures : bool seed : int - --------------------------------------------------------------------------- - Set the random seed - --------------------------------------------------------------------------- """ - _artemis.f90wrap_intf_gen__generate__binding__ar04c1(this=self._handle, \ + + exit_code = 0 + structures = None + + # check if host is ase.Atoms object or a Fortran derived type basis_type + if isinstance(basis_lw, Atoms): + basis_lw = geom_rw.basis(atoms=basis_lw) + + if isinstance(basis_up, Atoms): + basis_up = geom_rw.basis(atoms=basis_up) + + # exit_code = ... + _artemis.f90wrap_intf_gen__generate__binding__aigt(this=self._handle, \ basis_lw=basis_lw._handle, basis_up=basis_up._handle, miller_lw=miller_lw, \ miller_up=miller_up, surface_lw=surface_lw, surface_up=surface_up, \ thickness_lw=thickness_lw, thickness_up=thickness_up, \ @@ -1519,6 +1534,9 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ icheck_match=icheck_match, interface_idx=interface_idx, \ generate_structures=generate_structures, seed=seed) + structures = self.get_structures(calc) + return structures, exit_code + def restart(self, basis, interface_location=None, print_shift_info=None, \ seed=None): """ @@ -1542,10 +1560,35 @@ def restart(self, basis, interface_location=None, print_shift_info=None, \ Set the random seed --------------------------------------------------------------------------- """ - _artemis.f90wrap_intf_gen__restart__binding__artdb00(this=self._handle, \ + _artemis.f90wrap_intf_gen__restart__binding__aigt(this=self._handle, \ basis=basis._handle, interface_location=interface_location, \ print_shift_info=print_shift_info, seed=seed) + def get_structures(self, calculator=None): + """ + Get the generated structures as a list of ASE Atoms objects. + + Parameters: + calculator (ASE calculator): + The calculator to use for the generated structures. + """ + atoms = [] + for structure in self.structures: + atoms.append(structure.toase(calculator)) + return atoms + + @property + def num_structures(self): + """ + The number of generated structures currently stored in the generator. + """ + return _artemis.f90wrap_artemis_intf_gen_type__get__num_structures(self._handle) + + @num_structures.setter + def num_structures(self, num_structures): + _raffle.f90wrap_artemis_intf_gen_type__set__num_structures(self._handle, \ + num_structures) + @property def shift_method(self): """ @@ -1558,11 +1601,11 @@ def shift_method(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__shift_method(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__shift_method(self._handle) @shift_method.setter def shift_method(self, shift_method): - _artemis.f90wrap_artemis_interface_generator_type__set__shift_method(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__shift_method(self._handle, \ shift_method) @property @@ -1577,11 +1620,11 @@ def num_shifts(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__num_shifts(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__num_shifts(self._handle) @num_shifts.setter def num_shifts(self, num_shifts): - _artemis.f90wrap_artemis_interface_generator_type__set__num_shifts(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__num_shifts(self._handle, \ num_shifts) @property @@ -1596,13 +1639,13 @@ def shifts(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__array__shifts(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__array__shifts(self._handle) if array_handle in self._arrays: shifts = self._arrays[array_handle] else: shifts = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_interface_generator_type__array__shifts) + _artemis.f90wrap_artemis_intf_gen_type__array__shifts) self._arrays[array_handle] = shifts return shifts @@ -1622,11 +1665,11 @@ def interface_depth(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__interface_depth(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__interface_depth(self._handle) @interface_depth.setter def interface_depth(self, interface_depth): - _artemis.f90wrap_artemis_interface_generator_type__set__interface_depth(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__interface_depth(self._handle, \ interface_depth) @property @@ -1641,11 +1684,11 @@ def separation_scale(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__separation_scale(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__separation_scale(self._handle) @separation_scale.setter def separation_scale(self, separation_scale): - _artemis.f90wrap_artemis_interface_generator_type__set__separation_scale(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__separation_scale(self._handle, \ separation_scale) @property @@ -1660,11 +1703,11 @@ def depth_method(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__depth_method(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__depth_method(self._handle) @depth_method.setter def depth_method(self, depth_method): - _artemis.f90wrap_artemis_interface_generator_type__set__depth_method(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__depth_method(self._handle, \ depth_method) @property @@ -1679,13 +1722,13 @@ def shift_data(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__array__shift_data(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__array__shift_data(self._handle) if array_handle in self._arrays: shift_data = self._arrays[array_handle] else: shift_data = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_interface_generator_type__array__shift_data) + _artemis.f90wrap_artemis_intf_gen_type__array__shift_data) self._arrays[array_handle] = shift_data return shift_data @@ -1705,11 +1748,11 @@ def swap_method(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__swap_method(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__swap_method(self._handle) @swap_method.setter def swap_method(self, swap_method): - _artemis.f90wrap_artemis_interface_generator_type__set__swap_method(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__swap_method(self._handle, \ swap_method) @property @@ -1724,11 +1767,11 @@ def num_swaps(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__num_swaps(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__num_swaps(self._handle) @num_swaps.setter def num_swaps(self, num_swaps): - _artemis.f90wrap_artemis_interface_generator_type__set__num_swaps(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__num_swaps(self._handle, \ num_swaps) @property @@ -1743,11 +1786,11 @@ def swap_density(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__swap_density(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__swap_density(self._handle) @swap_density.setter def swap_density(self, swap_density): - _artemis.f90wrap_artemis_interface_generator_type__set__swap_density(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__swap_density(self._handle, \ swap_density) @property @@ -1762,11 +1805,11 @@ def swap_depth(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__swap_depth(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__swap_depth(self._handle) @swap_depth.setter def swap_depth(self, swap_depth): - _artemis.f90wrap_artemis_interface_generator_type__set__swap_depth(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__swap_depth(self._handle, \ swap_depth) @property @@ -1781,11 +1824,11 @@ def swap_sigma(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__swap_sigma(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__swap_sigma(self._handle) @swap_sigma.setter def swap_sigma(self, swap_sigma): - _artemis.f90wrap_artemis_interface_generator_type__set__swap_sigma(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__swap_sigma(self._handle, \ swap_sigma) @property @@ -1800,11 +1843,11 @@ def require_mirror_swaps(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__require_mirr41cf(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__require_mirr41cf(self._handle) @require_mirror_swaps.setter def require_mirror_swaps(self, require_mirror_swaps): - _artemis.f90wrap_artemis_interface_generator_type__set__require_mirr3bfa(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__require_mirr3bfa(self._handle, \ require_mirror_swaps) @property @@ -1819,11 +1862,11 @@ def match_method(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__match_method(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__match_method(self._handle) @match_method.setter def match_method(self, match_method): - _artemis.f90wrap_artemis_interface_generator_type__set__match_method(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__match_method(self._handle, \ match_method) @property @@ -1838,11 +1881,11 @@ def max_num_matches(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__max_num_matches(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__max_num_matches(self._handle) @max_num_matches.setter def max_num_matches(self, max_num_matches): - _artemis.f90wrap_artemis_interface_generator_type__set__max_num_matches(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__max_num_matches(self._handle, \ max_num_matches) @property @@ -1857,11 +1900,11 @@ def max_num_terms(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__max_num_terms(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__max_num_terms(self._handle) @max_num_terms.setter def max_num_terms(self, max_num_terms): - _artemis.f90wrap_artemis_interface_generator_type__set__max_num_terms(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__max_num_terms(self._handle, \ max_num_terms) @property @@ -1876,11 +1919,11 @@ def max_num_planes(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__max_num_planes(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__max_num_planes(self._handle) @max_num_planes.setter def max_num_planes(self, max_num_planes): - _artemis.f90wrap_artemis_interface_generator_type__set__max_num_planes(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__max_num_planes(self._handle, \ max_num_planes) @property @@ -1895,11 +1938,11 @@ def fix_normal(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__fix_normal(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__fix_normal(self._handle) @fix_normal.setter def fix_normal(self, fix_normal): - _artemis.f90wrap_artemis_interface_generator_type__set__fix_normal(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__fix_normal(self._handle, \ fix_normal) @property @@ -1914,11 +1957,11 @@ def bondlength_cutoff(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__bondlength_c21a8(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__get__bondlength_c21a8(self._handle) @bondlength_cutoff.setter def bondlength_cutoff(self, bondlength_cutoff): - _artemis.f90wrap_artemis_interface_generator_type__set__bondlength_cbd11(self._handle, \ + _artemis.f90wrap_artemis_intf_gen_type__set__bondlength_cbd11(self._handle, \ bondlength_cutoff) @property @@ -1933,14 +1976,14 @@ def layer_separation_cutoff(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__array__layer_sepa90a5(self._handle) + _artemis.f90wrap_artemis_intf_gen_type__array__layer_sepa90a5(self._handle) if array_handle in self._arrays: layer_separation_cutoff = self._arrays[array_handle] else: layer_separation_cutoff = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_interface_generator_type__array__layer_sepa90a5) + _artemis.f90wrap_artemis_intf_gen_type__array__layer_sepa90a5) self._arrays[array_handle] = layer_separation_cutoff return layer_separation_cutoff @@ -1948,6 +1991,26 @@ def layer_separation_cutoff(self): def layer_separation_cutoff(self, layer_separation_cutoff): self.layer_separation_cutoff[...] = layer_separation_cutoff + def _init_array_structures(self): + """ + Initialise the structures array. + + It is not recommended to use this function directly. Use the `structures` property instead. + """ + self.structures = f90wrap.runtime.FortranDerivedTypeArray(self, + _artemis.f90wrap_artemis_intf_gen_type__array_getitem__structures, + _artemis.f90wrap_artemis_intf_gen_type__array_setitem__structures, + _artemis.f90wrap_artemis_intf_gen_type__array_len__structures, + """ + Element items ftype=type(basis_type) pytype=basis + + + Defined at ../src/lib/mod_generator.f90 line \ + 29 + + """, Geom_Rw.basis) + return self.structures + def __str__(self): ret = ['{\n'] ret.append(' shift_method : ') @@ -1990,10 +2053,12 @@ def __str__(self): ret.append(repr(self.bondlength_cutoff)) ret.append(',\n layer_separation_cutoff : ') ret.append(repr(self.layer_separation_cutoff)) + ret.append(',\n structures : ') + ret.append(repr(self.structures)) ret.append('}') return ''.join(ret) - _dt_array_initialisers = [] + _dt_array_initialisers = [_init_array_structures] _dt_array_initialisers = [] diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index ef22d58..d192fd7 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -53,6 +53,7 @@ module artemis__misc_types type(basis_type), dimension(:), allocatable :: structures contains procedure, pass(this) :: write_structures + procedure, pass(this) :: get_structures end type abstract_artemis_generator_type @@ -110,5 +111,20 @@ subroutine write_structures( & end subroutine write_structures !############################################################################### - + + +!############################################################################### + function get_structures(this) result(structures) + !! Get the generated structures. + implicit none + ! Arguments + class(abstract_artemis_generator_type), intent(in) :: this + !! Instance of the raffle generator. + type(basis_type), dimension(:), allocatable :: structures + !! Generated structures. + + structures = this%structures + end function get_structures +!############################################################################### + end module artemis__misc_types diff --git a/src/wrapper/f90wrap_mod_intf_generator.f90 b/src/wrapper/f90wrap_mod_intf_generator.f90 index 77eea3b..21fbf55 100644 --- a/src/wrapper/f90wrap_mod_intf_generator.f90 +++ b/src/wrapper/f90wrap_mod_intf_generator.f90 @@ -1,6 +1,20 @@ ! Module artemis__interface_generator defined in file ../src/fortran/lib/mod_intf_generator.f90 -subroutine f90wrap_artemis_interface_generator_type__get__shift_method(this, f90wrap_shift_method) +subroutine f90wrap_artemis_intf_gen_type__get__num_structures(this, f90wrap_num_structures) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_structures + + this_ptr = transfer(this, this_ptr) + f90wrap_num_structures = this_ptr%p%num_structures +end subroutine f90wrap_artemis_intf_gen_type__get__num_structures + +subroutine f90wrap_artemis_intf_gen_type__get__shift_method(this, f90wrap_shift_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -12,9 +26,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__shift_method(this, f90 this_ptr = transfer(this, this_ptr) f90wrap_shift_method = this_ptr%p%shift_method -end subroutine f90wrap_artemis_interface_generator_type__get__shift_method +end subroutine f90wrap_artemis_intf_gen_type__get__shift_method -subroutine f90wrap_artemis_interface_generator_type__set__shift_method(this, f90wrap_shift_method) +subroutine f90wrap_artemis_intf_gen_type__set__shift_method(this, f90wrap_shift_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -26,9 +40,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__shift_method(this, f90 this_ptr = transfer(this, this_ptr) this_ptr%p%shift_method = f90wrap_shift_method -end subroutine f90wrap_artemis_interface_generator_type__set__shift_method +end subroutine f90wrap_artemis_intf_gen_type__set__shift_method -subroutine f90wrap_artemis_interface_generator_type__get__num_shifts(this, f90wrap_num_shifts) +subroutine f90wrap_artemis_intf_gen_type__get__num_shifts(this, f90wrap_num_shifts) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -40,9 +54,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__num_shifts(this, f90wr this_ptr = transfer(this, this_ptr) f90wrap_num_shifts = this_ptr%p%num_shifts -end subroutine f90wrap_artemis_interface_generator_type__get__num_shifts +end subroutine f90wrap_artemis_intf_gen_type__get__num_shifts -subroutine f90wrap_artemis_interface_generator_type__set__num_shifts(this, f90wrap_num_shifts) +subroutine f90wrap_artemis_intf_gen_type__set__num_shifts(this, f90wrap_num_shifts) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -54,9 +68,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__num_shifts(this, f90wr this_ptr = transfer(this, this_ptr) this_ptr%p%num_shifts = f90wrap_num_shifts -end subroutine f90wrap_artemis_interface_generator_type__set__num_shifts +end subroutine f90wrap_artemis_intf_gen_type__set__num_shifts -subroutine f90wrap_artemis_interface_generator_type__array__shifts(this, nd, dtype, dshape, dloc) +subroutine f90wrap_artemis_intf_gen_type__array__shifts(this, nd, dtype, dshape, dloc) use artemis__interface_generator, only: artemis_interface_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none @@ -79,9 +93,9 @@ subroutine f90wrap_artemis_interface_generator_type__array__shifts(this, nd, dty else dloc = 0 end if -end subroutine f90wrap_artemis_interface_generator_type__array__shifts +end subroutine f90wrap_artemis_intf_gen_type__array__shifts -subroutine f90wrap_artemis_interface_generator_type__get__interface_depth(this, f90wrap_interface_depth) +subroutine f90wrap_artemis_intf_gen_type__get__interface_depth(this, f90wrap_interface_depth) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -93,9 +107,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__interface_depth(this, this_ptr = transfer(this, this_ptr) f90wrap_interface_depth = this_ptr%p%interface_depth -end subroutine f90wrap_artemis_interface_generator_type__get__interface_depth +end subroutine f90wrap_artemis_intf_gen_type__get__interface_depth -subroutine f90wrap_artemis_interface_generator_type__set__interface_depth(this, f90wrap_interface_depth) +subroutine f90wrap_artemis_intf_gen_type__set__interface_depth(this, f90wrap_interface_depth) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -107,9 +121,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__interface_depth(this, this_ptr = transfer(this, this_ptr) this_ptr%p%interface_depth = f90wrap_interface_depth -end subroutine f90wrap_artemis_interface_generator_type__set__interface_depth +end subroutine f90wrap_artemis_intf_gen_type__set__interface_depth -subroutine f90wrap_artemis_interface_generator_type__get__separation_scale(this, f90wrap_separation_scale) +subroutine f90wrap_artemis_intf_gen_type__get__separation_scale(this, f90wrap_separation_scale) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -121,9 +135,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__separation_scale(this, this_ptr = transfer(this, this_ptr) f90wrap_separation_scale = this_ptr%p%separation_scale -end subroutine f90wrap_artemis_interface_generator_type__get__separation_scale +end subroutine f90wrap_artemis_intf_gen_type__get__separation_scale -subroutine f90wrap_artemis_interface_generator_type__set__separation_scale(this, f90wrap_separation_scale) +subroutine f90wrap_artemis_intf_gen_type__set__separation_scale(this, f90wrap_separation_scale) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -135,9 +149,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__separation_scale(this, this_ptr = transfer(this, this_ptr) this_ptr%p%separation_scale = f90wrap_separation_scale -end subroutine f90wrap_artemis_interface_generator_type__set__separation_scale +end subroutine f90wrap_artemis_intf_gen_type__set__separation_scale -subroutine f90wrap_artemis_interface_generator_type__get__depth_method(this, f90wrap_depth_method) +subroutine f90wrap_artemis_intf_gen_type__get__depth_method(this, f90wrap_depth_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -149,9 +163,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__depth_method(this, f90 this_ptr = transfer(this, this_ptr) f90wrap_depth_method = this_ptr%p%depth_method -end subroutine f90wrap_artemis_interface_generator_type__get__depth_method +end subroutine f90wrap_artemis_intf_gen_type__get__depth_method -subroutine f90wrap_artemis_interface_generator_type__set__depth_method(this, f90wrap_depth_method) +subroutine f90wrap_artemis_intf_gen_type__set__depth_method(this, f90wrap_depth_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -163,9 +177,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__depth_method(this, f90 this_ptr = transfer(this, this_ptr) this_ptr%p%depth_method = f90wrap_depth_method -end subroutine f90wrap_artemis_interface_generator_type__set__depth_method +end subroutine f90wrap_artemis_intf_gen_type__set__depth_method -subroutine f90wrap_artemis_interface_generator_type__array__shift_data(this, nd, dtype, dshape, dloc) +subroutine f90wrap_artemis_intf_gen_type__array__shift_data(this, nd, dtype, dshape, dloc) use artemis__interface_generator, only: artemis_interface_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none @@ -188,9 +202,9 @@ subroutine f90wrap_artemis_interface_generator_type__array__shift_data(this, nd, else dloc = 0 end if -end subroutine f90wrap_artemis_interface_generator_type__array__shift_data +end subroutine f90wrap_artemis_intf_gen_type__array__shift_data -subroutine f90wrap_artemis_interface_generator_type__get__swap_method(this, f90wrap_swap_method) +subroutine f90wrap_artemis_intf_gen_type__get__swap_method(this, f90wrap_swap_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -202,9 +216,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__swap_method(this, f90w this_ptr = transfer(this, this_ptr) f90wrap_swap_method = this_ptr%p%swap_method -end subroutine f90wrap_artemis_interface_generator_type__get__swap_method +end subroutine f90wrap_artemis_intf_gen_type__get__swap_method -subroutine f90wrap_artemis_interface_generator_type__set__swap_method(this, f90wrap_swap_method) +subroutine f90wrap_artemis_intf_gen_type__set__swap_method(this, f90wrap_swap_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -216,9 +230,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__swap_method(this, f90w this_ptr = transfer(this, this_ptr) this_ptr%p%swap_method = f90wrap_swap_method -end subroutine f90wrap_artemis_interface_generator_type__set__swap_method +end subroutine f90wrap_artemis_intf_gen_type__set__swap_method -subroutine f90wrap_artemis_interface_generator_type__get__num_swaps(this, f90wrap_num_swaps) +subroutine f90wrap_artemis_intf_gen_type__get__num_swaps(this, f90wrap_num_swaps) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -230,9 +244,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__num_swaps(this, f90wra this_ptr = transfer(this, this_ptr) f90wrap_num_swaps = this_ptr%p%num_swaps -end subroutine f90wrap_artemis_interface_generator_type__get__num_swaps +end subroutine f90wrap_artemis_intf_gen_type__get__num_swaps -subroutine f90wrap_artemis_interface_generator_type__set__num_swaps(this, f90wrap_num_swaps) +subroutine f90wrap_artemis_intf_gen_type__set__num_swaps(this, f90wrap_num_swaps) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -244,9 +258,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__num_swaps(this, f90wra this_ptr = transfer(this, this_ptr) this_ptr%p%num_swaps = f90wrap_num_swaps -end subroutine f90wrap_artemis_interface_generator_type__set__num_swaps +end subroutine f90wrap_artemis_intf_gen_type__set__num_swaps -subroutine f90wrap_artemis_interface_generator_type__get__swap_density(this, f90wrap_swap_density) +subroutine f90wrap_artemis_intf_gen_type__get__swap_density(this, f90wrap_swap_density) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -258,9 +272,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__swap_density(this, f90 this_ptr = transfer(this, this_ptr) f90wrap_swap_density = this_ptr%p%swap_density -end subroutine f90wrap_artemis_interface_generator_type__get__swap_density +end subroutine f90wrap_artemis_intf_gen_type__get__swap_density -subroutine f90wrap_artemis_interface_generator_type__set__swap_density(this, f90wrap_swap_density) +subroutine f90wrap_artemis_intf_gen_type__set__swap_density(this, f90wrap_swap_density) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -272,9 +286,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__swap_density(this, f90 this_ptr = transfer(this, this_ptr) this_ptr%p%swap_density = f90wrap_swap_density -end subroutine f90wrap_artemis_interface_generator_type__set__swap_density +end subroutine f90wrap_artemis_intf_gen_type__set__swap_density -subroutine f90wrap_artemis_interface_generator_type__get__swap_depth(this, f90wrap_swap_depth) +subroutine f90wrap_artemis_intf_gen_type__get__swap_depth(this, f90wrap_swap_depth) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -286,9 +300,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__swap_depth(this, f90wr this_ptr = transfer(this, this_ptr) f90wrap_swap_depth = this_ptr%p%swap_depth -end subroutine f90wrap_artemis_interface_generator_type__get__swap_depth +end subroutine f90wrap_artemis_intf_gen_type__get__swap_depth -subroutine f90wrap_artemis_interface_generator_type__set__swap_depth(this, f90wrap_swap_depth) +subroutine f90wrap_artemis_intf_gen_type__set__swap_depth(this, f90wrap_swap_depth) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -300,9 +314,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__swap_depth(this, f90wr this_ptr = transfer(this, this_ptr) this_ptr%p%swap_depth = f90wrap_swap_depth -end subroutine f90wrap_artemis_interface_generator_type__set__swap_depth +end subroutine f90wrap_artemis_intf_gen_type__set__swap_depth -subroutine f90wrap_artemis_interface_generator_type__get__swap_sigma(this, f90wrap_swap_sigma) +subroutine f90wrap_artemis_intf_gen_type__get__swap_sigma(this, f90wrap_swap_sigma) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -314,9 +328,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__swap_sigma(this, f90wr this_ptr = transfer(this, this_ptr) f90wrap_swap_sigma = this_ptr%p%swap_sigma -end subroutine f90wrap_artemis_interface_generator_type__get__swap_sigma +end subroutine f90wrap_artemis_intf_gen_type__get__swap_sigma -subroutine f90wrap_artemis_interface_generator_type__set__swap_sigma(this, f90wrap_swap_sigma) +subroutine f90wrap_artemis_intf_gen_type__set__swap_sigma(this, f90wrap_swap_sigma) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -328,9 +342,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__swap_sigma(this, f90wr this_ptr = transfer(this, this_ptr) this_ptr%p%swap_sigma = f90wrap_swap_sigma -end subroutine f90wrap_artemis_interface_generator_type__set__swap_sigma +end subroutine f90wrap_artemis_intf_gen_type__set__swap_sigma -subroutine f90wrap_artemis_interface_generator_type__get__require_mirr41cf( & +subroutine f90wrap_artemis_intf_gen_type__get__require_mirr41cf( & this, f90wrap_require_mirror_swaps) use artemis__interface_generator, only: artemis_interface_generator_type implicit none @@ -343,9 +357,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__require_mirr41cf( & this_ptr = transfer(this, this_ptr) f90wrap_require_mirror_swaps = this_ptr%p%require_mirror_swaps -end subroutine f90wrap_artemis_interface_generator_type__get__require_mirr41cf +end subroutine f90wrap_artemis_intf_gen_type__get__require_mirr41cf -subroutine f90wrap_artemis_interface_generator_type__set__require_mirr3bfa( & +subroutine f90wrap_artemis_intf_gen_type__set__require_mirr3bfa( & this, f90wrap_require_mirror_swaps) use artemis__interface_generator, only: artemis_interface_generator_type implicit none @@ -358,9 +372,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__require_mirr3bfa( & this_ptr = transfer(this, this_ptr) this_ptr%p%require_mirror_swaps = f90wrap_require_mirror_swaps -end subroutine f90wrap_artemis_interface_generator_type__set__require_mirr3bfa +end subroutine f90wrap_artemis_intf_gen_type__set__require_mirr3bfa -subroutine f90wrap_artemis_interface_generator_type__get__match_method(this, f90wrap_match_method) +subroutine f90wrap_artemis_intf_gen_type__get__match_method(this, f90wrap_match_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -372,9 +386,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__match_method(this, f90 this_ptr = transfer(this, this_ptr) f90wrap_match_method = this_ptr%p%match_method -end subroutine f90wrap_artemis_interface_generator_type__get__match_method +end subroutine f90wrap_artemis_intf_gen_type__get__match_method -subroutine f90wrap_artemis_interface_generator_type__set__match_method(this, f90wrap_match_method) +subroutine f90wrap_artemis_intf_gen_type__set__match_method(this, f90wrap_match_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -386,9 +400,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__match_method(this, f90 this_ptr = transfer(this, this_ptr) this_ptr%p%match_method = f90wrap_match_method -end subroutine f90wrap_artemis_interface_generator_type__set__match_method +end subroutine f90wrap_artemis_intf_gen_type__set__match_method -subroutine f90wrap_artemis_interface_generator_type__get__max_num_matches(this, f90wrap_max_num_matches) +subroutine f90wrap_artemis_intf_gen_type__get__max_num_matches(this, f90wrap_max_num_matches) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -400,9 +414,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__max_num_matches(this, this_ptr = transfer(this, this_ptr) f90wrap_max_num_matches = this_ptr%p%max_num_matches -end subroutine f90wrap_artemis_interface_generator_type__get__max_num_matches +end subroutine f90wrap_artemis_intf_gen_type__get__max_num_matches -subroutine f90wrap_artemis_interface_generator_type__set__max_num_matches(this, f90wrap_max_num_matches) +subroutine f90wrap_artemis_intf_gen_type__set__max_num_matches(this, f90wrap_max_num_matches) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -414,9 +428,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__max_num_matches(this, this_ptr = transfer(this, this_ptr) this_ptr%p%max_num_matches = f90wrap_max_num_matches -end subroutine f90wrap_artemis_interface_generator_type__set__max_num_matches +end subroutine f90wrap_artemis_intf_gen_type__set__max_num_matches -subroutine f90wrap_artemis_interface_generator_type__get__max_num_terms(this, f90wrap_max_num_terms) +subroutine f90wrap_artemis_intf_gen_type__get__max_num_terms(this, f90wrap_max_num_terms) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -428,9 +442,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__max_num_terms(this, f9 this_ptr = transfer(this, this_ptr) f90wrap_max_num_terms = this_ptr%p%max_num_terms -end subroutine f90wrap_artemis_interface_generator_type__get__max_num_terms +end subroutine f90wrap_artemis_intf_gen_type__get__max_num_terms -subroutine f90wrap_artemis_interface_generator_type__set__max_num_terms(this, f90wrap_max_num_terms) +subroutine f90wrap_artemis_intf_gen_type__set__max_num_terms(this, f90wrap_max_num_terms) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -442,9 +456,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__max_num_terms(this, f9 this_ptr = transfer(this, this_ptr) this_ptr%p%max_num_terms = f90wrap_max_num_terms -end subroutine f90wrap_artemis_interface_generator_type__set__max_num_terms +end subroutine f90wrap_artemis_intf_gen_type__set__max_num_terms -subroutine f90wrap_artemis_interface_generator_type__get__max_num_planes(this, f90wrap_max_num_planes) +subroutine f90wrap_artemis_intf_gen_type__get__max_num_planes(this, f90wrap_max_num_planes) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -456,9 +470,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__max_num_planes(this, f this_ptr = transfer(this, this_ptr) f90wrap_max_num_planes = this_ptr%p%max_num_planes -end subroutine f90wrap_artemis_interface_generator_type__get__max_num_planes +end subroutine f90wrap_artemis_intf_gen_type__get__max_num_planes -subroutine f90wrap_artemis_interface_generator_type__set__max_num_planes(this, f90wrap_max_num_planes) +subroutine f90wrap_artemis_intf_gen_type__set__max_num_planes(this, f90wrap_max_num_planes) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -470,9 +484,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__max_num_planes(this, f this_ptr = transfer(this, this_ptr) this_ptr%p%max_num_planes = f90wrap_max_num_planes -end subroutine f90wrap_artemis_interface_generator_type__set__max_num_planes +end subroutine f90wrap_artemis_intf_gen_type__set__max_num_planes -subroutine f90wrap_artemis_interface_generator_type__get__fix_normal(this, f90wrap_fix_normal) +subroutine f90wrap_artemis_intf_gen_type__get__fix_normal(this, f90wrap_fix_normal) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -484,9 +498,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__fix_normal(this, f90wr this_ptr = transfer(this, this_ptr) f90wrap_fix_normal = this_ptr%p%fix_normal -end subroutine f90wrap_artemis_interface_generator_type__get__fix_normal +end subroutine f90wrap_artemis_intf_gen_type__get__fix_normal -subroutine f90wrap_artemis_interface_generator_type__set__fix_normal(this, f90wrap_fix_normal) +subroutine f90wrap_artemis_intf_gen_type__set__fix_normal(this, f90wrap_fix_normal) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -498,9 +512,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__fix_normal(this, f90wr this_ptr = transfer(this, this_ptr) this_ptr%p%fix_normal = f90wrap_fix_normal -end subroutine f90wrap_artemis_interface_generator_type__set__fix_normal +end subroutine f90wrap_artemis_intf_gen_type__set__fix_normal -subroutine f90wrap_artemis_interface_generator_type__get__bondlength_c21a8(this, f90wrap_bondlength_cutoff) +subroutine f90wrap_artemis_intf_gen_type__get__bondlength_c21a8(this, f90wrap_bondlength_cutoff) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -512,9 +526,9 @@ subroutine f90wrap_artemis_interface_generator_type__get__bondlength_c21a8(this, this_ptr = transfer(this, this_ptr) f90wrap_bondlength_cutoff = this_ptr%p%bondlength_cutoff -end subroutine f90wrap_artemis_interface_generator_type__get__bondlength_c21a8 +end subroutine f90wrap_artemis_intf_gen_type__get__bondlength_c21a8 -subroutine f90wrap_artemis_interface_generator_type__set__bondlength_cbd11(this, f90wrap_bondlength_cutoff) +subroutine f90wrap_artemis_intf_gen_type__set__bondlength_cbd11(this, f90wrap_bondlength_cutoff) use artemis__interface_generator, only: artemis_interface_generator_type implicit none type artemis_interface_generator_type_ptr_type @@ -526,9 +540,9 @@ subroutine f90wrap_artemis_interface_generator_type__set__bondlength_cbd11(this, this_ptr = transfer(this, this_ptr) this_ptr%p%bondlength_cutoff = f90wrap_bondlength_cutoff -end subroutine f90wrap_artemis_interface_generator_type__set__bondlength_cbd11 +end subroutine f90wrap_artemis_intf_gen_type__set__bondlength_cbd11 -subroutine f90wrap_artemis_interface_generator_type__array__layer_sepa90a5(this, nd, dtype, dshape, dloc) +subroutine f90wrap_artemis_intf_gen_type__array__layer_sepa90a5(this, nd, dtype, dshape, dloc) use artemis__interface_generator, only: artemis_interface_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none @@ -547,7 +561,7 @@ subroutine f90wrap_artemis_interface_generator_type__array__layer_sepa90a5(this, this_ptr = transfer(this, this_ptr) dshape(1:1) = shape(this_ptr%p%layer_separation_cutoff) dloc = loc(this_ptr%p%layer_separation_cutoff) -end subroutine f90wrap_artemis_interface_generator_type__array__layer_sepa90a5 +end subroutine f90wrap_artemis_intf_gen_type__array__layer_sepa90a5 subroutine f90wrap_intf_gen__artemis_interface_gen0ea8(this) use artemis__interface_generator, only: artemis_interface_generator_type @@ -628,7 +642,7 @@ subroutine f90wrap_intf_gen__set_shift_method__bin4dc1(this, method, num_shifts, separation_scale=separation_scale, depth_method=depth_method) end subroutine f90wrap_intf_gen__set_shift_method__bin4dc1 -subroutine f90wrap_intf_gen__generate__binding__ar04c1( & +subroutine f90wrap_intf_gen__generate__binding__aigt( & this, basis_lw, basis_up, miller_lw, & miller_up, surface_lw, surface_up, & thickness_lw, thickness_up, & @@ -695,9 +709,9 @@ subroutine f90wrap_intf_gen__generate__binding__ar04c1( & elastic_constants_up=elastic_constants_up, print_lattice_match_info=print_lattice_match_info, & print_termination_info=print_termination_info, print_shift_info=print_shift_info, break_on_fail=break_on_fail, & icheck_match=icheck_match, interface_idx=interface_idx, generate_structures=generate_structures, seed=seed) -end subroutine f90wrap_intf_gen__generate__binding__ar04c1 +end subroutine f90wrap_intf_gen__generate__binding__aigt -subroutine f90wrap_intf_gen__restart__binding__artdb00(this, basis, interface_location, & +subroutine f90wrap_intf_gen__restart__binding__aigt(this, basis, interface_location, & print_shift_info, seed) use artemis__interface_generator, only: artemis_interface_generator_type use artemis__geom_rw, only: basis_type @@ -720,7 +734,127 @@ subroutine f90wrap_intf_gen__restart__binding__artdb00(this, basis, interface_lo basis_ptr = transfer(basis, basis_ptr) call this_ptr%p%restart(basis=basis_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & seed=seed) -end subroutine f90wrap_intf_gen__restart__binding__artdb00 +end subroutine f90wrap_intf_gen__restart__binding__aigt + +subroutine f90wrap_intf_gen__get_structures__binding__aigt(this, ret_structures) + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_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(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(out), dimension(2) :: ret_structures + type(basis_type_xnum_array_ptr_type) :: ret_structures_ptr + + this_ptr = transfer(this, this_ptr) + ret_structures_ptr%p%items = this_ptr%p%get_structures() + ret_structures = transfer(ret_structures_ptr,ret_structures) +end subroutine f90wrap_intf_gen__get_structures__binding__aigt + + +!############################################################################### +! generated structures handling +!############################################################################### +subroutine f90wrap_artemis_intf_gen_type__array_getitem__structures( & + f90wrap_this, f90wrap_i, structuresitem & +) + + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: f90wrap_this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(out) :: structuresitem(2) + type(basis_type_ptr_type) :: structures_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structures)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structures)) then + call f90wrap_abort("array index out of range") + else + structures_ptr%p => this_ptr%p%structures(f90wrap_i) + structuresitem = transfer(structures_ptr,structuresitem) + endif + else + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_artemis_intf_gen_type__array_getitem__structures + +subroutine f90wrap_artemis_intf_gen_type__array_setitem__structures( & + f90wrap_this, f90wrap_i, structuresitem & +) + + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: f90wrap_this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(in) :: structuresitem(2) + type(basis_type_ptr_type) :: structures_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structures)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structures)) then + call f90wrap_abort("array index out of range") + else + structures_ptr = transfer(structuresitem,structures_ptr) + this_ptr%p%structures(f90wrap_i) = structures_ptr%p + endif + else + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_artemis_intf_gen_type__array_setitem__structures + +subroutine f90wrap_artemis_intf_gen_type__array_len__structures( & + f90wrap_this, f90wrap_n & +) + + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(out) :: f90wrap_n + integer, intent(in) :: f90wrap_this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structures)) then + f90wrap_n = size(this_ptr%p%structures) + else + f90wrap_n = 0 + end if +end subroutine f90wrap_artemis_intf_gen_type__array_len__structures +!############################################################################### ! End of module artemis__interface_generator defined in file ../src/fortran/lib/mod_intf_generator.f90 From 8cfdcb11aeafef7a75f6112f10cebf5ff5e73cb1 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 12:14:17 +0100 Subject: [PATCH 060/137] Improve generator element handling --- src/artemis/artemis.py | 18 ++++++-- src/fortran/lib/mod_misc_types.f90 | 8 ++-- src/wrapper/f90wrap_mod_intf_generator.f90 | 50 ++++++++++++++++++++-- 3 files changed, 66 insertions(+), 10 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index a25f7b3..eeaffd5 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1518,8 +1518,7 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ if isinstance(basis_up, Atoms): basis_up = geom_rw.basis(atoms=basis_up) - # exit_code = ... - _artemis.f90wrap_intf_gen__generate__binding__aigt(this=self._handle, \ + exit_code = _artemis.f90wrap_intf_gen__generate__binding__aigt(this=self._handle, \ basis_lw=basis_lw._handle, basis_up=basis_up._handle, miller_lw=miller_lw, \ miller_up=miller_up, surface_lw=surface_lw, surface_up=surface_up, \ thickness_lw=thickness_lw, thickness_up=thickness_up, \ @@ -1532,7 +1531,8 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ print_termination_info=print_termination_info, \ print_shift_info=print_shift_info, break_on_fail=break_on_fail, \ icheck_match=icheck_match, interface_idx=interface_idx, \ - generate_structures=generate_structures, seed=seed) + generate_structures=generate_structures, seed=seed \ + ) structures = self.get_structures(calc) return structures, exit_code @@ -1589,6 +1589,18 @@ def num_structures(self, num_structures): _raffle.f90wrap_artemis_intf_gen_type__set__num_structures(self._handle, \ num_structures) + @property + def max_num_structures(self): + """ + The maximum number of generated structures that can be stored in the generator. + """ + return _artemis.f90wrap_artemis_intf_gen_type__get__num_structures(self._handle) + + @max_num_structures.setter + def max_num_structures(self, max_num_structures): + _raffle.f90wrap_artemis_intf_gen_type__set__max_num_structures(self._handle, \ + max_num_structures) + @property def shift_method(self): """ diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index d192fd7..9be28b6 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -1,6 +1,6 @@ module artemis__misc_types !! Module containing custom derived types for ARTEMIS - use artemis__constants, only: real32 + use artemis__constants, only: real32, pi use artemis__misc, only: to_lower use artemis__geom_rw, only: basis_type, geom_write implicit none @@ -30,9 +30,9 @@ module artemis__misc_types integer :: maxsize = 10 real(real32) :: maxlen=20._real32 real(real32) :: maxarea=400._real32 - real(real32) :: vec = 5._real32 - real(real32) :: ang = 1._real32 - real(real32) :: area = 10._real32 + real(real32) :: vec = 5._real32 / 100._real32 + real(real32) :: ang = 1._real32 * pi / 180._real32 + real(real32) :: area = 10._real32 / 100._real32 real(real32) :: ang_weight = 10._real32 real(real32) :: area_weight = 100._real32 end type tol_type diff --git a/src/wrapper/f90wrap_mod_intf_generator.f90 b/src/wrapper/f90wrap_mod_intf_generator.f90 index 21fbf55..0ea5600 100644 --- a/src/wrapper/f90wrap_mod_intf_generator.f90 +++ b/src/wrapper/f90wrap_mod_intf_generator.f90 @@ -14,6 +14,48 @@ subroutine f90wrap_artemis_intf_gen_type__get__num_structures(this, f90wrap_num_ f90wrap_num_structures = this_ptr%p%num_structures end subroutine f90wrap_artemis_intf_gen_type__get__num_structures +subroutine f90wrap_artemis_intf_gen_type__set__num_structures(this, f90wrap_num_structures) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_structures + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_structures = f90wrap_num_structures +end subroutine f90wrap_artemis_intf_gen_type__set__num_structures + +subroutine f90wrap_artemis_intf_gen_type__get__max_num_structures(this, f90wrap_max_num_structures) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_structures + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_structures = this_ptr%p%max_num_structures +end subroutine f90wrap_artemis_intf_gen_type__get__max_num_structures + +subroutine f90wrap_artemis_intf_gen_type__set__max_num_structures(this, f90wrap_max_num_structures) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_structures + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_structures = f90wrap_max_num_structures +end subroutine f90wrap_artemis_intf_gen_type__set__max_num_structures + subroutine f90wrap_artemis_intf_gen_type__get__shift_method(this, f90wrap_shift_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none @@ -651,8 +693,8 @@ subroutine f90wrap_intf_gen__generate__binding__aigt( & is_layered_lw, is_layered_up, & elastic_constants_lw, elastic_constants_up, & print_lattice_match_info, print_termination_info, print_shift_info, & - break_on_fail, icheck_match, interface_idx, generate_structures, seed, n0, & - n1, n2, n3) + break_on_fail, icheck_match, interface_idx, generate_structures, seed, exit_code, & + n0, n1, n2, n3) use artemis__interface_generator, only: artemis_interface_generator_type use artemis__geom_rw, only: basis_type implicit none @@ -691,6 +733,7 @@ subroutine f90wrap_intf_gen__generate__binding__aigt( & integer, intent(in), optional :: interface_idx logical, intent(in), optional :: generate_structures integer, intent(in), optional :: seed + integer, intent(out), optional :: exit_code integer :: n0 !f2py intent(hide), depend(surface_lw) :: n0 = shape(surface_lw,0) integer :: n1 @@ -708,7 +751,8 @@ subroutine f90wrap_intf_gen__generate__binding__aigt( & is_layered_lw=is_layered_lw, is_layered_up=is_layered_up, elastic_constants_lw=elastic_constants_lw, & elastic_constants_up=elastic_constants_up, print_lattice_match_info=print_lattice_match_info, & print_termination_info=print_termination_info, print_shift_info=print_shift_info, break_on_fail=break_on_fail, & - icheck_match=icheck_match, interface_idx=interface_idx, generate_structures=generate_structures, seed=seed) + icheck_match=icheck_match, interface_idx=interface_idx, generate_structures=generate_structures, seed=seed, exit_code=exit_code & + ) end subroutine f90wrap_intf_gen__generate__binding__aigt subroutine f90wrap_intf_gen__restart__binding__aigt(this, basis, interface_location, & From 5f6285901aa236c84c8c0448bbe721cf8e1a7fc6 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Fri, 18 Apr 2025 15:14:23 +0100 Subject: [PATCH 061/137] Disable lreduce --- CMakeLists.txt | 4 ++-- app/inputs.f90 | 10 +++++----- src/fortran/lib/mod_constants.f90 | 2 +- src/fortran/lib/mod_geom_rw.f90 | 12 ++++++------ src/fortran/lib/mod_geom_utils.f90 | 1 - src/fortran/lib/mod_intf_generator.f90 | 9 +++++---- src/fortran/lib/mod_lat_compare.f90 | 9 +++++---- src/fortran/lib/mod_misc_maths.f90 | 4 ++-- src/fortran/lib/mod_plane_matching.f90 | 22 +++++++--------------- src/fortran/lib/mod_shifting.f90 | 6 +++--- src/fortran/lib/mod_sym.f90 | 21 +++++++++++++++++---- 11 files changed, 53 insertions(+), 47 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index a82bafb..3f35c3d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -211,7 +211,7 @@ target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${DEVFLAGS}>") target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${DEBUGFLAGS}>") target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${WARNFLAGS}>") -target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${MPFLAGS}>") +# target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${MPFLAGS}>") target_compile_options(${PROJECT_NAME} PUBLIC "$<$:${PYTHONFLAGS}>") if (BUILD_EXECUTABLE) @@ -228,7 +228,7 @@ if (BUILD_EXECUTABLE) target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${DEBUGFLAGS}>") target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${WARNFLAGS}>") - target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${MPFLAGS}>") + # target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${MPFLAGS}>") target_compile_options(${PROJECT_NAME}_executable PUBLIC "$<$:${PYTHONFLAGS}>") set_target_properties(${PROJECT_NAME}_executable PROPERTIES VERSION ${PROJECT_VERSION}) diff --git a/app/inputs.f90 b/app/inputs.f90 index 5aac529..b5e1743 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -129,7 +129,7 @@ subroutine set_global_vars() lreduce=.false. iswap = 0 nswap = 5 - swap_den = 5.D-2 + swap_den = 5.E-2_real32 swap_sigma = -1.0 swap_depth = 3.0 lswap_mirror = .true. @@ -143,7 +143,7 @@ subroutine set_global_vars() lw_surf=0 up_surf=0 iintf=-1 - tol_sym = 1.D-6 + tol_sym = 1.E-6_real32 udef_intf_loc = [ -1._real32, -1._real32 ] lw_use_pricel=.true. up_use_pricel=.true. @@ -601,8 +601,8 @@ subroutine read_card_cell_edits(unit,count,skip) call cat(unit=unit,end_string="END",end_string2="SHIFT",& line=count,string=store,rm_cmt=.true.) end if - edits%axis(edits%nedits)=assign_list(store,tag_list,1) - edits%val(edits%nedits)=assign_list(store,tag_list,3) + edits%axis(edits%nedits)= nint( assign_list(store,tag_list,1) ) + edits%val(edits%nedits)= assign_list(store,tag_list,3) if(index(store,"bounds").eq.0)then readvar(5) = readvar(5) + 1 edits%list(edits%nedits)=1 @@ -619,7 +619,7 @@ subroutine read_card_cell_edits(unit,count,skip) readvar(7) = readvar(7) + 1 call cat(unit=unit,end_string="END",end_string2="VACUUM",& line=count,string=store,rm_cmt=.true.) - edits%axis(edits%nedits)=assign_list(store,tag_list,1) + edits%axis(edits%nedits)= nint( assign_list(store,tag_list,1) ) edits%bounds(edits%nedits,1)=assign_list(store,tag_list,2) edits%val(edits%nedits)=assign_list(store,tag_list,3) else diff --git a/src/fortran/lib/mod_constants.f90 b/src/fortran/lib/mod_constants.f90 index 88bca78..e7ba879 100644 --- a/src/fortran/lib/mod_constants.f90 +++ b/src/fortran/lib/mod_constants.f90 @@ -8,7 +8,7 @@ module artemis__constants real(real32), parameter, public :: avogadros=6.022e23_real32 real(real32), parameter, public :: bohrtoang=0.529177249_real32 real(real32), parameter, public :: pi = 4._real32*atan(1._real32) - real(real32), parameter, public :: INF = huge(0._real32) + real(real32), parameter, public :: INF = huge(1._real32) integer, public :: ierror = -1 real(real32), parameter, public :: tolerance = 1.E-6_real32 end MODULE artemis__constants diff --git a/src/fortran/lib/mod_geom_rw.f90 b/src/fortran/lib/mod_geom_rw.f90 index e5755fa..89b148c 100644 --- a/src/fortran/lib/mod_geom_rw.f90 +++ b/src/fortran/lib/mod_geom_rw.f90 @@ -1250,15 +1250,15 @@ subroutine change_lattice(this, lattice) !! The new lattice. ! Local variables - integer :: is, ia - !! Loop index. - real(real32), dimension(3,3) :: transform - !! The transformation matrix. + ! integer :: is, ia + ! !! Loop index. + ! real(real32), dimension(3,3) :: transform + ! !! The transformation matrix. logical :: lcart !! Logical variable to determine whether the basis is in cartesian coordinates. - transform = matmul(inverse_3x3(lattice),this%lat) + ! transform = matmul(inverse_3x3(lattice),this%lat) lcart = this%lcart if(.not.lcart) call this%convert() ! do is = 1, this%nspec @@ -1470,7 +1470,7 @@ subroutine copy(this, basis, length) !--------------------------------------------------------------------------- ! determines whether user wants output basis extra translational dimension !--------------------------------------------------------------------------- - length_input = size(basis%spec(1)%atom(1,:),dim=1) + length_input = size(basis%spec(1)%atom,dim=2) if(present(length))then length_ = length else diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 47ae565..d86bbdb 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -1934,7 +1934,6 @@ subroutine get_bulk(lat,bas,axis,bulk_lat,bulk_bas) integer :: minspecloc,minatomloc,nxtatomloc real(real32), dimension(3) :: transvec real(real32), dimension(2,2) :: regions - real(real32), dimension(3,3) :: tf logical, allocatable, dimension(:) :: atom_mask type(basis_type), allocatable, dimension(:) :: splitbas diff --git a/src/fortran/lib/mod_intf_generator.f90 b/src/fortran/lib/mod_intf_generator.f90 index 7964fce..2c9fe9b 100644 --- a/src/fortran/lib/mod_intf_generator.f90 +++ b/src/fortran/lib/mod_intf_generator.f90 @@ -359,7 +359,7 @@ subroutine generate_interfaces( & break_on_fail, & icheck_match, interface_idx, & generate_structures, & - seed & + seed, exit_code & ) !! Generate interfaces from two bulk structures implicit none @@ -418,6 +418,8 @@ subroutine generate_interfaces( & !! Boolean whether to generate structures or just print information integer, intent(in), optional :: seed !! Random seed for generating random numbers + integer, intent(out), optional :: exit_code + !! Exit code for the function ! Local variables real(real32) :: avg_min_bond @@ -557,8 +559,8 @@ subroutine generate_interfaces( & !!!----------------------------------------------------------------------------- !!! determines the primitive and niggli reduced cell for each bulk !!!----------------------------------------------------------------------------- - call basis_lw_%copy(basis_lw) - call basis_up_%copy(basis_up) + call basis_lw_%copy(basis_lw, length=4) + call basis_up_%copy(basis_up, length=4) write(6,*) use_pricel_lw_ = .false. use_pricel_up_ = .false. @@ -655,7 +657,6 @@ subroutine generate_interfaces( & end if - !!!----------------------------------------------------------------------------- !!! investigates individual bulks and their bondlengths !!!----------------------------------------------------------------------------- diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index 94c961d..623b656 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -14,7 +14,7 @@ !!! convert_n_tf1!!! endcode !!!############################################################################# module lat_compare - use artemis__constants + use artemis__constants, only: real32, pi, INF, ierror use artemis__misc_types, only: latmatch_type, tol_type use misc_linalg, only: cross,uvec,modu,get_area,find_tf,det,reduce_vec_gcd,& inverse_3x3,get_vec_multiple,get_frac_denom @@ -23,7 +23,7 @@ module lat_compare implicit none integer :: ierr_compare logical :: lstop=.true. - logical :: lreduce=.true. + logical :: lreduce=.false. integer, private :: match_method=0 @@ -521,6 +521,7 @@ function get_lat2_alt(SAV,tol,tlat1) result(tf) !!! IF tf RETURNED AS ALL 0, THEN NO MATCH FOUND + lchange = .false. m_num=0 m_max=ceiling(& get_area(tlat1(1,:),tlat1(2,:))/get_area(SAV%lat2(1,:),SAV%lat2(2,:))) @@ -556,7 +557,7 @@ function get_lat2_alt(SAV,tol,tlat1) result(tf) !!!----------------------------------------------------------------------------- !!! Loops over the n array to check whether values are allowed !!!----------------------------------------------------------------------------- -302 mloop: do + mloop: do chngloop2: do i=2,1,-1 do j=1,SAV%axes(2) if(m(i,j).lt.0)then @@ -950,7 +951,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) type(sym_type) :: grp1,grp2 type(tol_type) :: tol - type(pm_tol_type) :: pm_tol + type(tol_type) :: pm_tol type(latmatch_type) :: SAV real(real32), dimension(3,3) :: tf real(real32), dimension(3,3) :: lat1,lat2 !original lattices. diff --git a/src/fortran/lib/mod_misc_maths.f90 b/src/fortran/lib/mod_misc_maths.f90 index 6ddd103..b7b7de8 100644 --- a/src/fortran/lib/mod_misc_maths.f90 +++ b/src/fortran/lib/mod_misc_maths.f90 @@ -381,7 +381,7 @@ function mode(in_array) maxcount=0 do i=1,size(in_array) itmp1=count(in_array.eq.in_array(i)) - itmp1=count(abs(in_array-in_array(i)).lt.1.D-8) + itmp1=count(abs(in_array-in_array(i)).lt.1.E-8_real32) if(itmp1.gt.maxcount)then maxcount=itmp1 mode=in_array(i) @@ -416,7 +416,7 @@ function normalise(in_array) result(output) real(real32), dimension(size(in_array)) :: output sumval=sum(in_array) - if(sumval.lt.1.D-8)then + if(sumval.lt.1.E-8_real32)then output=in_array else output=in_array/sum(in_array) diff --git a/src/fortran/lib/mod_plane_matching.f90 b/src/fortran/lib/mod_plane_matching.f90 index 4af9c6e..0dc61c3 100644 --- a/src/fortran/lib/mod_plane_matching.f90 +++ b/src/fortran/lib/mod_plane_matching.f90 @@ -7,19 +7,11 @@ module plane_matching use artemis__constants, only: real32, INF, pi use misc_linalg, only: cross,modu,get_angle,get_area,find_tf,& reduce_vec_gcd,gcd, inverse_2x2, find_tf_2x2 + use artemis__misc_types, only: tol_type implicit none !! importance of vector, angle, and area real(real32), dimension(3) :: vaa_weighting=(/1._real32,5._real32,2.5_real32/) - type :: pm_tol_type - integer :: maxsize,maxfit,nstore - real(real32) :: maxlen=20._real32 - real(real32) :: maxarea=400._real32 - real(real32) :: vec,ang,area - real(real32) :: ang_weight = 10._real32 - real(real32) :: area_weight = 100._real32 - end type pm_tol_type - !!!updated 2021/11/11 @@ -574,27 +566,27 @@ subroutine cell_match(& real(real32) :: tiny real(real32) :: reference_mag,considered_mag real(real32) :: reference_angle,considered_angle - type(pm_tol_type) :: tol + type(tol_type) :: tol real(real32), dimension(3) :: lat1_veca,lat1_vecb,lat2_veca,lat2_vecb real(real32), dimension(tol%maxfit) :: MAIN_LOOP_LIST_TOLERANCES !real(real32), dimension(:) :: MAIN_LOOP_LIST_TOLERANCES integer, dimension(2,6) :: tmpmat real(real32), dimension(2,2) :: tf,mat1,mat2 real(real32), dimension(2,3) :: considered_vectors - real(real32), dimension(3,3) :: lat1,lat2 + real(real32), dimension(3,3), intent(in) :: lat1,lat2 real(real32), dimension(1000,3) :: tmp_tolerances - real(real32), allocatable, dimension(:,:) :: matched_tols + real(real32), allocatable, dimension(:,:), intent(out) :: matched_tols real(real32), dimension(tol%maxfit,2,4) :: MAIN_LOOP_LIST - integer :: ntransforms + integer, intent(out) :: ntransforms !! The 2x2 transformation matrices output by the code. !! allocated when we know how many fits. - integer, allocatable, dimension(:,:,:) :: transforms1,transforms2 + integer, allocatable, dimension(:,:,:), intent(out) :: transforms1,transforms2 integer, allocatable, dimension(:,:) :: numstore_1,numstore_2 integer, allocatable, dimension(:,:) :: iarrtmp1 real(real32), allocatable, dimension(:,:) :: latstore_1,latstore_2 real(real32), allocatable, dimension(:,:) :: darrtmp1 - real(real32), dimension(:,:,:), optional :: sym1,sym2 + real(real32), dimension(:,:,:), intent(in), optional :: sym1,sym2 !!! Layout of each of the 1000 cells: diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index 6394c8d..d0d7966 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -564,7 +564,7 @@ function get_c_shift(lat,plane_up,plane_dw,bond,axis,num_steps) result(c_shift) !!!----------------------------------------------------------------------------- !!! Initialise variables !!!----------------------------------------------------------------------------- - tol=1.D-2/modu(lat(axis,:)) + tol=1.E-2_real32/modu(lat(axis,:)) count1=0 prev_min_bond=0._real32 prev_c_shift=0._real32 @@ -956,7 +956,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& !where(DON_missing(i,is)%atom(ia,:).lt.0._real32) ! DON_missing(i,is)%atom(ia,:)=0._real32 !end where - if(all(abs(DON_missing(i,is)%atom(ia,:)).lt.1.D-2))& + if(all(abs(DON_missing(i,is)%atom(ia,:)).lt.1.E-2_real32))& cycle atom_loop1 @@ -1077,7 +1077,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& gridsize(2) = stepsize/modu(bas%lat(2,:)) gridsize(3) = stepsize/modu(bas%lat(3,:)) - nstep(:2) = min_trans(:2)*ngrid(:2) + nstep(:2) = nint( min_trans(:2) * ngrid(:2) ) nstep(3) = 0 do jc=1,ngrid(3) pos(3) = real(jc-1,real32)*gridsize(3) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 736583d..23f6cba 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -26,7 +26,7 @@ module artemis__sym implicit none integer :: ierror_sym=0 integer :: s_start=1,s_end=0 - real(real32) :: tol_sym = 5.E-5_real32 + real(real32) :: tol_sym = 1.E-6_real32 character(1) :: verb_sym = "n" integer, allocatable, dimension(:) :: symops_compare @@ -69,9 +69,12 @@ module artemis__sym end type confine_type type sym_type - integer :: nsym,nlatsym,nsymop,npntop - logical :: lspace=.true. - logical :: lmolec=.false. + integer :: nsym = 0 + integer :: nlatsym = 0 + integer :: nsymop = 0 + integer :: npntop = 0 + logical :: lspace = .true. + logical :: lmolec = .false. integer, allocatable, dimension(:) :: op real(real32), allocatable, dimension(:,:,:) :: sym type(confine_type) :: confine @@ -193,6 +196,16 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) 204 format(4(F11.6),/,4(F11.6),/,4(F11.6),/,4(F11.6)) + ! check length of basis + do is = 1, bas1%nspec + if(size(bas1%spec(is)%atom,2).ne.4)then + write(0,'("ERROR: error encountered in check_sym")') + write(0,'(2X,"Internal error in subroutine check_sym in artemis__sym.f90")') + write(0,'(2X,"size of basis is not 4")') + return + end if + end do + !!!----------------------------------------------------------------------------- !!! allocated grp%op From 8551c1713ebd3b81a25bc3881847c2f637115467 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 19 Apr 2025 15:16:38 +0100 Subject: [PATCH 062/137] Tidy variables and printing --- app/inputs.f90 | 68 ++--- app/main.f90 | 24 +- app/mod_tools_infile.f90 | 2 +- src/fortran/lib/mod_intf_generator.f90 | 83 +++--- src/fortran/lib/mod_intf_identifier.f90 | 10 +- src/fortran/lib/mod_io_utils_extd.F90 | 16 +- src/fortran/lib/mod_lat_compare.f90 | 86 +++---- src/fortran/lib/mod_misc.f90 | 22 +- src/fortran/lib/mod_misc_types.f90 | 2 +- src/fortran/lib/mod_shifting.f90 | 46 ++-- src/fortran/lib/mod_swapping.f90 | 18 +- src/fortran/lib/mod_term_generator.f90 | 8 +- src/fortran/lib/mod_terminations.f90 | 320 ++++++++++++------------ 13 files changed, 354 insertions(+), 351 deletions(-) diff --git a/app/inputs.f90 b/app/inputs.f90 index b5e1743..fb316cb 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -174,15 +174,15 @@ subroutine set_global_vars() if(.not.empty)then read(buffer,'(A)') input_file else - write(6,'("ERROR: No input filename supplied, but the flag ''-f'' was used")') + write(*,'("ERROR: No input filename supplied, but the flag ''-f'' was used")') infilename_do: do j=1,3 - write(6,'("Please supply an input filename:")') + write(*,'("Please supply an input filename:")') read(5,'(A)') input_file if(trim(input_file).ne.'')then - write(6,'("Input filename supplied")') + write(*,'("Input filename supplied")') exit infilename_do else - write(6,'(1X,"Not a valid filename")') + write(*,'(1X,"Not a valid filename")') end if if(j.eq.3)then call err_abort('ERROR: No valid input filename supplied\nExiting...',.true.) @@ -234,46 +234,46 @@ subroutine set_global_vars() if(.not.empty) read(buffer,*) ierror elseif(index(buffer,'--version').eq.1)then flag="--version" - write(6,'(1X,"ARTEMIS version: ",A)') trim(artemis__version__) + write(*,'(1X,"ARTEMIS version: ",A)') trim(artemis__version__) stop elseif(index(buffer,'-h').eq.1.or.index(buffer,'--help').eq.1)then flag="--help" if(index(buffer,'-h').eq.1) flag="-h" call flagmaker(buffer,flag,i,skip,empty) if(empty)then - write(6,'("Flags:")') - write(6,'("-----------------FILE-NAME-FLAGS-----------------")') - write(6,'(2X,"-f : Input file name (Default = (empty)). (ALTERNATIVE TO FLAGS)")') - write(6,'(2X,"-i : Structure file 1 (Default = POSCAR)")') - write(6,'(2X,"-I : Structure file 2 (Default = (empty)")') - write(6,'(2X,"-D : Output directory name for generated structures (Default = DInterfaces)")') - write(6,'(2X,"-o : Subdirectory prefix (Default = D)")') - write(6,'("--------------------JOB-FLAGS--------------------")') - write(6,'(2X,"--restart : Restart job from where left off (NOT YET IMPLEMENTED)")') - write(6,'(2X,"--gen-surfaces : Generates the surfaces and labels them (NOT YET IMPLEMENTED)")') - write(6,'("------------------VERBOSE-FLAGS------------------")') - write(6,'(2X,"--version : Prints the version number")') - write(6,'(2X,"-v : Verbose printing type")') - write(6,'(2X,"-d[STR] : Print example input file (to file STR if present)")') - write(6,'(2X,"-h|--help [tag] : Prints the help for flags and tags (describes [tag] if supplied)")') - write(6,'(2X," "" all : Prints a list of all input file tags")') - write(6,'(2X,"--search : Searches the help for tags including the string ")') + write(*,'("Flags:")') + write(*,'("-----------------FILE-NAME-FLAGS-----------------")') + write(*,'(2X,"-f : Input file name (Default = (empty)). (ALTERNATIVE TO FLAGS)")') + write(*,'(2X,"-i : Structure file 1 (Default = POSCAR)")') + write(*,'(2X,"-I : Structure file 2 (Default = (empty)")') + write(*,'(2X,"-D : Output directory name for generated structures (Default = DInterfaces)")') + write(*,'(2X,"-o : Subdirectory prefix (Default = D)")') + write(*,'("--------------------JOB-FLAGS--------------------")') + write(*,'(2X,"--restart : Restart job from where left off (NOT YET IMPLEMENTED)")') + write(*,'(2X,"--gen-surfaces : Generates the surfaces and labels them (NOT YET IMPLEMENTED)")') + write(*,'("------------------VERBOSE-FLAGS------------------")') + write(*,'(2X,"--version : Prints the version number")') + write(*,'(2X,"-v : Verbose printing type")') + write(*,'(2X,"-d[STR] : Print example input file (to file STR if present)")') + write(*,'(2X,"-h|--help [tag] : Prints the help for flags and tags (describes [tag] if supplied)")') + write(*,'(2X," "" all : Prints a list of all input file tags")') + write(*,'(2X,"--search : Searches the help for tags including the string ")') else - write(6,*) + write(*,*) call settings_help(6,trim(adjustl(buffer))) call cell_edits_help(6,trim(adjustl(buffer))) call interface_help(6,trim(adjustl(buffer))) - write(6,'("======================================")') + write(*,'("======================================")') end if stop elseif(index(buffer,'--search').eq.1)then flag="--search" - write(6,*) + write(*,*) call flagmaker(buffer,flag,i,skip,empty) call settings_help(6,trim(adjustl(buffer)),search=.true.) call cell_edits_help(6,trim(adjustl(buffer)),search=.true.) call interface_help(6,trim(adjustl(buffer)),search=.true.) - write(6,'("======================================")') + write(*,'("======================================")') stop end if end do flagloop @@ -289,7 +289,7 @@ subroutine set_global_vars() !!! print execution date and time !!!----------------------------------------------------------------------------- call date_and_time(values=date_time_vals) - write(6,'(" executed on ",& + write(*,'(" executed on ",& &I4,".",I2.2,".",I2.2," at ",& &I0,":",I0,":",I0)')& date_time_vals(1:3),date_time_vals(5:7) @@ -331,7 +331,7 @@ subroutine set_global_vars() seed = clock + 37 * (/ (i - 1, i = 1, n) /) call random_seed(put=seed) - write(6,'(1X,A,I0)') "clock seed: ",clock + write(*,'(1X,A,I0)') "clock seed: ",clock !!!----------------------------------------------------------------------------- @@ -348,8 +348,8 @@ subroutine set_global_vars() if( (irestart.eq.1.and.task.eq.1).or.& (lsurf_gen.and.task.eq.1.and.struc2_file.eq.'').or.& (task.eq.0.and.struc2_file.eq.'') )then - write(6,'("2nd structure file not supplied")') - write(6,'(2X,"As is not necessary for this run, skipping...")') + write(*,'("2nd structure file not supplied")') + write(*,'(2X,"As is not necessary for this run, skipping...")') elseif(struc2_file.eq.'')then call err_abort('ERROR: 2nd structure file not supplied\n& & Supply a filename to the tag STRUC2_FILE in the SETTINGS card\n& @@ -387,7 +387,7 @@ subroutine set_global_vars() call write_settings(adjustl(trim(dirname))) end if - write(6,'(A)') repeat("#",50) + write(*,'(A)') repeat("#",50) if(lw_thickness.gt.0._real32.and.lw_num_layers.gt.0)then write(0,'(1X,A)') "WARNING: SLAB THICKNESS AND NUMBER OF LAYERS BOTH DEFINED" @@ -529,7 +529,7 @@ subroutine read_card_settings(unit,count,skip) case("TOL_SYM") call assign(buffer,tol_sym, readvar(11)) case default - write(6,'("NOTE: unable to assign variable on line ",I0)') count + write(*,'("NOTE: unable to assign variable on line ",I0)') count end select end do settings_read @@ -651,7 +651,7 @@ subroutine read_card_cell_edits(unit,count,skip) case("MIN_THICKNESS") call assign(buffer,lw_thickness, readvar(13)) case default - write(6,'("NOTE: unable to assign variable on line ",I0)') count + write(*,'("NOTE: unable to assign variable on line ",I0)') count end select end do cell_edits_read @@ -960,7 +960,7 @@ subroutine read_card_defects(unit,count,skip) !! defect task 1 = doper !! defect task 2 = molec rotater case default - write(6,'("NOTE: unable to assign variable on line ",I0)') count + write(*,'("NOTE: unable to assign variable on line ",I0)') count end select end do defects_read diff --git a/app/main.f90 b/app/main.f90 index 8e1a129..6b52542 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -30,7 +30,7 @@ program artemis_executable !!! ARTIE = Alloying & Rotating Tool for Intermixed structure Editing ??? select case(task) case(0) ! cell_edit/ASPECT - write(6,'(1X,"task ",I0," set",/,1X,"Performing Cell Edits")') task + write(*,'(1X,"task ",I0," set",/,1X,"Performing Cell Edits")') task if(lsurf_gen)then write(0,'(1X,"Finding terminations for lower material.")') term_gen%layer_separation_cutoff = layer_sep @@ -48,7 +48,7 @@ program artemis_executable lnorm=lnorm_lat) case(1) ! interfaces/ARTEMIS/SEARCH - write(6,'(1X,"task ",I0," set",/,1X,"Performing Interface Generation")') task + write(*,'(1X,"task ",I0," set",/,1X,"Performing Interface Generation")') task !!------------------------------------------------------------------------- !! surface generator @@ -59,10 +59,10 @@ program artemis_executable call chdir("DTERMINATIONS") if(all(lw_mplane.eq.0))then - write(6,'("No Miller plane defined for lower material.")') - write(6,'("Skipping...")') + write(*,'("No Miller plane defined for lower material.")') + write(*,'("Skipping...")') else - write(6,'(1X,"Finding terminations for lower material.")') + write(*,'(1X,"Finding terminations for lower material.")') term_gen%layer_separation_cutoff = lw_layer_sep call term_gen%generate(struc1_bas,lw_mplane,axis,& num_layers = lw_num_layers, & @@ -71,10 +71,10 @@ program artemis_executable call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "lw_") end if if(all(up_mplane.eq.0))then - write(6,'("No Miller plane defined for upper material.")') - write(6,'("Skipping...")') + write(*,'("No Miller plane defined for upper material.")') + write(*,'("Skipping...")') else - write(6,'(1X,"Finding terminations for upper material.")') + write(*,'(1X,"Finding terminations for upper material.")') term_gen%layer_separation_cutoff = up_layer_sep call term_gen%generate(struc2_bas,up_mplane,axis,& num_layers = up_num_layers, & @@ -82,7 +82,7 @@ program artemis_executable ) call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "up_") end if - write(6,'(1X,"Terminations printed.",/,1X,"Exiting...")') + write(*,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop end if @@ -110,12 +110,12 @@ program artemis_executable case(2) ! defects/ARTIE - write(6,'(1X,"task ",I0," set",/,1X,"Performing Defect Generation")') task + write(*,'(1X,"task ",I0," set",/,1X,"Performing Defect Generation")') task case default - write(6,'(1X,"No task selected.")') - write(6,'(1X,"Exiting code...")') + write(*,'(1X,"No task selected.")') + write(*,'(1X,"Exiting code...")') call exit() end select diff --git a/app/mod_tools_infile.f90 b/app/mod_tools_infile.f90 index 4703f44..ddc8c43 100644 --- a/app/mod_tools_infile.f90 +++ b/app/mod_tools_infile.f90 @@ -267,7 +267,7 @@ subroutine rm_comments(buffer,itmp) lbracket=scan(buffer,'(',back=.true.) rbracket=scan(buffer(lbracket:),')') if(lbracket.eq.0.or.rbracket.eq.0)then - write(6,'(A,I0)') & + write(*,'(A,I0)') & ' NOTE: a bracketing error was encountered on line ',iline buffer="" return diff --git a/src/fortran/lib/mod_intf_generator.f90 b/src/fortran/lib/mod_intf_generator.f90 index 2c9fe9b..7ad1caf 100644 --- a/src/fortran/lib/mod_intf_generator.f90 +++ b/src/fortran/lib/mod_intf_generator.f90 @@ -45,6 +45,17 @@ module artemis__interface_generator !! Separation scale integer :: depth_method = 0 !! Method for determining the depth to which consider atoms from interface + + integer, dimension(:,:,:,:), allocatable :: match_data + !! Data of matches for each interface + !! indices 1 and 2 are the transformation matrices + !! index 3 is length 2, where element 1 is lower, element 2 is upper + !! index 4 is the interface number in structures + real(real32), dimension(:,:), allocatable :: mismatch_data + !! Data of mismatches for each interface + !! index 1 is length 3, element 1 = length, element 2 = angle, element 3 = area + !! index 2 is the interface number in structures + real(real32), dimension(:,:), allocatable :: shift_data !! Data of shifts for each interface, where index 1 is the interface number in structures @@ -294,8 +305,8 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & else intf=get_interface(basis%lat,basis,this%axis) intf%loc=intf%loc/modu(basis%lat(intf%axis,:)) - write(6,*) "interface axis:",intf%axis - write(6,*) "interface loc:",intf%loc + write(*,*) "interface axis:",intf%axis + write(*,*) "interface loc:",intf%loc !! write interface location to a file for user to refer back to open(unit=10,file="interface_location.dat") write(10,'(1X,"AXIS = ",I0)') intf%axis @@ -335,8 +346,8 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & end do specloop1 min_bond = ( min_bond1 + min_bond2 ) / 2._real32 - write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond - write(6,'(1X,"Trans-interfacial scaling factor:",F0.3)') this%separation_scale + write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond + write(*,'(1X,"Trans-interfacial scaling factor:",F0.3)') this%separation_scale this%axis = intf%axis call this%generate_perturbations(basis, intf%loc, min_bond, bulk_DON, print_shift_info_, seed_arr) @@ -446,7 +457,7 @@ subroutine generate_interfaces( & !! Upper bulk termination loop indices ! slab thickness variables - integer :: ncells_lw, ncells_up + integer :: num_cells_lw, num_cells_up !! Number of cells in the slab real(real32) :: height_lw, height_up !! Height of the slab @@ -561,28 +572,28 @@ subroutine generate_interfaces( & !!!----------------------------------------------------------------------------- call basis_lw_%copy(basis_lw, length=4) call basis_up_%copy(basis_up, length=4) - write(6,*) + write(*,*) use_pricel_lw_ = .false. use_pricel_up_ = .false. if(present(use_pricel_lw)) use_pricel_lw_ = use_pricel_lw if(present(use_pricel_up)) use_pricel_up_ = use_pricel_up if(use_pricel_lw_)then - write(6,'(1X,"Using primitive cell for lower material")') + write(*,'(1X,"Using primitive cell for lower material")') call get_primitive_cell(basis_lw_) else - write(6,'(1X,"Using supplied cell for lower material")') + write(*,'(1X,"Using supplied cell for lower material")') call reducer(basis_lw_) basis_lw_%lat=primitive_lat(basis_lw_%lat) end if if(use_pricel_up_)then - write(6,'(1X,"Using primitive cell for upper material")') + write(*,'(1X,"Using primitive cell for upper material")') call get_primitive_cell(basis_up_) else - write(6,'(1X,"Using supplied cell for upper material")') + write(*,'(1X,"Using supplied cell for upper material")') call reducer(basis_up_) basis_up_%lat=primitive_lat(basis_up_%lat) end if - write(6,*) + write(*,*) surface_lw_ = 0 @@ -662,8 +673,8 @@ subroutine generate_interfaces( & !!!----------------------------------------------------------------------------- avg_min_bond = & ( get_min_bulk_bond(basis_lw_) + get_min_bulk_bond(basis_up_) )/2._real32 - write(6,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond - write(6,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale + write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond + write(*,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale if(this%shift_method.eq.-1) this%num_shifts=1 @@ -872,7 +883,7 @@ subroutine generate_interfaces( & write(0,'(1X,"Number of matches found: ",I0)')& min(this%tolerance%nstore,SAV%nfit) end if - write(6,'(1X,"Maximum number of generated interfaces will be: ",I0)')& + write(*,'(1X,"Maximum number of generated interfaces will be: ",I0)')& this%max_num_terms*this%num_shifts*this%tolerance%nstore if(.not.generate_structures_)then write(0,'(1X,"Told not to generate interfaces, just find matches.")') @@ -891,7 +902,7 @@ subroutine generate_interfaces( & if(interface_idx_.gt.0)then intf_start=interface_idx_ intf_end=interface_idx_ - write(6,'(1X,"Generating only interfaces for match ",I0)') interface_idx_ + write(*,'(1X,"Generating only interfaces for match ",I0)') interface_idx_ else intf_start=1 intf_end=min(this%tolerance%nstore,SAV%nfit) @@ -901,7 +912,7 @@ subroutine generate_interfaces( & !!! Applies the best match transformations !!!----------------------------------------------------------------------------- intf_loop: do ifit = intf_start, intf_end - write(6,'("Fit number: ",I0)') ifit + write(*,'("Fit number: ",I0)') ifit call supercell_lw%copy(basis_lw_) call supercell_up%copy(basis_up_) if(allocated(t1lw_map)) deallocate(t1lw_map) @@ -1029,7 +1040,7 @@ subroutine generate_interfaces( & !! Defines height of lower slab from user-defined values !!----------------------------------------------------------------------- call set_slab_height(supercell_lw,t1lw_map,lw_term,surface_lw_,& - height_lw,num_layers_lw_, thickness_lw_,ncells_lw,& + height_lw,num_layers_lw_, thickness_lw_,num_cells_lw,& term_lw_start_idx,term_lw_end_idx,term_lw_step & ) if(term_lw_end_idx.gt.this%max_num_terms) term_lw_end_idx = this%max_num_terms @@ -1110,7 +1121,7 @@ subroutine generate_interfaces( & !! Defines height of upper slab from user-defined values !!----------------------------------------------------------------------- call set_slab_height(supercell_up,t1up_map,up_term,surface_up_,& - height_up,num_layers_up_, thickness_up_, ncells_up,& + height_up,num_layers_up_, thickness_up_, num_cells_up,& term_up_start_idx,term_up_end_idx,term_up_step & ) if(term_up_end_idx.gt.this%max_num_terms) term_up_end_idx = this%max_num_terms @@ -1119,7 +1130,7 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------------- !! Print termination plane locations !!----------------------------------------------------------------------- - write(6,'(1X,"Number of unique terminations: ",I0,2X,I0)') & + write(*,'(1X,"Number of unique terminations: ",I0,2X,I0)') & lw_term%nterm,up_term%nterm !!----------------------------------------------------------------------- @@ -1134,7 +1145,7 @@ subroutine generate_interfaces( & !! Shifts lower material to specified termination !!-------------------------------------------------------------------- call build_slab(slab_lw,t2lw_map,lw_term,[iterm_lw,surface_lw_(2)],& - thickness_lw_, ncells_lw, num_layers_lw_, height_lw,& + thickness_lw_, num_cells_lw, num_layers_lw_, height_lw,& "lw",lcycle, & vacuum = this%vacuum_gap & ) @@ -1149,7 +1160,7 @@ subroutine generate_interfaces( & if(allocated(t2up_map)) deallocate(t2up_map) allocate(t2up_map,source=t1up_map) call build_slab(slab_up,t2up_map,up_term,[iterm_up,surface_up_(2)],& - thickness_up_, ncells_up, num_layers_up_, height_up,& + thickness_up_, num_cells_up, num_layers_up_, height_up,& "up",lcycle, & vacuum = this%vacuum_gap & ) @@ -1162,24 +1173,24 @@ subroutine generate_interfaces( & if(slab_lw%nspec.ne.basis_lw_%nspec.or.any(& (basis_lw_%spec(1)%num*slab_lw%spec(:)%num)& /slab_lw%spec(1)%num.ne.basis_lw_%spec(:)%num))then - write(6,'("WARNING: This lower surface termination is not & + write(*,'("WARNING: This lower surface termination is not & &stoichiometric")') if(is_layered_lw_)then - write(6,'(2X,"As lower structure is layered, stoichiometric & + write(*,'(2X,"As lower structure is layered, stoichiometric & &surfaces are required.")') - write(6,'(2X,"Skipping this termination...")') + write(*,'(2X,"Skipping this termination...")') cycle lw_term_loop end if end if if(slab_up%nspec.ne.basis_up_%nspec.or.any(& (basis_up_%spec(1)%num*slab_up%spec(:)%num)& /slab_up%spec(1)%num.ne.basis_up_%spec(:)%num))then - write(6,'("WARNING: This upper surface termination is not & + write(*,'("WARNING: This upper surface termination is not & &stoichiometric")') if(is_layered_up_)then - write(6,'(2X,"As upper structure is layered, stoichiometric & + write(*,'(2X,"As upper structure is layered, stoichiometric & &surfaces are required.")') - write(6,'(2X,"Skipping this termination...")') + write(*,'(2X,"Skipping this termination...")') cycle up_term_loop end if end if @@ -1235,7 +1246,7 @@ subroutine generate_interfaces( & if(this%num_structures.gt.old_intf)then iunique=iunique+1 ! if(this%shift_method.gt.0.and.this%num_shifts.gt.1) & - ! write(6,'(1X,"Generating shifts for unique interface ",& + ! write(*,'(1X,"Generating shifts for unique interface ",& ! &I0,":")') iunique ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique ! call system('mkdir -p '//trim(adjustl(dirpath))) @@ -1414,7 +1425,7 @@ subroutine generate_shifts_and_swaps( & !!!----------------------------------------------------------------------------- !!! Prints number of shifts to terminal !!!----------------------------------------------------------------------------- - write(6,'(3X,"Number of unique shifts structures: ",I0)') this%num_shifts + write(*,'(3X,"Number of unique shifts structures: ",I0)') this%num_shifts !!!----------------------------------------------------------------------------- @@ -1422,7 +1433,7 @@ subroutine generate_shifts_and_swaps( & !!!----------------------------------------------------------------------------- nswaps_per_cell=nint(this%swap_density*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) if(this%swap_method.ne.0)then - write(6,& + write(*,& '(" Generating ",I0," swaps per structure ")') nswaps_per_cell end if @@ -1452,9 +1463,9 @@ subroutine generate_shifts_and_swaps( & if(min_bond%length.le.1.5_real32)then write(msg,'("Smallest bond in the interface structure is\nless than 1.5 Å.")') call print_warning(trim(msg)) - write(6,'(2X,"bond length: ",F9.6)') min_bond%length - write(6,'(2X,"atom 1:",I4,2X,I4)') min_bond%atoms(1,:) - write(6,'(2X,"atom 2:",I4,2X,I4)') min_bond%atoms(2,:) + write(*,'(2X,"bond length: ",F9.6)') min_bond%length + write(*,'(2X,"atom 1:",I4,2X,I4)') min_bond%atoms(1,:) + write(*,'(2X,"atom 2:",I4,2X,I4)') min_bond%atoms(2,:) end if @@ -1477,7 +1488,7 @@ subroutine generate_shifts_and_swaps( & ! else ! filename = trim(out_filename) ! end if - ! write(6,'(2X,"Writing interface ",I0,"...")') intf + ! write(*,'(2X,"Writing interface ",I0,"...")') intf ! open(unit=ounit,file=trim(adjustl(filename))) ! call geom_write(ounit,tbas) ! close(ounit) @@ -1506,7 +1517,7 @@ subroutine generate_shifts_and_swaps( & ! call chdir(dirpath) ! call system('mkdir -p '//trim(adjustl(swapdir))) ! call chdir(swapdir) - ! write(6,'(3X,"Number of unique swap structures: ",I0)') ngen_swaps + ! write(*,'(3X,"Number of unique swap structures: ",I0)') ngen_swaps this%structures = [ this%structures, bas_arr(1:ngen_swaps) ] ! do l=1,ngen_swaps ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),l @@ -1514,7 +1525,7 @@ subroutine generate_shifts_and_swaps( & ! write(filename,'(A,"/",A)') & ! trim(adjustl(dirpath)),trim(out_filename) ! ounit=100+l - ! write(6,'(3X,"Writing swap ",I0,"...")') l + ! write(*,'(3X,"Writing swap ",I0,"...")') l ! open(unit=ounit,file=trim(adjustl(filename))) ! call geom_write(ounit,bas_arr(l)) ! close(ounit) diff --git a/src/fortran/lib/mod_intf_identifier.f90 b/src/fortran/lib/mod_intf_identifier.f90 index 05c5719..cc9fab2 100644 --- a/src/fortran/lib/mod_intf_identifier.f90 +++ b/src/fortran/lib/mod_intf_identifier.f90 @@ -488,7 +488,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) !!! initialise variables !!!----------------------------------------------------------------------------- if(present(lprint))then - if(lprint) write(6,'(1X,"Determining axis perpendicular to interface")') + if(lprint) write(*,'(1X,"Determining axis perpendicular to interface")') end if power=1.E0 nstep=size(DOS(1)%atom(1,1,:)) @@ -590,7 +590,7 @@ function get_intf_axis_DOS(DOS,lat,bas,dist_max,cutoff,lprint) result(axis) !!!----------------------------------------------------------------------------- axis=minloc(dir_disim,dim=1) if(present(lprint))then - if(lprint) write(6,*) "Interface located along axis",axis + if(lprint) write(*,*) "Interface located along axis",axis end if @@ -829,9 +829,9 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) !!! identify whether system is likely a planar defect !!!----------------------------------------------------------------------------- if(count(abs(multiCADD).lt.1.D-8).gt.0.9*nstep)then - write(6,'(1X,"System has same species-split density across system")') - write(6,'(1X,"Likely a planar defect")') - write(6,'(1X,"Use another interface identifier method...")') + write(*,'(1X,"System has same species-split density across system")') + write(*,'(1X,"Likely a planar defect")') + write(*,'(1X,"Use another interface identifier method...")') end if diff --git a/src/fortran/lib/mod_io_utils_extd.F90 b/src/fortran/lib/mod_io_utils_extd.F90 index 3d5ac62..3582f69 100644 --- a/src/fortran/lib/mod_io_utils_extd.F90 +++ b/src/fortran/lib/mod_io_utils_extd.F90 @@ -66,18 +66,18 @@ subroutine setup_input_fmt(fmt) select case(form) case("VASP") - write(6,*) "Input files will be VASP formatted" + write(*,*) "Input files will be VASP formatted" igeom_input=1 case("CASTEP") - write(6,*) "Input files will be CASTEP formatted" + write(*,*) "Input files will be CASTEP formatted" igeom_input=2 !call err_abort('ERROR: ARTEMIS not yet set up for CASTEP') case("QE","QUANTUMESPRESSO") - write(6,*) "Input files will be QuantumEspresso formatted" + write(*,*) "Input files will be QuantumEspresso formatted" igeom_input=3 !call err_abort('ERROR: ARTEMIS not yet set up for Quantum Espresso') case("CRYSTAL") - write(6,*) "Input files will be CRYSTAL formatted" + write(*,*) "Input files will be CRYSTAL formatted" igeom_input=4 call err_abort('ERROR: ARTEMIS not yet set up for CRYSTAL') end select @@ -108,21 +108,21 @@ subroutine setup_output_fmt(fmt,out_filename) select case(form) case("VASP") - write(6,*) "Output files will be VASP formatted" + write(*,*) "Output files will be VASP formatted" if(out_filename.eq.'') out_filename="POSCAR" igeom_output=1 case("CASTEP") - write(6,*) "Output files will be CASTEP formatted" + write(*,*) "Output files will be CASTEP formatted" if(out_filename.eq.'') out_filename="struc.cell" igeom_output=2 !call err_abort('ERROR: ARTEMIS not yet set up for CASTEP') case("QE","QUANTUMESPRESSO") - write(6,*) "Output files will be QuantumEspresso formatted" + write(*,*) "Output files will be QuantumEspresso formatted" if(out_filename.eq.'') out_filename="struc.geom" igeom_output=3 !call err_abort('ERROR: ARTEMIS not yet set up for Quantum Espresso') case("CRYSTAL") - write(6,*) "Output files will be CRYSTAL formatted" + write(*,*) "Output files will be CRYSTAL formatted" if(out_filename.eq.'') out_filename="INPUT_geom" igeom_output=4 call err_abort('ERROR: ARTEMIS not yet set up for CRYSTAL') diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index 623b656..7612c7a 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -118,22 +118,22 @@ subroutine pick_axis(SAV,str,lprint) do i=1,2 if(verify("abc",str(i)).eq.0) then SAV%axes(i)=3 - if(lprint) write(6,*) "Finding matches of all possible planes." + if(lprint) write(*,*) "Finding matches of all possible planes." elseif(verify("abc",str(i)).eq.3) then SAV%axes(i)=2 - if(lprint) write(6,*) "Finding matches of the ab planes." + if(lprint) write(*,*) "Finding matches of the ab planes." elseif(verify("abc",str(i)).eq.1) then SAV%axes(i)=2 SAV%abc=cshift(SAV%abc,shift=1) SAV%lat1(:,:)=cshift(SAV%lat1(:,:),shift=1,dim=1) SAV%lat2(:,:)=cshift(SAV%lat2(:,:),shift=1,dim=1) - if(lprint) write(6,*) "Finding matches of the bc planes." + if(lprint) write(*,*) "Finding matches of the bc planes." elseif(verify("abc",str(i)).eq.2) then SAV%axes(i)=2 SAV%abc=cshift(SAV%abc,shift=2) SAV%lat1(:,:)=cshift(SAV%lat1(:,:),shift=2,dim=1) SAV%lat2(:,:)=cshift(SAV%lat2(:,:),shift=2,dim=1) - if(lprint) write(6,*) "Finding matches of the ca planes." + if(lprint) write(*,*) "Finding matches of the ca planes." end if end do @@ -321,12 +321,12 @@ subroutine cyc_lat1(SAV,tol,ltmp) !!!----------------------------------------------------------------------------- if(SAV%nfit.eq.tol%maxfit) then if(lprint) & - write(6,'(/,"Number of fits reached maxfits ",I0)') SAV%nfit + write(*,'(/,"Number of fits reached maxfits ",I0)') SAV%nfit return end if if(lstop.and.count1.gt.100) then if(lprint) & - write(6,'(/,"Stopped as we reached ",I0," failed checks.")')& + write(*,'(/,"Stopped as we reached ",I0," failed checks.")')& count1 return end if @@ -709,21 +709,21 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) !!----------------------------------------------------------------------- if(present(lprint))then if(lprint)then - write(6,'(/,A,I0,2X,A,I0)') & + write(*,'(/,A,I0,2X,A,I0)') & "Fit number: ",SAV%nfit+1,& "Area increase: ",& nint(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))) - write(6,'(" Transmat 1: Transmat 2:")') - write(6,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc - write(6,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & + write(*,'(" Transmat 1: Transmat 2:")') + write(*,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc + write(*,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & tf1(1,1:3),tf2(1,1:3),& tf1(2,1:3),tf2(2,1:3),& tf1(3,1:3),tf2(3,1:3) - write(6,'(" vector mismatch (%) = ",F0.9)') diff*100._real32 - write(6,'(" angle mismatch (°) = ",F0.9)') abs(ang1-ang2)*180/pi - write(6,'(" area mismatch (%) = ",F0.9)') (& + write(*,'(" vector mismatch (%) = ",F0.9)') diff*100._real32 + write(*,'(" angle mismatch (°) = ",F0.9)') abs(ang1-ang2)*180/pi + write(*,'(" area mismatch (%) = ",F0.9)') (& 1-abs(t_area1/t_area2))*100._real32 - write(6,*) "reduced:",SAV%lreduced + write(*,*) "reduced:",SAV%lreduced end if end if !!----------------------------------------------------------------------- @@ -853,27 +853,27 @@ subroutine endcode(SAV) type(latmatch_type) :: SAV - write(6,*) + write(*,*) if(SAV%nfit.eq.0)then - write(6,'(" No matches were found within the tolerances supplied.")') - write(6,*) + write(*,'(" No matches were found within the tolerances supplied.")') + write(*,*) call exit(1) end if - write(6,'(1X,"BEST MATCH Area increase: ",I0)') & + write(*,'(1X,"BEST MATCH Area increase: ",I0)') & nint(get_area(real(SAV%tf1(1,1,:),real32),real(SAV%tf1(1,2,:),real32))) - write(6,'(" Transmat 1: Transmat 2:")') - write(6,'((/,1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & + write(*,'(" Transmat 1: Transmat 2:")') + write(*,'((/,1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & SAV%abc,SAV%abc,& SAV%tf1(1,1,1:3),SAV%tf2(1,1,1:3),& SAV%tf1(1,2,1:3),SAV%tf2(1,2,1:3),& SAV%tf1(1,3,1:3),SAV%tf2(1,3,1:3) - write(6,'(" vector mismatch (%) = ",F0.9)') SAV%tol(1,1) - write(6,'(" angle mismatch (°) = ",F0.9)') SAV%tol(1,2)*180/pi - write(6,'(" area mismatch (%) = ",F0.9)') SAV%tol(1,3) - write(6,*) + write(*,'(" vector mismatch (%) = ",F0.9)') SAV%tol(1,1) + write(*,'(" angle mismatch (°) = ",F0.9)') SAV%tol(1,2)*180/pi + write(*,'(" area mismatch (%) = ",F0.9)') SAV%tol(1,3) + write(*,*) - write(6,'(A)') "EXITING" + write(*,'(A)') "EXITING" return @@ -1117,19 +1117,19 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) end if if(present(lprint))then if(lprint)then - write(6,*) - write(6,'(1X,"Miller planes considered for lower material: ",I0)') & + write(*,*) + write(*,'(1X,"Miller planes considered for lower material: ",I0)') & size(miller1(:,1)) do i=1,size(miller1(:,1)) - write(6,'(2X,I2,")",3X,3(3X,I0))') i,miller1(i,:) + write(*,'(2X,I2,")",3X,3(3X,I0))') i,miller1(i,:) end do - write(6,*) - write(6,'(1X,"Miller planes considered for upper material: ",I0)') & + write(*,*) + write(*,'(1X,"Miller planes considered for upper material: ",I0)') & size(miller2(:,1)) do i=1,size(miller2(:,1)) - write(6,'(2X,I2,")",3X,3(3X,I0))') i,miller2(i,:) + write(*,'(2X,I2,")",3X,3(3X,I0))') i,miller2(i,:) end do - write(6,*) + write(*,*) end if end if @@ -1300,7 +1300,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !!!----------------------------------------------------------------------------- !!! Reduce transformation matrices if necessary !!!----------------------------------------------------------------------------- - write(6,*) "Performing lattice match reduction" + write(*,*) "Performing lattice match reduction" allocate(lvec1(tol%nstore)) lvec1=.false. OUTLOOP: do i=1,tol%nstore @@ -1342,7 +1342,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) end do OUTLOOP SAV%tol(:,1) = SAV%tol(:,1)*100._real32 SAV%tol(:,3) = SAV%tol(:,3)*100._real32 - write(6,*) "Total number of matches saved:",SAV%nfit + write(*,*) "Total number of matches saved:",SAV%nfit !!!----------------------------------------------------------------------------- @@ -1351,21 +1351,21 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) if(present(lprint))then if(lprint)then do i=1,SAV%nfit - write(6,'(/,A,I0,2X,A,I0)') & + write(*,'(/,A,I0,2X,A,I0)') & "Fit number: ",i,& "Area increase: ",& nint(get_area(real(SAV%tf1(i,1,:),real32),real(SAV%tf1(i,2,:),real32))) - write(6,'(" Transmat 1: Transmat 2:")') - write(6,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc - write(6,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & + write(*,'(" Transmat 1: Transmat 2:")') + write(*,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc + write(*,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & SAV%tf1(i,1,1:3),SAV%tf2(i,1,1:3),& SAV%tf1(i,2,1:3),SAV%tf2(i,2,1:3),& SAV%tf1(i,3,1:3),SAV%tf2(i,3,1:3) - write(6,'(" vector mismatch (%) = ",F0.9)') SAV%tol(i,1) - write(6,'(" angle mismatch (°) = ",F0.9)') SAV%tol(i,2)*180/pi - write(6,'(" area mismatch (%) = ",F0.9)') SAV%tol(i,3) - write(6,*) "reduced:",lvec1(i) - write(6,*) + write(*,'(" vector mismatch (%) = ",F0.9)') SAV%tol(i,1) + write(*,'(" angle mismatch (°) = ",F0.9)') SAV%tol(i,2)*180/pi + write(*,'(" area mismatch (%) = ",F0.9)') SAV%tol(i,3) + write(*,*) "reduced:",lvec1(i) + write(*,*) end do end if end if diff --git a/src/fortran/lib/mod_misc.f90 b/src/fortran/lib/mod_misc.f90 index c595122..ba4ddef 100644 --- a/src/fortran/lib/mod_misc.f90 +++ b/src/fortran/lib/mod_misc.f90 @@ -132,17 +132,17 @@ subroutine sort2D(arr,dim) real(real32), dimension(3) :: buff real(real32), dimension(dim,3) :: arr - a123(:)=(/1,2,3/) + a123(:) = [ 1, 2, 3 ] istart=1 - do j=1,3 - do i=j,dim + do j = 1, 3 + do i = j, dim loc=minloc(abs(arr(i:dim,a123(1))),dim=1,mask=(abs(arr(i:dim,a123(1))).gt.1.E-5_real32))+i-1 buff(:)=arr(i,:) arr(i,:)=arr(loc,:) arr(loc,:)=buff(:) end do - scndrow: do i=j,dim + scndrow: do i = j, dim if(abs(arr(j,a123(1))).ne.abs(arr(i,a123(1)))) exit scndrow loc=minloc(abs(arr(i:dim,a123(2)))+abs(arr(i:dim,a123(3))),dim=1,& mask=(abs(arr(j,a123(1))).eq.abs(arr(i:dim,a123(1)))))+i-1 @@ -411,9 +411,9 @@ subroutine loadbar(count,div,loaded) end if if((real(count)/real(4*div)-floor(real(count)/real(4*div))).lt.tiny) then - write(6,'(A,20X,A,"CALCULATING")',advance='no') creturn,creturn + write(*,'(A,20X,A,"CALCULATING")',advance='no') creturn,creturn else if((real(count)/real(div)-floor(real(count)/real(div))).lt.tiny) then - write(6,'(".")',advance='no') + write(*,'(".")',advance='no') end if return @@ -452,22 +452,22 @@ subroutine file_check(UNIT,FILENAME,ACTION) do i=1,5 inquire(file=trim(FILENAME),exist=filefound) if(.not.filefound) then - write(6,'("File name ",A," not found.")')& + write(*,'("File name ",A," not found.")')& "'"//trim(FILENAME)//"'" - write(6,'("Supply another filename: ")') + write(*,'("Supply another filename: ")') read(*,*) FILENAME else - write(6,'("Using file ",A)') & + write(*,'("Using file ",A)') & "'"//trim(FILENAME)//"'" exit end if if(i.ge.4) then - write(6,*) "Nope" + write(*,*) "Nope" call exit() end if end do if(trim(adjustl(udef_action)).eq.'NONE')then - write(6,*) "File found, but not opened." + write(*,*) "File found, but not opened." else open(unit=UNIT,file=trim(FILENAME),action=trim(udef_action),iostat=Reason) end if diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 9be28b6..62cf480 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -16,7 +16,7 @@ module artemis__misc_types type latmatch_type integer :: nfit logical :: lreduced - character(1) :: abc(3)=(/'a','b','c'/) + character(1) :: abc(3)= [ 'a', 'b', 'c' ] integer, dimension(2) :: axes integer, allocatable, dimension(:,:,:) :: tf1,tf2 diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index d0d7966..82cb0f9 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -278,7 +278,7 @@ function get_fit_shifts(lat,bas,bond,axis,intf_loc,depth,nstore,itmp1,itmp2) res ! close(unit) ! end do - write(6,'(4(F0.5,2X))') (best_shifts(i,:),i=1,nstore) + write(*,'(4(F0.5,2X))') (best_shifts(i,:),i=1,nstore) end function get_fit_shifts !!!######################################################################### @@ -520,9 +520,9 @@ function get_descriptive_shifts(lat,bas,bond,axis,intf_loc,depth,nstore,c_scale, if(present(lprint))then if(lprint)then - write(6,'(1X,"Shifts to be applied (Å)")') + write(*,'(1X,"Shifts to be applied (Å)")') do is=1,nstore - write(6,*) res_shifts(is,1),res_shifts(is,2), & + write(*,*) res_shifts(is,1),res_shifts(is,2), & res_shifts(is,3)*modu(lat(axis,:)) end do end if @@ -859,7 +859,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& where(abs(min_trans).lt.1.E-5_real32) min_trans=1._real32 end where - if(ierror.eq.1) write(6,*) "repeated_trans:",min_trans + if(ierror.eq.1) write(*,*) "repeated_trans:",min_trans !!!----------------------------------------------------------------------------- @@ -871,7 +871,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& do i=1,2 wyckoff(i)=get_wyckoff(splitbas(i),axis) if(.not.allocated(wyckoff(i)%spec))then - write(6,'(1X,"Using centre atoms as bulk representation")') + write(*,'(1X,"Using centre atoms as bulk representation")') lwyckoff(i)=.false. end if end do @@ -893,9 +893,9 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& dist_max = 4.0 end if allocate(DON_missing(2,bas%nspec)) - if(ierror.ge.1) write(6,*) + if(ierror.ge.1) write(*,*) region_loop: do i=1,2 - if(ierror.ge.1) write(6,'& + if(ierror.ge.1) write(*,'& &(2X,"is",2X,"ia",4X,"nmissing",4X,"bond size (Å)",8X,"position")') count1 = 0 @@ -979,7 +979,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& - 1 ) * dist_max/nstep_default neighbour(i,count1)%num = itmp1 if(ierror.ge.1)& - write(6,'(2X,I2,3X,I3,7X,I2,9X,F0.3,8X,3(1X,F5.2))') & + write(*,'(2X,I2,3X,I3,7X,I2,9X,F0.3,8X,3(1X,F5.2))') & is,ia,& neighbour(i,count1)%num,& neighbour(i,count1)%bond,& @@ -1021,8 +1021,8 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& end do atom_loop1 end do spec_loop if(ierror.ge.1)then - write(6,*) "nneigh:",count1 - write(6,*) + write(*,*) "nneigh:",count1 + write(*,*) end if if(count1.le.0)then write(0,'("WARNING: No missing bonds identified for parent slab ",I0)') i @@ -1047,8 +1047,8 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& lowest_atom(1) = minval(intf(1)%neigh(:)%pos(3),dim=1) highest_atom(2) = maxval(intf(2)%neigh(:)%pos(3),dim=1) if(abs(ierror).ge.1)then - write(6,*) "lowest atom:",lowest_atom - write(6,*) "highest atom:",highest_atom + write(*,*) "lowest atom:",lowest_atom + write(*,*) "highest atom:",highest_atom end if @@ -1086,7 +1086,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& nstep(3) = nstep(3) + 1 end do if(present(offset))then - if(ierror.ge.1) write(6,'(1X,"user-defined offset:",3(3X,F7.3))') offset + if(ierror.ge.1) write(*,'(1X,"user-defined offset:",3(3X,F7.3))') offset add = -1.0 do i=1,3 if(offset(i).ge.0._real32)then @@ -1110,12 +1110,12 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& !!! Determines neighbours for each grid point !!!----------------------------------------------------------------------------- if(abs(ierror).ge.1)then - write(6,'(1X,A,3(2X,F8.4))') & + write(*,'(1X,A,3(2X,F8.4))') & "lat:",modu(bas%lat(1,:)),modu(bas%lat(2,:)),modu(bas%lat(3,:)) - write(6,'(1X,A,3(2X,F8.4))') "gridsize:",gridsize - write(6,*) "add:",add - write(6,*) "nstep:",nstep - write(6,*) "ngrid:",ngrid + write(*,'(1X,A,3(2X,F8.4))') "gridsize:",gridsize + write(*,*) "add:",add + write(*,*) "nstep:",nstep + write(*,*) "ngrid:",ngrid write(*,*) "max_sep:",max_sep end if @@ -1267,12 +1267,12 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& !!!----------------------------------------------------------------------------- !!! Sets output of shifts !!!----------------------------------------------------------------------------- - write(6,'("Determined shifts (gridsize:",3(2X,F6.4),")")') gridsize - write(6,'(" num fit_val x y z")') + write(*,'("Determined shifts (gridsize:",3(2X,F6.4),")")') gridsize + write(*,'(" num fit_val x y z")') do i=1,nstore res_shifts(i,:) = real(shift_store(i,:),real32)/real(ngrid(:)-1,real32) res_shifts(i,:2) = res_shifts(i,:2) + add(:2) - write(6,'(1X,I3,":",2X,F6.2,3(2X,I3))') i,fit_store(i),shift_store(i,:) + write(*,'(1X,I3,":",2X,F6.2,3(2X,I3))') i,fit_store(i),shift_store(i,:) end do res_shifts(:,axis) = (res_shifts(:,axis)*max_sep)/modu(bas%lat(axis,:)) + & add(axis) @@ -1281,9 +1281,9 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& if(present(lprint))then if(lprint)then - write(6,'(1X,"Shifts to be applied (Å)")') + write(*,'(1X,"Shifts to be applied (Å)")') do i=1,nstore - write(6,'(I3,":",2X,3(2X,F7.4))') & + write(*,'(I3,":",2X,3(2X,F7.4))') & i,res_shifts(i,:2),res_shifts(i,3)*modu(bas%lat(axis,:)) end do end if diff --git a/src/fortran/lib/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 index 91d85b5..2fc03c0 100644 --- a/src/fortran/lib/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -110,8 +110,8 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& ! if(nperm.le.0) nperm=10 ! ! if(nswap.gt.nperm)then - ! write(6,'(1X,A)') "Number of possible permutations is less than requested value." - ! write(6,'(1X,A,I0)') "Resetting number of output structures to ",nperm + ! write(*,'(1X,A)') "Number of possible permutations is less than requested value." + ! write(*,'(1X,A,I0)') "Resetting number of output structures to ",nperm ! nswap=nperm ! end if !!!----------------------------------------------------------------------------- @@ -166,9 +166,9 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& end if end do if(ierror.ge.1)then - write(6,*) "mirror found for swaps" - write(6,'(4(2X,F9.4))') intf_sym(:,:) - write(6,*) + write(*,*) "mirror found for swaps" + write(*,'(4(2X,F9.4))') intf_sym(:,:) + write(*,*) end if else write(0,*) "WARNING: No mirror identified in interface" @@ -206,8 +206,8 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& nabove = size(up_close_list) end select if(nswaps_per_cell.gt.min(nabove,nbelow))then - write(6,'(1X,A)') "Number of possible swaps is less than requested value." - write(6,'(1X,A,I0)') "Resetting number of swaps to ",min(nabove,nbelow) + write(*,'(1X,A)') "Number of possible swaps is less than requested value." + write(*,'(1X,A,I0)') "Resetting number of swaps to ",min(nabove,nbelow) nswaps_per_cell=min(nabove,nbelow) end if @@ -295,8 +295,8 @@ subroutine check_intf(lat,bas,dintf,width,lw_list,up_list,nbelow,nabove,bas_list nbelow=count(dintf-bas_list(:,axis).le.width.and.dintf-bas_list(:,axis).ge.0) nabove=count(bas_list(:,axis)-dintf.le.width.and.bas_list(:,axis)-dintf.gt.0) if(min(nabove,nbelow).eq.0)then - write(6,'(1X,"No atoms found within ",F0.2," Å of the interface.")') width*modu(lat(axis,:)) - write(6,'(1X,"Exiting code...")') + write(*,'(1X,"No atoms found within ",F0.2," Å of the interface.")') width*modu(lat(axis,:)) + write(*,'(1X,"Exiting code...")') call exit() end if diff --git a/src/fortran/lib/mod_term_generator.f90 b/src/fortran/lib/mod_term_generator.f90 index 4a8f2fe..999330d 100644 --- a/src/fortran/lib/mod_term_generator.f90 +++ b/src/fortran/lib/mod_term_generator.f90 @@ -71,7 +71,7 @@ subroutine generate_terminations( & ! Local variables integer :: itmp1, iterm, term_start, term_end, iterm_step, i !! Termination loop variables - integer :: ncells, ntrans + integer :: num_cells, ntrans !! Number of cells in the slab integer :: num_structures !! Number of structures to be generated @@ -131,7 +131,7 @@ subroutine generate_terminations( & bas_map = -1 - write(6,'(1X,"Using supplied plane...")') + write(*,'(1X,"Using supplied plane...")') tfmat = planecutter(tmp_bas1%lat,real(miller_plane,real32)) call transformer(tmp_bas1,tfmat,bas_map) !call err_abort_print_struc(bas,"check.vasp","stop") @@ -197,7 +197,7 @@ subroutine generate_terminations( & ! determine required extension and perform that call set_slab_height(tmp_bas1,bas_map,term,surface_,& - height,num_layers_, thickness, ncells,& + height,num_layers_, thickness, num_cells,& term_start,term_end,iterm_step & ) @@ -221,7 +221,7 @@ subroutine generate_terminations( & if(allocated(t1bas_map)) deallocate(t1bas_map) allocate(t1bas_map,source=bas_map) call build_slab(output(i),bas_map,term,[iterm,surface_(2)],& - thickness, ncells, num_layers_, height,& + thickness, num_cells, num_layers_, height,& "lw", lcycle, orthogonalise_, this%vacuum_gap & ) end do diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index b983c79..6feb81f 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -20,7 +20,6 @@ module artemis__terminations type term_type - !real(real32) :: add real(real32) :: hmin real(real32) :: hmax integer :: natom @@ -179,9 +178,9 @@ function get_termination_info( & call sort_col(basis_list,col=axis) -!!!----------------------------------------------------------------------------- -!!! Finds number of non-unique terminations -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Find number of non-unique terminations + !--------------------------------------------------------------------------- nterm=1 allocate(term_arr(basis%natom)) term_arr(:)%natom=0 @@ -193,12 +192,7 @@ function get_termination_info( & itmp1 = 1 term_loop1: do - !! get the atom at that height. - !vtmp1 = get_min_dist(basis%lat,basis,basis_list(itmp1,:3),.true.,axis,.true.,.false.) - !itmp1 = minloc(basis_list(:,axis) - vtmp1(axis), dim=1, & - ! mask = abs(basis_list(:,axis) - (basis_list(itmp1,axis) + vtmp1(axis))& - ! ).lt.tolerance) - + ! get the atom at that height itmp1 = minloc(basis_list(:,axis) - term_arr(nterm)%hmax, dim=1, & mask = basis_list(:,axis) - term_arr(nterm)%hmax.gt.0._real32) if(itmp1.gt.basis%natom.or.itmp1.le.0)then @@ -206,7 +200,6 @@ function get_termination_info( & exit term_loop1 end if - !rtmp1 = modu(matmul(vtmp1,basis%lat)) rtmp1 = basis_list(itmp1,axis) - term_arr(nterm)%hmax if(rtmp1.le.tol)then term_arr(nterm)%hmax = basis_list(itmp1,axis) @@ -223,9 +216,9 @@ function get_termination_info( & term_arr(:nterm)%hmax = term_arr(:nterm)%hmax + height -!!!----------------------------------------------------------------------------- -!!! Set up system symmetries -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Set up system symmetries + !--------------------------------------------------------------------------- allocate(basis_arr(2*nterm)) allocate(basis_arr_reject(2*nterm)) dim = size(basis%spec(1)%atom(1,:)) @@ -241,9 +234,9 @@ function get_termination_info( & end do -!!!----------------------------------------------------------------------------- -!!! Print location of unique terminations -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Print location of unique terminations + !--------------------------------------------------------------------------- mterm = 0 ireject = 0 grp_store%lspace = .true. @@ -253,11 +246,11 @@ function get_termination_info( & - !!-------------------------------------------------------------------------- - !! Handle inversion matrix (centre of inversion must be accounted for) - !!-------------------------------------------------------------------------- - !! change symmetry constraints after setting up symmetries - !! this is done to constrain the matching of two basises in certain directions + !--------------------------------------------------------------------------- + ! Handle inversion matrix (centre of inversion must be accounted for) + !--------------------------------------------------------------------------- + ! change symmetry constraints after setting up symmetries + ! this is done to constrain the matching of two basises in certain directions grp_store%confine%l = .false. grp_store%confine%laxis(axis) = .false. call check_sym(grp_store,bas1=basis,iperm=-1,lsave=.true.) @@ -283,9 +276,9 @@ function get_termination_info( & - !!-------------------------------------------------------------------------- - !! Determine unique surface terminations - !!-------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Determine unique surface terminations + !--------------------------------------------------------------------------- grp_store%confine%l = .true. grp_store%confine%laxis(axis) = .true. allocate(term_arr_uniq(2*nterm)) @@ -296,8 +289,6 @@ function get_termination_info( & basis_arr(mterm) = basis centre = term_arr(i)%hmin + (term_arr(i)%hmax - term_arr(i)%hmin)/2._real32 call shifter(basis_arr(mterm),axis,1-centre,.true.) - !if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - ! i,term_arr(i)%hmin,term_arr(i)%hmax,term_arr(i)%natom sym_if: if(i.ne.1)then sym_loop1:do j=1,mterm-1 if(abs(abs(term_arr(i)%hmax-term_arr(i)%hmin) - & @@ -307,8 +298,6 @@ function get_termination_info( & call check_sym(grp1,bas1=basis_arr(mterm),& iperm=-1,tmpbas2=basis_arr(j),lsave=.true.) if(grp1%nsymop.ne.0)then - !write(0,*) "we have a possible reject" - !if(any(grp1%sym_save(:grp1%nsymop,axis,axis).eq.-1._real32))then if(grp1%sym_save(1,axis,axis).eq.-1._real32)then ireject = ireject + 1 reject_match(ireject,:) = [ i, j ] @@ -328,15 +317,12 @@ function get_termination_info( & term_arr_uniq(mterm)%nstep = 1 allocate(term_arr_uniq(mterm)%ladder(nterm)) term_arr_uniq(mterm)%ladder(:) = 0._real32 - !open(100+mterm) - !call geom_write(100+mterm,basis_arr(mterm)) - !close(100+mterm) end do shift_loop1 - !!-------------------------------------------------------------------------- - !! Set up mirror/inversion symmetries of the matrix - !!-------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Set up mirror/inversion symmetries of the matrix + !--------------------------------------------------------------------------- call sym_setup(grp_store,basis%lat,predefined=.false.,new_start=.true.) allocate(tmpsym(count(grp_store%sym(:,3,3).eq.-1._real32),4,4)) allocate(tmpop(count(grp_store%sym(:,3,3).eq.-1._real32))) @@ -356,9 +342,9 @@ function get_termination_info( & s_end = grp_store%nsym - !!-------------------------------------------------------------------------- - !! Check rejects for inverse surface termination of saved - !!-------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Check rejects for inverse surface termination of saved + !--------------------------------------------------------------------------- ident = 0._real32 do i=1,3 ident(i,i) = 1._real32 @@ -380,9 +366,7 @@ function get_termination_info( & iperm=-1,lsave=.true.,lcheck_all=.true.) ltmp1=.false. -!!!HERE !! Check if pure translations are present in comparison termination? - !do j=1,grp1%nsymop ! if(all(abs(grp1%sym_save(j,:3,:3)-ident).le.tolerance))then ! write(0,*) "FOUND TRANSLATION" ! cycle reject_loop1 @@ -404,8 +388,6 @@ function get_termination_info( & !! ... through lattice matches. !! Solely inversions are unique and must be captured. do j=1,grp1%nsymop - !write(0,'(4(2X,F9.4))') grp1%sym_save(j,:,:) - !write(0,*) det(grp1%sym_save(j,:3,:3)) if(abs(det(grp1%sym_save(j,:3,:3))-1._real32).le.tolerance) lunique=.false. end do if(grp1%sym_save(1,4,axis).eq.& @@ -422,10 +404,6 @@ function get_termination_info( & mterm=mterm+1 success(i)=itmp2 term_arr_uniq(mterm)=term_arr(reject_match(i,1)) - !if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - ! mterm,& - ! term_arr_uniq(mterm)%hmin,& - ! term_arr_uniq(mterm)%hmax,term_arr_uniq(mterm)%natom reject_match(i,2)=0 term_arr_uniq(mterm)%nstep = 1 allocate(term_arr_uniq(mterm)%ladder(ireject+1)) @@ -438,16 +416,16 @@ function get_termination_info( & end do reject_loop1 - !!-------------------------------------------------------------------------- - !! Populate termination output - !!-------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Populate termination output + !--------------------------------------------------------------------------- allocate(term%arr(mterm)) term%tol=tol term%axis=axis term%nterm=mterm term%lmirror = lmirror if(ludef_print)& - write(6,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') + write(*,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') rtmp1 = term_arr_uniq(1)%hmin-1.E-6_real32 itmp1 = 1 do i=1,mterm @@ -457,7 +435,7 @@ function get_termination_info( & term%arr(i)%natom = term_arr_uniq(itmp1)%natom term%arr(i)%nstep = term_arr_uniq(itmp1)%nstep term%arr(i)%ladder(:term%arr(i)%nstep) = term_arr_uniq(i)%ladder(:term%arr(i)%nstep) - if(ludef_print) write(6,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + if(ludef_print) write(*,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & i,term%arr(i)%hmin,term%arr(i)%hmax,term%arr(i)%natom itmp1 = minloc(term_arr_uniq(:)%hmin,& mask=term_arr_uniq(:)%hmin.gt.rtmp1+tol,dim=1) @@ -470,10 +448,10 @@ function get_termination_info( & term%nstep = maxval(term%arr(:)%nstep) - !!-------------------------------------------------------------------------- - !! Check to ensure equivalent number of steps for each termination - !!-------------------------------------------------------------------------- - !! Not yet certain whether each termination should have samve number ... + !--------------------------------------------------------------------------- + ! Check to ensure equivalent number of steps for each termination + !--------------------------------------------------------------------------- + !! Not yet certain whether each termination should have same number ... !! ... of ladder rungs. That's why this check is here. if(all(term%arr(:)%nstep.ne.term%nstep))then write(0,'("ERROR: Number of rungs in terminations no equivalent for & @@ -570,8 +548,8 @@ subroutine set_layer_tol(term) end if end do - !! add the tolerances to the edges of the layers - !! this ensures that all atoms in the layers are captured + ! add the tolerances to the edges of the layers + ! this ensures that all atoms in the layers are captured term%arr(:)%hmin = term%arr(:)%hmin - term%tol term%arr(:)%hmax = term%arr(:)%hmax + term%tol @@ -581,7 +559,7 @@ end subroutine set_layer_tol !############################################################################### subroutine set_slab_height( basis, map, term, surf,& - height, num_layers, thickness, ncells,& + height, num_layers, thickness, num_cells,& term_start, term_end, term_step & ) !! Extend the basis to the maximum required height for all terminations @@ -602,7 +580,7 @@ subroutine set_slab_height( basis, map, term, surf,& integer, dimension(2), intent(in) :: surf !! Surface termination indices (for a single slab with both surface indices) integer, intent(in) :: num_layers - integer, intent(out) :: term_start, term_end, ncells + integer, intent(out) :: term_start, term_end, num_cells integer, intent(out) :: term_step real(real32), intent(in) :: thickness real(real32), intent(out) :: height @@ -622,15 +600,15 @@ subroutine set_slab_height( basis, map, term, surf,& logical :: ludef_surf - !!-------------------------------------------------------------------- - !! Initialise variables - !!-------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Initialise variables + !--------------------------------------------------------------------------- height = 0._real32 - !!----------------------------------------------------------------------- - !! Defines height of slab from user-defined values - !!----------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Define height of slab from user-defined values + !--------------------------------------------------------------------------- ludef_surf = .false. term_start = 1 term_end = term%nterm @@ -645,14 +623,14 @@ subroutine set_slab_height( basis, map, term, surf,& end if ludef_surf = .true. list = get_term_list(term) - !! set term_start to first surface value + ! set term_start to first surface value term_start = surf(1) - !! set term_end to first surface value as a user-defined surface ... - !! ... should not be cycled over. - !! it is just one, potentially assymetric, slab to be explored. + ! set term_end to first surface value as a user-defined surface ... + ! ... should not be cycled over. + ! it is just one, potentially assymetric, slab to be explored. term_end = surf(1) - !! determines the maximum number of cells required + ! determines the maximum number of cells required allocate(vtmp1(size(list))) height = term%arr(term_start)%hmin do i=num_layers,2,-1 @@ -665,7 +643,6 @@ subroutine set_slab_height( basis, map, term, surf,& height = height + vtmp1(itmp1) end do vtmp1 = list(:)%loc - height - !vtmp1 = vtmp1 - ceiling( vtmp1 - 1._real32 ) where(vtmp1.lt.-1.E-5_real32) vtmp1 = vtmp1 - ceiling( vtmp1 + 1.E-5_real32 - 1._real32 ) end where @@ -675,21 +652,19 @@ subroutine set_slab_height( basis, map, term, surf,& list(:)%term.eq.surf(2)) height = height + vtmp1(itmp1) - term%arr(term_start)%hmin - !if(.not.term%lmirror)then - ! get thickness of top/surface layer - rtmp1 = term%arr(surf(2))%hmax - term%arr(surf(2))%hmin - if(rtmp1.lt.-1.E-5_real32) rtmp1 = rtmp1 + 1._real32 - height = height + rtmp1 !(1._real32 - rtmp1) - !end if + ! get thickness of top/surface layer + rtmp1 = term%arr(surf(2))%hmax - term%arr(surf(2))%hmin + if(rtmp1.lt.-1.E-5_real32) rtmp1 = rtmp1 + 1._real32 + height = height + rtmp1 - ncells = ceiling(height) - height = height/real(ncells,real32) + num_cells = ceiling(height) + height = height/real(num_cells,real32) end if - !!----------------------------------------------------------------------- - !! Define termination iteration counter - !!----------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Define termination iteration counter + !--------------------------------------------------------------------------- if(term_end.lt.term_start)then term_step = -1 else @@ -697,11 +672,11 @@ subroutine set_slab_height( basis, map, term, surf,& end if - !!----------------------------------------------------------------------- - !! Extend slab to user-defined thickness - !!----------------------------------------------------------------------- - if(.not.ludef_surf) ncells = int((num_layers-1)/term%nstep)+1 - !! convert thickness, in angstroms to number of cells + !--------------------------------------------------------------------------- + ! Extend slab to user-defined thickness + !--------------------------------------------------------------------------- + if(.not.ludef_surf) num_cells = int((num_layers-1)/term%nstep)+1 + ! convert thickness, in angstroms, to number of cells if(thickness.gt.0._real32)then select case(term%axis) case(1) @@ -754,7 +729,7 @@ subroutine set_slab_height( basis, map, term, surf,& end if end do step_loop1 if(.not.success) cycle cell_loop1 - ncells = icell + 1 + num_cells = icell + 1 exit cell_loop1 end do cell_loop1 @@ -777,27 +752,27 @@ subroutine set_slab_height( basis, map, term, surf,& end do step_loop if(.not.success) cycle cell_loop2 end do term_loop - ncells = icell + 1 + num_cells = icell + 1 exit cell_loop2 end do cell_loop2 end if - height = height/real(ncells * slab_thickness,real32) + height = height/real(num_cells * slab_thickness,real32) end if tfmat(:,:) = 0._real32 tfmat(1,1) = 1._real32 tfmat(2,2) = 1._real32 - tfmat(3,3) = ncells + tfmat(3,3) = num_cells call transformer(basis,tfmat,map) - !!----------------------------------------------------------------------- - !! Readjust termination plane locations - !! ... i.e. divide all termination values by the number of cells - !!----------------------------------------------------------------------- - term%arr(:)%hmin = term%arr(:)%hmin/real(ncells,real32) - term%arr(:)%hmax = term%arr(:)%hmax/real(ncells,real32) - term%tol = term%tol/real(ncells,real32) + !--------------------------------------------------------------------------- + ! Readjust termination plane locations + ! ... i.e. divide all termination values by the number of cells + !--------------------------------------------------------------------------- + term%arr(:)%hmin = term%arr(:)%hmin/real(num_cells,real32) + term%arr(:)%hmax = term%arr(:)%hmax/real(num_cells,real32) + term%tol = term%tol/real(num_cells,real32) end subroutine set_slab_height @@ -807,8 +782,8 @@ end subroutine set_slab_height !############################################################################### subroutine build_slab( & - basis, map, term, surf, thickness, ncells, num_layers, & - height, lwup_in, lcycle, & + basis, map, term, surf, thickness, num_cells, num_layers, & + height, prefix, lcycle, & orthogonalise, vacuum & ) !! Build a slab of the specified terminations @@ -829,41 +804,63 @@ subroutine build_slab( & integer, dimension(2), intent(in) :: surf !! Surface termination indices (for a single slab with both surface indices) - integer, intent(in) :: num_layers, ncells - real(real32), intent(in) :: height, thickness - character(2), intent(in) :: lwup_in + real(real32), intent(in) :: thickness + !! Requested thickness of the slab (mutually exclusive with num_layers) + integer, intent(in) :: num_layers + !! Requested number of layers in the slab (mutually exclusive with thickness) + integer, intent(in) :: num_cells + !! Number of cells in the input slab + real(real32), intent(in) :: height + !! Height of the slab if user-defined surf (calculated in set_slab_height) + character(2), intent(in) :: prefix + !! Prefix for file names + !! (e.g. "lw" for lower, "up" for upper) logical, intent(out) :: lcycle - + !! Boolean whether to skip this slab in the cycle logical, optional, intent(in) :: orthogonalise + !! Boolean whether to orthogonalise the slab (default: .true.) real(real32), intent(in) :: vacuum - + !! Vacuum thickness to add to the slab ! Local variables integer :: term_btm_idx, term_top_idx !! Indices of the bottom and top terminations logical :: equivalent_surfaces !! Boolean whether the two surfaces are equivalent - integer :: j, j_start, istep, natom_check + integer :: j, j_start, istep, icell + !! Loop index and termination step + integer :: natom_check + !! Check for number of atoms + integer :: num_cells_minus1 + !! Number of cells minus 1 real(real32) :: rtmp1, slab_thickness, shift_val - character(2) :: lwup - character(5) :: lowerupper + !! Temporary variable for slab thickness and shifting + real(real32) :: layer_thickness, ladder_adjust + !! Layer thickness and ladder adjustment + character(2) :: prefix_ + !! Prefix for file names + character(5) :: slab_name + !! Name of the slab character(1024) :: msg + !! Printing message logical :: orthogonalise_ - integer, dimension(3) :: abc=(/1,2,3/) + !! Boolean whether to orthogonalise the slab + integer, dimension(3) :: abc real(real32), dimension(3) :: surface_normal_vec + !! Surface normal vector real(real32), dimension(3,3) :: tfmat + !! Transformation matrix integer, allocatable, dimension(:) :: iterm_list + !! List of terminations - integer :: icell, num_cells - real(real32) :: layer_thickness, ladder_adjust - - !!-------------------------------------------------------------------- - !! Initialise variables - !!-------------------------------------------------------------------- - lwup=to_lower(lwup_in) - if(lwup.eq."lw") lowerupper="LOWER" - if(lwup.eq."up") lowerupper="UPPER" + !--------------------------------------------------------------------------- + ! Initialise variables + !--------------------------------------------------------------------------- + abc = [ 1, 2, 3 ] + prefix_=to_lower(prefix) + if(prefix_.eq."lw") slab_name="LOWER" + if(prefix_.eq."up") slab_name="UPPER" lcycle = .false. rtmp1=0._real32 tfmat=0._real32 @@ -887,10 +884,10 @@ subroutine build_slab( & slab_thickness = abs( dot_product(surface_normal_vec, [ basis%lat(3,:) ]) ) end select if(thickness.gt.0._real32)then - rtmp1 = slab_thickness / ncells * ( ncells - 1 ) + rtmp1 = slab_thickness / num_cells * ( num_cells - 1 ) istep = term%nstep - num_cells = ncells - 1 - cell_loop: do icell = 0, ncells, 1 + num_cells_minus1 = num_cells - 1 + cell_loop: do icell = 0, num_cells, 1 layer_thickness = term%arr(term_top_idx)%hmax - term%arr(term_btm_idx)%hmin - 2.E0 * term%tol ladder_adjust = 0._real32 step_loop: do j = 1, term%nstep @@ -903,18 +900,18 @@ subroutine build_slab( & ladder_adjust = term%arr(term_top_idx)%ladder(j+1) - term%arr(term_btm_idx)%ladder(j) end if end if - rtmp1 = ( icell / real(ncells,real32) + layer_thickness ) * slab_thickness + & - ( ladder_adjust + term%arr(term_top_idx)%ladder(j) - term%arr(term_btm_idx)%ladder(1) ) * slab_thickness / real(ncells,real32) + rtmp1 = ( icell / real(num_cells,real32) + layer_thickness ) * slab_thickness + & + ( ladder_adjust + term%arr(term_top_idx)%ladder(j) - term%arr(term_btm_idx)%ladder(1) ) * slab_thickness / real(num_cells,real32) if(rtmp1.ge.thickness)then istep = j - num_cells = icell + num_cells_minus1 = icell exit cell_loop end if end do step_loop end do cell_loop else - istep = num_layers - (ncells-1)*term%nstep - num_cells = ncells - 1 + istep = num_layers - (num_cells-1)*term%nstep + num_cells_minus1 = num_cells - 1 end if natom_check = basis%natom @@ -922,9 +919,9 @@ subroutine build_slab( & if(present(orthogonalise)) orthogonalise_ = orthogonalise - !!-------------------------------------------------------------------- - !! Set up list for checking expected number of atoms - !!-------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Set up list for checking expected number of atoms + !--------------------------------------------------------------------------- allocate(iterm_list(term%nterm)) do j = 1, term%nterm iterm_list(j) = j @@ -933,66 +930,61 @@ subroutine build_slab( & if(.not.equivalent_surfaces)then j_start = term_top_idx - term_btm_idx + 1 if(j_start.le.0) j_start = j_start + term%nterm - j_start = j_start + 1 !+ (istep-1)*term%nterm/term%nstep + j_start = j_start + 1 else - !! handle ladder steps that are equivalent - j_start = 2 !+ (istep-1)*term%nterm/term%nstep + j_start = 2 end if - !!-------------------------------------------------------------------- - !! Shift lower material to specified termination - !!-------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Shift lower material to specified termination + !--------------------------------------------------------------------------- call shifter(basis,term%axis,-term%arr(term_btm_idx)%hmin,.true.) - !!-------------------------------------------------------------------- - !! Determine cell reduction to specified termination - !!-------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Determine cell reduction to specified termination + !--------------------------------------------------------------------------- do j = 1, 3 tfmat(j,j) = 1._real32 if(j.eq.term%axis)then if(.not.equivalent_surfaces)then tfmat(j,j) = height - else!if(term%lmirror)then + else if(istep.ne.0)then - rtmp1 = num_cells + term%arr(term_btm_idx)%ladder(istep) - rtmp1 = rtmp1/real(ncells, real32) + rtmp1 = num_cells_minus1 + term%arr(term_btm_idx)%ladder(istep) + rtmp1 = rtmp1/real(num_cells, real32) tfmat(j,j) = rtmp1 + & (term%arr(term_btm_idx)%hmax - term%arr(term_btm_idx)%hmin) end if - !else - ! tfmat(j,j) = tfmat(j,j) + (& - ! term%arr(term_btm_idx)%hmax - & - ! term%arr(term_btm_idx)%hmin) + term%tol*2._real32 end if end if end do - !!-------------------------------------------------------------------- - !! Check number of atoms is expected - !!-------------------------------------------------------------------- - if(num_cells.ne.ncells-1)then - do icell = num_cells + 2, ncells, 1 - natom_check = natom_check - nint( basis%natom / real(ncells) ) + !--------------------------------------------------------------------------- + ! Check number of atoms is expected + !--------------------------------------------------------------------------- + if(num_cells_minus1.ne.num_cells-1)then + do icell = num_cells_minus1 + 2, num_cells, 1 + natom_check = natom_check - nint( basis%natom / real(num_cells) ) end do end if - !!-------------------------------------------------------------------- - !! Apply transformation and shift cell back to bottom of layer - !! ... i.e. account for the tolerance that has been added to layer ... - !! ... hmin and hmax - !!-------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Apply transformation and shift cell back to bottom of layer + ! ... i.e. account for the tolerance that has been added to layer ... + ! ... hmin and hmax + !--------------------------------------------------------------------------- shift_val = term%tol * slab_thickness / modu(basis%lat(term%axis,:)) call transformer(basis,tfmat,map) call shifter(basis,term%axis,-shift_val/tfmat(term%axis,term%axis),.true.) - !!-------------------------------------------------------------------- - !! Check number of atoms is expected - !!-------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Check number of atoms is expected + !--------------------------------------------------------------------------- if(term%nterm.gt.1.or.term%nstep.gt.1)then do j = 1, max(0,term%nstep-istep), 1 natom_check = natom_check - sum(term%arr(:)%natom) @@ -1002,22 +994,22 @@ subroutine build_slab( & end do end if if(basis%natom.ne.natom_check)then - write(msg, '("NUMBER OF ATOMS IN '//to_upper(lowerupper)//' SLAB! & + write(msg, '("NUMBER OF ATOMS IN '//to_upper(slab_name)//' SLAB! & &Expected ",I0," but generated ",I0," instead")') & natom_check,basis%natom if(tfmat(term%axis,term%axis).gt.1._real32)then write(0,'("THE TRANSFORMATION IS GREATER THAN ONE ",F0.9)') & tfmat(term%axis,term%axis) end if - call err_abort_print_struc(basis,lwup//"_term.vasp",& + call err_abort_print_struc(basis,prefix_//"_term.vasp",& trim(msg),.true.) lcycle = .true. end if - !!-------------------------------------------------------------------- - !! Apply slab_cuber to orthogonalise lower material - !!-------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Apply slab_cuber to orthogonalise lower material + !--------------------------------------------------------------------------- call set_vacuum(basis,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum) abc=cshift(abc,3-term%axis) if(orthogonalise_)then From fd734a81ec062d264ec0df82eaea1c2720dc2d24 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 19 Apr 2025 15:31:34 +0100 Subject: [PATCH 063/137] Improve commenting --- src/fortran/lib/mod_terminations.f90 | 149 ++++++++++++++++----------- 1 file changed, 88 insertions(+), 61 deletions(-) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 6feb81f..b9ed6ab 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -10,6 +10,7 @@ module artemis__terminations use edit_geom, only: shifter, transformer, ortho_axis, set_vacuum implicit none + private public :: term_arr_type @@ -20,6 +21,7 @@ module artemis__terminations type term_type + !! Structure to hold termination information real(real32) :: hmin real(real32) :: hmax integer :: natom @@ -28,6 +30,7 @@ module artemis__terminations end type term_type type term_arr_type + !! Structure to hold arrays of terminations integer :: nterm = 0, axis, nstep real(real32) :: tol logical :: lmirror=.false. @@ -35,6 +38,7 @@ module artemis__terminations end type term_arr_type type term_list_type + !! Structure to hold termination index and location integer :: term real(real32) :: loc end type term_list_type @@ -63,38 +67,52 @@ function get_termination_info( & logical, intent(in), optional :: break_on_fail !! Boolean whether to break on failure to find terminations - - integer :: i,j,is,nterm,mterm,dim,ireject - integer :: itmp1,itmp2,init,min_loc - logical :: ludef_print,lunique,ltmp1,lmirror, break_on_fail_ - real(real32) :: rtmp1,tol,height,max_sep,c_along,centre - type(sym_type) :: grp1,grp_store + ! Local variables + integer :: i, j, is, nterm, mterm, dim, ireject + !! Loop indices and dimensions + integer :: itmp1, itmp2, init, min_loc + !! Temporary indices + logical :: ludef_print, lunique, ltmp1, lmirror, break_on_fail_ + !! Boolean flags + real(real32) :: rtmp1, tol, height, max_sep, c_along, centre + !! Temporary variables + real(real32) :: layer_sep_ + !! Minimum separation between layers + type(sym_type) :: grp1, grp_store + !! Symmetry group structure type(term_arr_type) :: term - integer, dimension(3) :: abc=(/1,2,3/) + !! Termination information + integer, dimension(3) :: abc + !! Axis indices real(real32), dimension(3) :: vec_compare - real(real32), dimension(3,3) :: inv_mat,ident - type(basis_type),allocatable, dimension(:) :: basis_arr,basis_arr_reject - type(term_type), allocatable, dimension(:) :: term_arr,term_arr_uniq - integer, allocatable, dimension(:) :: success,tmpop + !! Comparison vector + real(real32), dimension(3,3) :: inv_mat, ident + !! Inversion and identity matrix + type(basis_type),allocatable, dimension(:) :: basis_arr, basis_arr_reject + !! Basis structures for terminations + type(term_type), allocatable, dimension(:) :: term_arr, term_arr_uniq + !! Termination information + integer, allocatable, dimension(:) :: success, tmpop + !! Temporary symmetry operations integer, allocatable, dimension(:,:) :: reject_match + !! Rejection match array real(real32), allocatable, dimension(:,:) :: basis_list + !! List of basis atoms real(real32), allocatable, dimension(:,:,:) :: tmpsym + !! Temporary symmetry matrix character(len=256) :: err_msg + !! Error message - - -!!!APPLY TRANSFORMATION MATRIX TO FIND TERMINATIONS ALONG OTHER PLANES -!!! E.G. (1 0 1) - + abc = [ 1, 2, 3 ] term%nterm = 0 s_end=0 grp_store%confine%l=.false. grp_store%confine%axis=axis grp_store%confine%laxis=.false. -!!!----------------------------------------------------------------------------- -!!! Sets printing option -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Set printing option + !--------------------------------------------------------------------------- if(present(lprint))then ludef_print = lprint else @@ -104,25 +122,25 @@ function get_termination_info( & if(present(break_on_fail)) break_on_fail_ = break_on_fail -!!!----------------------------------------------------------------------------- -!!! Sets the surface identification tolerance -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Set the surface identification tolerance + !--------------------------------------------------------------------------- if(present(layer_sep))then - tol = layer_sep + layer_sep_ = layer_sep else - tol = 1._real32 !!!tolerance of 1 Å for defining a layer + layer_sep_ = 1._real32 !!!tolerance of 1 Å for defining a layer end if abc=cshift(abc,3-axis) c_along = abs(dot_product(basis%lat(axis,:),& uvec(cross([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])))) - tol = tol / c_along + layer_sep_ = layer_sep_ / c_along lmirror=.false. -!!!----------------------------------------------------------------------------- -!!! Set up basis list that will order them wrt distance along 'axis' -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Set up basis list that will order them wrt distance along 'axis' + !--------------------------------------------------------------------------- allocate(basis_list(basis%natom,3)) init = 1 do is=1,basis%nspec @@ -132,9 +150,9 @@ function get_termination_info( & call sort_col(basis_list,col=axis) -!!!----------------------------------------------------------------------------- -!!! Find largest separation between atoms -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Find largest separation between atoms + !--------------------------------------------------------------------------- max_sep = basis_list(1,axis) - (basis_list(basis%natom,axis)-1._real32) height = ( basis_list(1,axis) + (basis_list(basis%natom,axis)-1._real32) )/2._real32 do i=1,basis%natom-1 @@ -144,7 +162,7 @@ function get_termination_info( & height = ( basis_list(i+1,axis) + basis_list(i,axis) )/2._real32 end if end do - if(max_sep.lt.tol)then + if(max_sep.lt.layer_sep_)then if(break_on_fail_)then write(0,'("ERROR: Error in artemis__sym.f90")') else @@ -201,7 +219,7 @@ function get_termination_info( & end if rtmp1 = basis_list(itmp1,axis) - term_arr(nterm)%hmax - if(rtmp1.le.tol)then + if(rtmp1.le.layer_sep_)then term_arr(nterm)%hmax = basis_list(itmp1,axis) else term_arr(nterm)%natom = itmp1 - min_loc @@ -357,7 +375,7 @@ function get_termination_info( & lunique=.true. itmp1=reject_match(i,1) itmp2=reject_match(i,2) - !! Check if comparison termination has already been compared successfully + ! Check if comparison termination has already been compared successfully prior_check: if(any(success(1:i-1).eq.itmp2))then lunique=.false. else @@ -366,27 +384,27 @@ function get_termination_info( & iperm=-1,lsave=.true.,lcheck_all=.true.) ltmp1=.false. - !! Check if pure translations are present in comparison termination? - ! if(all(abs(grp1%sym_save(j,:3,:3)-ident).le.tolerance))then - ! write(0,*) "FOUND TRANSLATION" - ! cycle reject_loop1 - ! end if - !end do - !! Check if inversions are present in comparison termination + ! Check if pure translations are present in comparison termination? + !! if(all(abs(grp1%sym_save(j,:3,:3)-ident).le.tolerance))then + !! write(0,*) "FOUND TRANSLATION" + !! cycle reject_loop1 + !! end if + !! end do + ! Check if inversions are present in comparison termination do j=1,grp1%nsymop if(abs(det(grp1%sym_save(j,:3,:3))+1._real32).le.tolerance) ltmp1=.true. end do - !! If they are not, then no point comparing. It is a new termination + ! If they are not, then no point comparing. It is a new termination if(.not.ltmp1) exit prior_check call clone_grp(grp_store,grp1) call check_sym(grp1,basis_arr(itmp2),& tmpbas2=basis_arr_reject(i),iperm=-1,lsave=.true.,lcheck_all=.true.) - !! Check det of all symmetry operations. If any are 1, move on - !! This is because they are just rotations as can be captured ... - !! ... through lattice matches. - !! Solely inversions are unique and must be captured. + ! Check det of all symmetry operations. If any are 1, move on + ! This is because they are just rotations as can be captured ... + ! ... through lattice matches. + ! Solely inversions are unique and must be captured. do j=1,grp1%nsymop if(abs(det(grp1%sym_save(j,:3,:3))-1._real32).le.tolerance) lunique=.false. end do @@ -420,7 +438,7 @@ function get_termination_info( & ! Populate termination output !--------------------------------------------------------------------------- allocate(term%arr(mterm)) - term%tol=tol + term%tol=layer_sep_ term%axis=axis term%nterm=mterm term%lmirror = lmirror @@ -438,10 +456,10 @@ function get_termination_info( & if(ludef_print) write(*,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & i,term%arr(i)%hmin,term%arr(i)%hmax,term%arr(i)%natom itmp1 = minloc(term_arr_uniq(:)%hmin,& - mask=term_arr_uniq(:)%hmin.gt.rtmp1+tol,dim=1) + mask=term_arr_uniq(:)%hmin.gt.rtmp1+layer_sep_,dim=1) if(itmp1.eq.0) then itmp1 = minloc(term_arr_uniq(:)%hmin,& - mask=term_arr_uniq(:)%hmin.gt.rtmp1+tol-1._real32,dim=1) + mask=term_arr_uniq(:)%hmin.gt.rtmp1+layer_sep_-1._real32,dim=1) end if rtmp1 = term_arr_uniq(itmp1)%hmin end do @@ -451,8 +469,8 @@ function get_termination_info( & !--------------------------------------------------------------------------- ! Check to ensure equivalent number of steps for each termination !--------------------------------------------------------------------------- - !! Not yet certain whether each termination should have same number ... - !! ... of ladder rungs. That's why this check is here. + ! Not yet certain whether each termination should have same number ... + ! ... of ladder rungs. That's why this check is here. if(all(term%arr(:)%nstep.ne.term%nstep))then write(0,'("ERROR: Number of rungs in terminations no equivalent for & &every termination! Please report this to developers.\n& @@ -579,25 +597,34 @@ subroutine set_slab_height( basis, map, term, surf,& !! List of termination information integer, dimension(2), intent(in) :: surf !! Surface termination indices (for a single slab with both surface indices) - integer, intent(in) :: num_layers - integer, intent(out) :: term_start, term_end, num_cells - integer, intent(out) :: term_step real(real32), intent(in) :: thickness + !! Requested thickness of the slab (mutually exclusive with num_layers) + integer, intent(in) :: num_layers + !! Requested number of layers in the slab (mutually exclusive with thickness) real(real32), intent(out) :: height + !! Height of the slab if user-defined surf + integer, intent(out) :: num_cells + !! Maximum number of cells in the output basis + integer, intent(out) :: term_start, term_end, term_step + !! Termination indices for the slab - - integer :: i,itmp1 - real(real32) :: rtmp1, slab_thickness, largest_sep + ! Local variables + integer :: i, itmp1, icell, istep, iterm + !! Loop indices + real(real32) :: rtmp1, slab_thickness, largest_sep, layer_thickness + !! Temporary variables character(1024) :: msg + !! Temporary message string real(real32), dimension(3,3) :: tfmat + !! Transformation matrix real(real32), allocatable, dimension(:) :: vtmp1 + !! Temporary vector type(term_list_type), allocatable, dimension(:) :: list - - - integer :: icell, istep, iterm - real(real32) :: layer_thickness + !! List of terminations logical :: success + !! Success flag for finding the required thickness logical :: ludef_surf + !! Boolean whether surface terminations are user-defined !--------------------------------------------------------------------------- From 6520ba86b77b91a201f318bf4fe3c644acad22d5 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sat, 19 Apr 2025 16:53:11 +0100 Subject: [PATCH 064/137] Update generator arguments --- src/artemis/artemis.py | 327 +++++++++-- src/fortran/lib/mod_intf_generator.f90 | 601 ++++++++++++--------- src/fortran/lib/mod_misc_types.f90 | 17 + src/wrapper/f90wrap_mod_intf_generator.f90 | 467 ++++++++++++++-- 4 files changed, 1099 insertions(+), 313 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index eeaffd5..55182b1 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1456,22 +1456,18 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ interface_depth=interface_depth, separation_scale=separation_scale, \ depth_method=depth_method) - def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ - surface_lw=None, surface_up=None, thickness_lw=None, thickness_up=None, \ - num_layers_lw=None, num_layers_up=None, use_pricel_lw=None, \ - use_pricel_up=None, is_layered_lw=None, is_layered_up=None, \ - elastic_constants_lw=None, elastic_constants_up=None, \ + def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ + thickness_up=None, num_layers_lw=None, num_layers_up=None, \ print_lattice_match_info=None, print_termination_info=None, \ print_shift_info=None, break_on_fail=None, icheck_match=None, \ - interface_idx=None, generate_structures=None, seed=None, - calc=None): + interface_idx=None, generate_structures=None, seed=None, verbose=None, \ + exit_code=None, calc=None): """ - generate__binding__artemis_interface_generator_type(self, basis_lw, basis_up[, \ - miller_lw, miller_up, surface_lw, surface_up, thickness_lw, thickness_up, \ - num_layers_lw, num_layers_up, use_pricel_lw, use_pricel_up, is_layered_lw, \ - is_layered_up, elastic_constants_lw, elastic_constants_up, \ + generate__binding__artemis_interface_generator_type(self[, surface_lw, \ + surface_up, thickness_lw, thickness_up, num_layers_lw, num_layers_up, \ print_lattice_match_info, print_termination_info, print_shift_info, \ - break_on_fail, icheck_match, interface_idx, generate_structures, seed]) + break_on_fail, icheck_match, interface_idx, generate_structures, seed, \ + verbose, exit_code]) Defined at \ @@ -1481,22 +1477,12 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ Parameters ---------- this : Artemis_Interface_Generator_Type - basis_lw : Basis_Type - basis_up : Basis_Type - miller_lw : int array - miller_up : int array surface_lw : int array surface_up : int array thickness_lw : float thickness_up : float num_layers_lw : int num_layers_up : int - use_pricel_lw : bool - use_pricel_up : bool - is_layered_lw : bool - is_layered_up : bool - elastic_constants_lw : float array - elastic_constants_up : float array print_lattice_match_info : bool print_termination_info : bool print_shift_info : bool @@ -1505,6 +1491,8 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ interface_idx : int generate_structures : bool seed : int + verbose : int + exit_code : int """ @@ -1518,20 +1506,15 @@ def generate(self, basis_lw, basis_up, miller_lw=None, miller_up=None, \ if isinstance(basis_up, Atoms): basis_up = geom_rw.basis(atoms=basis_up) - exit_code = _artemis.f90wrap_intf_gen__generate__binding__aigt(this=self._handle, \ - basis_lw=basis_lw._handle, basis_up=basis_up._handle, miller_lw=miller_lw, \ - miller_up=miller_up, surface_lw=surface_lw, surface_up=surface_up, \ - thickness_lw=thickness_lw, thickness_up=thickness_up, \ - num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, \ - use_pricel_lw=use_pricel_lw, use_pricel_up=use_pricel_up, \ - is_layered_lw=is_layered_lw, is_layered_up=is_layered_up, \ - elastic_constants_lw=elastic_constants_lw, \ - elastic_constants_up=elastic_constants_up, \ + exit_code = _artemis.f90wrap_artemis__interface_generator__generate__binding__ar04c1(this=self._handle, \ + surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, \ + thickness_up=thickness_up, num_layers_lw=num_layers_lw, \ + num_layers_up=num_layers_up, \ print_lattice_match_info=print_lattice_match_info, \ print_termination_info=print_termination_info, \ print_shift_info=print_shift_info, break_on_fail=break_on_fail, \ icheck_match=icheck_match, interface_idx=interface_idx, \ - generate_structures=generate_structures, seed=seed \ + generate_structures=generate_structures, seed=seed, verbose=verbose ) structures = self.get_structures(calc) @@ -1601,6 +1584,256 @@ def max_num_structures(self, max_num_structures): _raffle.f90wrap_artemis_intf_gen_type__set__max_num_structures(self._handle, \ max_num_structures) + @property + def structure_lw(self): + """ + Element structure_lw ftype=type(basis_type) pytype=Basis_Type + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 32 + + """ + structure_lw_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__get__structure_lw(self._handle) + if tuple(structure_lw_handle) in self._objs: + structure_lw = self._objs[tuple(structure_lw_handle)] + else: + structure_lw = artemis__geom_rw.basis_type.from_handle(structure_lw_handle) + self._objs[tuple(structure_lw_handle)] = structure_lw + return structure_lw + + @structure_lw.setter + def structure_lw(self, structure_lw): + structure_lw = structure_lw._handle + _artemis.f90wrap_artemis_interface_generator_type__set__structure_lw(self._handle, \ + structure_lw) + + @property + def structure_up(self): + """ + Element structure_up ftype=type(basis_type) pytype=Basis_Type + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 32 + + """ + structure_up_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__get__structure_up(self._handle) + if tuple(structure_up_handle) in self._objs: + structure_up = self._objs[tuple(structure_up_handle)] + else: + structure_up = artemis__geom_rw.basis_type.from_handle(structure_up_handle) + self._objs[tuple(structure_up_handle)] = structure_up + return structure_up + + @structure_up.setter + def structure_up(self, structure_up): + structure_up = structure_up._handle + _artemis.f90wrap_artemis_interface_generator_type__set__structure_up(self._handle, \ + structure_up) + + @property + def elastic_constants_lw(self): + """ + Element elastic_constants_lw ftype=real(real32) pytype=float + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 34 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__array__elastic_co4c3f(self._handle) + if array_handle in self._arrays: + elastic_constants_lw = self._arrays[array_handle] + else: + elastic_constants_lw = \ + f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_artemis_interface_generator_type__array__elastic_co4c3f) + self._arrays[array_handle] = elastic_constants_lw + return elastic_constants_lw + + @elastic_constants_lw.setter + def elastic_constants_lw(self, elastic_constants_lw): + self.elastic_constants_lw[...] = elastic_constants_lw + + @property + def elastic_constants_up(self): + """ + Element elastic_constants_up ftype=real(real32) pytype=float + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 34 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__array__elastic_coedb6(self._handle) + if array_handle in self._arrays: + elastic_constants_up = self._arrays[array_handle] + else: + elastic_constants_up = \ + f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_artemis_interface_generator_type__array__elastic_coedb6) + self._arrays[array_handle] = elastic_constants_up + return elastic_constants_up + + @elastic_constants_up.setter + def elastic_constants_up(self, elastic_constants_up): + self.elastic_constants_up[...] = elastic_constants_up + + @property + def use_pricel_lw(self): + """ + Element use_pricel_lw ftype=logical pytype=bool + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 36 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__use_pricel_lw(self._handle) + + @use_pricel_lw.setter + def use_pricel_lw(self, use_pricel_lw): + _artemis.f90wrap_artemis_interface_generator_type__set__use_pricel_lw(self._handle, \ + use_pricel_lw) + + @property + def use_pricel_up(self): + """ + Element use_pricel_up ftype=logical pytype=bool + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 36 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__use_pricel_up(self._handle) + + @use_pricel_up.setter + def use_pricel_up(self, use_pricel_up): + _artemis.f90wrap_artemis_interface_generator_type__set__use_pricel_up(self._handle, \ + use_pricel_up) + + @property + def miller_lw(self): + """ + Element miller_lw ftype=integer pytype=int + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 38 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_artemis_interface_generator_type__array__miller_lw(self._handle) + if array_handle in self._arrays: + miller_lw = self._arrays[array_handle] + else: + miller_lw = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_artemis_interface_generator_type__array__miller_lw) + self._arrays[array_handle] = miller_lw + return miller_lw + + @miller_lw.setter + def miller_lw(self, miller_lw): + self.miller_lw[...] = miller_lw + + @miller_up.setter + def miller_up(self, miller_up): + self.miller_up[...] = miller_up + + @property + def is_layered_lw(self): + """ + Element is_layered_lw ftype=logical pytype=bool + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 40 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__is_layered_lw(self._handle) + + @is_layered_lw.setter + def is_layered_lw(self, is_layered_lw): + _artemis.f90wrap_artemis_interface_generator_type__set__is_layered_lw(self._handle, \ + is_layered_lw) + + @property + def is_layered_up(self): + """ + Element is_layered_up ftype=logical pytype=bool + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 40 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__is_layered_up(self._handle) + + @is_layered_up.setter + def is_layered_up(self, is_layered_up): + _artemis.f90wrap_artemis_interface_generator_type__set__is_layered_up(self._handle, \ + is_layered_up) + + @property + def ludef_is_layered_lw(self): + """ + Element ludef_is_layered_lw ftype=logical pytype=bool + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 42 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__ludef_is_lay4aa6(self._handle) + + @ludef_is_layered_lw.setter + def ludef_is_layered_lw(self, ludef_is_layered_lw): + _artemis.f90wrap_artemis_interface_generator_type__set__ludef_is_lay87a5(self._handle, \ + ludef_is_layered_lw) + + @property + def ludef_is_layered_up(self): + """ + Element ludef_is_layered_up ftype=logical pytype=bool + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 42 + + """ + return \ + _artemis.f90wrap_artemis_interface_generator_type__get__ludef_is_lay60fd(self._handle) + + @ludef_is_layered_up.setter + def ludef_is_layered_up(self, ludef_is_layered_up): + _artemis.f90wrap_artemis_interface_generator_type__set__ludef_is_laye6e4(self._handle, \ + ludef_is_layered_up) + @property def shift_method(self): """ @@ -2025,7 +2258,35 @@ def _init_array_structures(self): def __str__(self): ret = ['{\n'] - ret.append(' shift_method : ') + ret.append(' num_structures : ') + ret.append(repr(self.num_structures)) + ret.append(',\n max_num_structures : ') + ret.append(repr(self.max_num_structures)) + ret.append('\n structure_lw : ') + ret.append(repr(self.structure_lw)) + ret.append(',\n structure_up : ') + ret.append(repr(self.structure_up)) + ret.append(',\n elastic_constants_lw : ') + ret.append(repr(self.elastic_constants_lw)) + ret.append(',\n elastic_constants_up : ') + ret.append(repr(self.elastic_constants_up)) + ret.append(',\n use_pricel_lw : ') + ret.append(repr(self.use_pricel_lw)) + ret.append(',\n use_pricel_up : ') + ret.append(repr(self.use_pricel_up)) + ret.append(',\n miller_lw : ') + ret.append(repr(self.miller_lw)) + ret.append(',\n miller_up : ') + ret.append(repr(self.miller_up)) + ret.append(',\n is_layered_lw : ') + ret.append(repr(self.is_layered_lw)) + ret.append(',\n is_layered_up : ') + ret.append(repr(self.is_layered_up)) + ret.append(',\n ludef_is_layered_lw : ') + ret.append(repr(self.ludef_is_layered_lw)) + ret.append(',\n ludef_is_layered_up : ') + ret.append(repr(self.ludef_is_layered_up)) + ret.append('\n shift_method : ') ret.append(repr(self.shift_method)) ret.append(',\n num_shifts : ') ret.append(repr(self.num_shifts)) diff --git a/src/fortran/lib/mod_intf_generator.f90 b/src/fortran/lib/mod_intf_generator.f90 index 7ad1caf..c78b032 100644 --- a/src/fortran/lib/mod_intf_generator.f90 +++ b/src/fortran/lib/mod_intf_generator.f90 @@ -10,7 +10,7 @@ module artemis__interface_generator use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type use artemis__geom_rw, only: basis_type,geom_write use lat_compare, only: get_best_match - use artemis__io_utils, only: err_abort, print_warning + use artemis__io_utils, only: err_abort, print_warning, stop_program use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: uvec,modu,get_area,inverse,cross use interface_identifier, only: intf_info_type,& @@ -33,6 +33,21 @@ module artemis__interface_generator type, extends(abstract_artemis_generator_type) :: artemis_interface_generator_type + !! Interface generator type + type(basis_type) :: structure_lw, structure_up + !! Lower and upper bulk structures + real(real32), dimension(:), allocatable :: elastic_constants_lw, elastic_constants_up + !! Elastic constants for the lower and upper bulk structures + logical :: use_pricel_lw = .true., use_pricel_up = .true. + !! Use primitive cell for lower and upper bulk structures + + integer, dimension(3) :: miller_lw = [ 0, 0, 0], miller_up = [ 0, 0, 0 ] + !! Miller indices for the lower and upper bulk structures + logical :: is_layered_lw = .false., is_layered_up = .false. + !! Boolean whether the lower and upper bulk structures are layered + logical :: ludef_is_layered_lw = .false., ludef_is_layered_up = .false. + !! Boolean whether the user defined whether to use layered structures + integer :: shift_method = 4 !! Shift method integer :: num_shifts = 5 @@ -73,9 +88,13 @@ module artemis__interface_generator !! Require mirror swaps integer :: match_method = 0 + !! Match method integer :: max_num_matches = 5 + !! Maximum number of matches integer :: max_num_terms = 5 + !! Maximum number of terminations integer :: max_num_planes = 10 + !! Maximum number of planes logical :: fix_normal = .true. !! compensate_strains_parallel = .true. !! Fix the lattice constants parallel to the interface normal vector @@ -83,18 +102,32 @@ module artemis__interface_generator !! Fix = false = relaxed (compensate for interfacial strain by extending/compressing) real(real32) :: bondlength_cutoff = 6._real32 + !! Maximum bond length cutoff for the bulk structures real(real32), dimension(2) :: layer_separation_cutoff = 1._real32 + !! Minimum separation between layers type(tol_type) :: tolerance + !! Tolerance structure - ! type(basis_type), dimension(:), allocatable :: term_structures_lw - ! type(basis_type), dimension(:), allocatable :: term_structures_up contains procedure, pass(this) :: set_tolerance + !! Set tolerance for identifying good lattice matches procedure, pass(this) :: set_shift_method + !! Set the shift method and associated data + procedure, pass(this) :: set_materials + !! Set the input materials for the interface generator + procedure, pass(this) :: set_surface_properties + !! Set the surface properties for the interface generator + procedure, pass(this) :: reset_is_layered_lw + !! Reset the is_layered flags for the lower bulk structure + procedure, pass(this) :: reset_is_layered_up + !! Reset the is_layered flags for the upper bulk structure procedure, pass(this) :: generate => generate_interfaces + !! Generate interfaces from two bulk structures procedure, pass(this) :: restart => generate_intefaces_from_existing + !! Generate interfaces from existing bulk structures procedure, pass(this) :: generate_perturbations => generate_shifts_and_swaps + !! Generate perturbations for the given basis end type artemis_interface_generator_type contains @@ -238,6 +271,130 @@ end subroutine set_shift_method !############################################################################### +!############################################################################### + subroutine set_materials( & + this, structure_lw, structure_up, & + elastic_constants_lw, elastic_constants_up, & + use_pricel_lw, use_pricel_up & + ) + !! Set the materials for the interface generator + implicit none + + ! Arguments + class(artemis_interface_generator_type), intent(inout) :: this + !! Instance of artemis generator type + type(basis_type), intent(in) :: structure_lw + !! Lower bulk structure + type(basis_type), intent(in) :: structure_up + !! Upper bulk structure + real(real32), dimension(:), intent(in), optional :: elastic_constants_lw + !! Elastic constants for the lower bulk structure + real(real32), dimension(:), intent(in), optional :: elastic_constants_up + !! Elastic constants for the upper bulk structure + logical, intent(in), optional :: use_pricel_lw + !! Use primitive cell for lower bulk structure + logical, intent(in), optional :: use_pricel_up + + ! Local variables + character(len=256) :: err_msg + + + this%structure_lw = structure_lw + this%structure_up = structure_up + + !--------------------------------------------------------------------------- + ! Handle the elastic constants + !--------------------------------------------------------------------------- + if(present(elastic_constants_lw))then + if(allocated(this%elastic_constants_lw)) deallocate(this%elastic_constants_lw) + allocate(this%elastic_constants_lw(size(elastic_constants_lw))) + this%elastic_constants_lw = elastic_constants_lw + end if + if(present(elastic_constants_up))then + if(allocated(this%elastic_constants_up)) deallocate(this%elastic_constants_up) + allocate(this%elastic_constants_up(size(elastic_constants_up))) + this%elastic_constants_up = elastic_constants_up + end if + + if(present(use_pricel_lw)) this%use_pricel_lw = use_pricel_lw + if(present(use_pricel_up)) this%use_pricel_up = use_pricel_up + + + end subroutine set_materials +!############################################################################### + + +!############################################################################### + subroutine set_surface_properties( & + this, & + miller_lw, miller_up, & + is_layered_lw, is_layered_up & + ) + !! Set the surface properties for the interface generator + implicit none + + ! Arguments + class(artemis_interface_generator_type), intent(inout) :: this + !! Instance of artemis generator type + integer, dimension(3), intent(in), optional :: miller_lw + !! Miller indices for the lower bulk structure + integer, dimension(3), intent(in), optional :: miller_up + !! Miller indices for the upper bulk structure + + logical, intent(in), optional :: is_layered_lw + !! Boolean whether the lower bulk structure is layered + logical, intent(in), optional :: is_layered_up + !! Boolean whether the upper bulk structure is layered + + + if(present(miller_lw)) this%miller_lw = miller_lw + if(present(miller_up)) this%miller_up = miller_up + + if(present(is_layered_lw))then + this%is_layered_lw = is_layered_lw + this%ludef_is_layered_lw = .true. + end if + if(present(is_layered_up))then + this%is_layered_up = is_layered_up + this%ludef_is_layered_up = .true. + end if + + end subroutine set_surface_properties +!############################################################################### + + +!############################################################################### + subroutine reset_is_layered_lw(this) + !! Reset the is_layered flags + implicit none + + ! Arguments + class(artemis_interface_generator_type), intent(inout) :: this + !! Instance of artemis generator type + + this%is_layered_lw = .false. + this%ludef_is_layered_lw = .false. + + end subroutine reset_is_layered_lw +!############################################################################### + + +!############################################################################### + subroutine reset_is_layered_up(this) + !! Reset the is_layered flags + implicit none + + ! Arguments + class(artemis_interface_generator_type), intent(inout) :: this + !! Instance of artemis generator type + + this%is_layered_up = .false. + this%ludef_is_layered_up = .false. + + end subroutine reset_is_layered_up +!############################################################################### + + !############################################################################### subroutine generate_intefaces_from_existing(this, basis, interface_location, & print_shift_info, seed & @@ -358,19 +515,15 @@ end subroutine generate_intefaces_from_existing !############################################################################### subroutine generate_interfaces( & - this, basis_lw, basis_up, & - miller_lw, miller_up, & + this, & surface_lw, surface_up, & thickness_lw, thickness_up, & num_layers_lw, num_layers_up, & - use_pricel_lw, use_pricel_up, & - is_layered_lw, is_layered_up, & - elastic_constants_lw, elastic_constants_up, & print_lattice_match_info, print_termination_info, print_shift_info, & break_on_fail, & icheck_match, interface_idx, & generate_structures, & - seed, exit_code & + seed, verbose, exit_code & ) !! Generate interfaces from two bulk structures implicit none @@ -378,14 +531,6 @@ subroutine generate_interfaces( & ! Arguments class(artemis_interface_generator_type), intent(inout) :: this !! Instance of artemis generator type - type(basis_type), intent(in) :: basis_lw - !! Lower bulk structure - type(basis_type), intent(in) :: basis_up - !! Upper bulk structure - integer, intent(in), optional :: miller_lw(3) - !! Miller indices for the lower bulk structure - integer, intent(in), optional :: miller_up(3) - !! Miller indices for the upper bulk structure integer, intent(in), dimension(:), optional :: surface_lw !! Surface indices for the lower bulk structure integer, intent(in), dimension(:), optional :: surface_up @@ -399,20 +544,6 @@ subroutine generate_interfaces( & integer, intent(in), optional :: num_layers_up !! Number of layers in the upper slab - logical, intent(in), optional :: use_pricel_lw - !! Use primitive cell for lower bulk structure - logical, intent(in), optional :: use_pricel_up - !! Use primitive cell for upper bulk structure - logical, intent(in), optional :: is_layered_lw - !! Boolean whether the lower bulk structure is layered - logical, intent(in), optional :: is_layered_up - !! Boolean whether the upper bulk structure is layered - - real(real32), dimension(:), intent(in), optional :: elastic_constants_lw - !! Elastic constants for the lower bulk structure - real(real32), dimension(:), intent(in), optional :: elastic_constants_up - !! Elastic constants for the upper bulk structure - logical, intent(in), optional :: break_on_fail !! Break on failure logical, intent(in), optional :: print_lattice_match_info @@ -429,6 +560,8 @@ subroutine generate_interfaces( & !! Boolean whether to generate structures or just print information integer, intent(in), optional :: seed !! Random seed for generating random numbers + integer, intent(in), optional :: verbose + !! Verbosity level integer, intent(out), optional :: exit_code !! Exit code for the function @@ -436,9 +569,7 @@ subroutine generate_interfaces( & real(real32) :: avg_min_bond !! Average minimum bond length - type(basis_type) :: basis_lw_, basis_up_ - !! Temporary basis structures - type(basis_type) :: supercell_lw, supercell_up + type(basis_type) :: structure_lw, structure_up, supercell_lw, supercell_up !! Copy of the basis structures type(basis_type) :: slab_lw, slab_up !! Slab structures @@ -465,14 +596,8 @@ subroutine generate_interfaces( & !! Thickness of the slab integer :: num_layers_lw_, num_layers_up_ !! Number of layers in the slab - logical :: use_pricel_lw_, use_pricel_up_ - !! Use primitive cell for lower and upper bulk structures - logical :: is_layered_lw_, is_layered_up_ - !! Boolean whether the bulk structures are layered - logical :: ludef_is_layered_lw, ludef_is_layered_up - !! Boolean whether the user defined whether to use layered structures - integer, dimension(3) :: miller_lw_, miller_up_ + integer, dimension(3) :: miller_lw, miller_up !! Miller indices for the lower and upper bulk structures integer, dimension(2) :: surface_lw_, surface_up_ !! Surface indices for the lower and upper bulk structures @@ -483,8 +608,9 @@ subroutine generate_interfaces( & logical :: break_on_fail_ !! Boolean whether to break on failure - logical :: print_lattice_match_info_, print_termination_info_, print_shift_info_ - !! Boolean whether to print lattice match, termination, and shift information + logical :: print_lattice_match_info_, print_termination_info_, & + print_shift_info_ + !! Boolean whether to print lattice match, termination, and shift info integer :: num_seed !! Number of seeds for the random number generator. integer, dimension(:), allocatable :: seed_arr @@ -496,29 +622,61 @@ subroutine generate_interfaces( & logical :: generate_structures_ !! Boolean whether to generate structures or just print information - real(real32), dimension(:), allocatable :: elastic_constants_lw_, elastic_constants_up_ - !! Elastic constants for the lower and upper bulk structures - - type(bulk_DON_type), dimension(2) :: bulk_DON - !! Distribution functions for the lower and upper bulk structures - integer :: ntrans,iunique,itmp1,old_intf - integer :: layered_axis_lw,layered_axis_up + integer :: ntrans, iunique, itmp1, num_structures_old + integer :: layered_axis_lw, layered_axis_up real(real32) :: dtmp1,bondlength character(3) :: abc - character(1024) :: pwd,intf_dir,dirpath,msg + character(1024) :: pwd, intf_dir, dirpath, msg type(confine_type) :: confine type(latmatch_type) :: SAV - type(term_arr_type) :: lw_term,up_term + type(term_arr_type) :: lw_term, up_term integer, dimension(3) :: ivtmp1 real(real32), dimension(2) :: intf_loc - real(real32), dimension(3) :: init_offset = [0._real32,0._real32,2._real32] - !real(real32), dimension(3,3) :: mtmp1,DONsupercell_up%lat + real(real32), dimension(3) :: init_offset real(real32), dimension(3,3) :: tfmat - integer, allocatable, dimension(:,:,:) :: lw_map,t1lw_map,t2lw_map - integer, allocatable, dimension(:,:,:) :: up_map,t1up_map,t2up_map + !! Transformation matrix + type(bulk_DON_type), dimension(2) :: bulk_DON + !! Distribution functions for the lower and upper bulk structures + integer, allocatable, dimension(:,:,:) :: lw_map, t1lw_map, t2lw_map + integer, allocatable, dimension(:,:,:) :: up_map, t1up_map, t2up_map real(real32), allocatable, dimension(:,:) :: trans + integer :: exit_code_ + !! Exit code for the function + integer :: verbose_ + !! Verbosity level + + + !--------------------------------------------------------------------------- + ! Initialise variables + !--------------------------------------------------------------------------- + exit_code_ = 0 + verbose_ = 0 + if(present(verbose)) verbose_ = verbose + + icheck_match_ = -1; interface_idx_ = -1 + if(present(icheck_match)) icheck_match_ = icheck_match + if(present(interface_idx)) interface_idx_ = interface_idx + + break_on_fail_ = .true. + if(present(break_on_fail)) break_on_fail_ = break_on_fail + + generate_structures_ = .true. + if(present(generate_structures)) generate_structures_ = generate_structures + + print_lattice_match_info_ = .false. + print_termination_info_ = .false. + print_shift_info_ = .false. + if(present(print_lattice_match_info)) & + print_lattice_match_info_ = print_lattice_match_info + if(present(print_termination_info)) & + print_termination_info_ = print_termination_info + if(present(print_shift_info)) print_shift_info_ = print_shift_info + + init_offset = [0._real32,0._real32,2._real32] + if(.not.allocated(this%shifts)) call this%set_shift_method() + !--------------------------------------------------------------------------- ! Set the random seed @@ -533,69 +691,57 @@ subroutine generate_interfaces( & allocate(seed_arr(num_seed)) call random_seed(get=seed_arr) end if - icheck_match_ = -1; interface_idx_ = -1 - if(present(icheck_match)) icheck_match_ = icheck_match - if(present(interface_idx)) interface_idx_ = interface_idx - break_on_fail_ = .true. - if(present(break_on_fail)) break_on_fail_ = break_on_fail - generate_structures_ = .true. - if(present(generate_structures)) generate_structures_ = generate_structures - - if(.not.allocated(this%shifts)) call this%set_shift_method() !--------------------------------------------------------------------------- - ! Handle the elastic constants + ! Check if the structures are valid !--------------------------------------------------------------------------- - if(present(elastic_constants_lw))then - if(allocated(elastic_constants_lw_)) deallocate(elastic_constants_lw_) - allocate(elastic_constants_lw_(size(elastic_constants_lw))) - elastic_constants_lw_ = elastic_constants_lw - else - if(allocated(elastic_constants_lw_)) deallocate(elastic_constants_lw_) - allocate(elastic_constants_lw_(1)) - elastic_constants_lw_ = 0._real32 + ! check if the structures have anything (i.e. atoms) in them + if(this%structure_lw%natom.eq.0)then + write(err_msg,'(A,I0,A)') & + "ERROR: The lower structure has ", this%structure_lw%natom, & + " atoms. It should have at least 1." + call err_abort(trim(err_msg),fmtd=.true.) + return end if - if(present(elastic_constants_up))then - if(allocated(elastic_constants_up_)) deallocate(elastic_constants_up_) - allocate(elastic_constants_up_(size(elastic_constants_up))) - elastic_constants_up_ = elastic_constants_up - else - if(allocated(elastic_constants_up_)) deallocate(elastic_constants_up_) - allocate(elastic_constants_up_(1)) - elastic_constants_up_ = 0._real32 + if(this%structure_up%natom.eq.0)then + write(err_msg,'(A,I0,A)') & + "ERROR: The upper structure has ", this%structure_lw%natom, & + " atoms. It should have at least 1." + call err_abort(trim(err_msg),fmtd=.true.) + return end if + call structure_lw%copy(this%structure_lw, length=4) + call structure_up%copy(this%structure_up, length=4) + if(.not.allocated(this%structures)) allocate(this%structures(0)) -!!!----------------------------------------------------------------------------- -!!! determines the primitive and niggli reduced cell for each bulk -!!!----------------------------------------------------------------------------- - call basis_lw_%copy(basis_lw, length=4) - call basis_up_%copy(basis_up, length=4) - write(*,*) - use_pricel_lw_ = .false. - use_pricel_up_ = .false. - if(present(use_pricel_lw)) use_pricel_lw_ = use_pricel_lw - if(present(use_pricel_up)) use_pricel_up_ = use_pricel_up - if(use_pricel_lw_)then + !--------------------------------------------------------------------------- + ! Retrieve the primitive cells if necessary + !--------------------------------------------------------------------------- + if(this%use_pricel_lw)then write(*,'(1X,"Using primitive cell for lower material")') - call get_primitive_cell(basis_lw_) + call get_primitive_cell(structure_lw) else write(*,'(1X,"Using supplied cell for lower material")') - call reducer(basis_lw_) - basis_lw_%lat=primitive_lat(basis_lw_%lat) + call reducer(structure_lw) + structure_lw%lat=primitive_lat(structure_lw%lat) end if - if(use_pricel_up_)then + if(this%use_pricel_up)then write(*,'(1X,"Using primitive cell for upper material")') - call get_primitive_cell(basis_up_) + call get_primitive_cell(structure_up) else write(*,'(1X,"Using supplied cell for upper material")') - call reducer(basis_up_) - basis_up_%lat=primitive_lat(basis_up_%lat) + call reducer(structure_up) + structure_up%lat=primitive_lat(structure_up%lat) end if - write(*,*) + !--------------------------------------------------------------------------- + ! Handle surface properties + !--------------------------------------------------------------------------- + miller_lw = this%miller_lw + miller_up = this%miller_up surface_lw_ = 0 surface_up_ = 0 if(present(surface_lw))then @@ -630,20 +776,6 @@ subroutine generate_interfaces( & if(all(surface_lw_.gt.0)) ludef_surface_lw = .true. if(all(surface_up_.gt.0)) ludef_surface_up = .true. - miller_lw_ = 0 - miller_up_ = 0 - if(present(miller_lw)) miller_lw_ = miller_lw - if(present(miller_up)) miller_up_ = miller_up - - print_lattice_match_info_ = .false. - print_termination_info_ = .false. - print_shift_info_ = .false. - if(present(print_lattice_match_info)) print_lattice_match_info_ = print_lattice_match_info - if(present(print_termination_info)) print_termination_info_ = print_termination_info - if(present(print_shift_info)) print_shift_info_ = print_shift_info - - if(.not.allocated(this%structures)) allocate(this%structures(0)) - thickness_lw_ = 10._real32 thickness_up_ = 10._real32 num_layers_lw_ = 0 @@ -668,24 +800,28 @@ subroutine generate_interfaces( & end if -!!!----------------------------------------------------------------------------- -!!! investigates individual bulks and their bondlengths -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Get the average bond length + !--------------------------------------------------------------------------- avg_min_bond = & - ( get_min_bulk_bond(basis_lw_) + get_min_bulk_bond(basis_up_) )/2._real32 + ( & + get_min_bulk_bond(structure_lw) + & + get_min_bulk_bond(structure_up) & + ) / 2._real32 write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond write(*,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale - if(this%shift_method.eq.-1) this%num_shifts=1 + if(this%shift_method.eq.-1) this%num_shifts = 1 -!!!----------------------------------------------------------------------------- -!!! gets bulk DONs, if shift_method = 4 -!!!----------------------------------------------------------------------------- - allocate(lw_map(basis_lw_%nspec,maxval(basis_lw_%spec(:)%num,dim=1),2)) - allocate(up_map(basis_up_%nspec,maxval(basis_up_%spec(:)%num,dim=1),2)) + !--------------------------------------------------------------------------- + ! Gets bulk distribution functions (i.e. densities of neighbours) + ! ... if shift_method = 4 + !--------------------------------------------------------------------------- + allocate(lw_map(structure_lw%nspec,maxval(structure_lw%spec(:)%num,dim=1),2)) + allocate(up_map(structure_up%nspec,maxval(structure_up%spec(:)%num,dim=1),2)) if(this%shift_method.eq.4.or.this%shift_method.eq.0)then lw_map=0 - bulk_DON(1)%spec=gen_DON(basis_lw_%lat,basis_lw_,& + bulk_DON(1)%spec=gen_DON(structure_lw%lat,structure_lw,& dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) @@ -716,7 +852,7 @@ subroutine generate_interfaces( & end if end do up_map=0 - bulk_DON(2)%spec=gen_DON(basis_up_%lat,basis_up_,& + bulk_DON(2)%spec=gen_DON(structure_up%lat,structure_up,& dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) @@ -752,31 +888,14 @@ subroutine generate_interfaces( & end if -!!!----------------------------------------------------------------------------- -!!! checks whether system appears layered -!!!----------------------------------------------------------------------------- - if(present(is_layered_lw))then - is_layered_lw_ = is_layered_lw - ludef_is_layered_lw = .true. - else - is_layered_lw_ = .false. - ludef_is_layered_lw = .false. - end if - if(present(is_layered_up))then - is_layered_up_ = is_layered_up - ludef_is_layered_up = .true. - else - is_layered_up_ = .false. - ludef_is_layered_up = .false. - end if - - - - layered_axis_lw=get_layered_axis(basis_lw_%lat,basis_lw_) - if(.not.is_layered_lw_.and.layered_axis_lw.gt.0)then - ivtmp1=0 + !--------------------------------------------------------------------------- + ! Check whether system appears layered + !--------------------------------------------------------------------------- + layered_axis_lw = get_layered_axis( structure_lw%lat, structure_lw ) + if(.not.this%is_layered_lw.and.layered_axis_lw.gt.0)then + ivtmp1 = 0 ivtmp1(layered_axis_lw)=1 - if(ludef_is_layered_lw)then + if(this%ludef_is_layered_lw)then write(msg,'("Lower crystal appears layered along axis ",I0,"\n& &Partial layer terminations will be generated\n& &We suggest using LW_MILLER =",3(1X,I1))') layered_axis_lw,ivtmp1 @@ -787,18 +906,18 @@ subroutine generate_interfaces( & &If you don''t want this, set\nLW_LAYERED = .FALSE.")') & ivtmp1 call print_warning(trim(msg)) - miller_lw_=ivtmp1 - is_layered_lw_=.true. + miller_lw=ivtmp1 + this%is_layered_lw=.true. end if - elseif(is_layered_lw_.and.layered_axis_lw.gt.0.and.all(miller_lw_.eq.0))then - miller_lw_(layered_axis_lw)=1 + elseif(this%is_layered_lw.and.layered_axis_lw.gt.0.and.all(miller_lw.eq.0))then + miller_lw(layered_axis_lw)=1 end if - layered_axis_up=get_layered_axis(basis_up_%lat,basis_up_) - if(.not.is_layered_up_.and.layered_axis_up.gt.0)then + layered_axis_up = get_layered_axis( structure_up%lat, structure_up ) + if(.not.this%is_layered_up.and.layered_axis_up.gt.0)then ivtmp1=0 ivtmp1(layered_axis_up)=1 - if(ludef_is_layered_up)then + if(this%ludef_is_layered_up)then write(msg,'("Upper crystal appears layered along axis ",I0,"\n& &Partial layer terminations will be generated\n& &We suggest using UP_MILLER =",3(1X,I1))') layered_axis_up,ivtmp1 @@ -809,21 +928,20 @@ subroutine generate_interfaces( & &If you don''t want this, set\nUP_LAYERED = .FALSE.")') & ivtmp1 call print_warning(trim(msg)) - miller_up_=ivtmp1 - is_layered_up_=.true. + miller_up=ivtmp1 + this%is_layered_up=.true. end if - elseif(is_layered_up_.and.layered_axis_up.gt.0.and.all(miller_up_.eq.0))then - miller_up_(layered_axis_up)=1 + elseif(this%is_layered_up.and.layered_axis_up.gt.0.and.all(miller_up.eq.0))then + miller_up(layered_axis_up)=1 end if -!!!----------------------------------------------------------------------------- -!!! Finds and stores the best matches between the materials -!!!----------------------------------------------------------------------------- - ! call getcwd(pwd) - old_intf = -1 + !--------------------------------------------------------------------------- + ! Finds and stores the best matches between the materials + !--------------------------------------------------------------------------- + num_structures_old = -1 abc="abc" - if(this%match_method.ne.0.and.(any(miller_lw_.ne.0).or.any(miller_up_.ne.0)))then + if(this%match_method.ne.0.and.(any(miller_lw.ne.0).or.any(miller_up.ne.0)))then call err_abort( '& &Cannot use LW_MILLER or UP_MILLER with IMATCH>0\n& Exiting...', & @@ -840,38 +958,38 @@ subroutine generate_interfaces( & &")') call print_warning(trim(msg)) end if - if(any(miller_lw_.ne.0))then + if(any(miller_lw.ne.0))then if(this%match_method.ne.0)then abc="ab" - tfmat=planecutter(basis_lw_%lat,real(miller_lw_,real32)) - call transformer(basis_lw_,tfmat,lw_map) + tfmat=planecutter(structure_lw%lat,real(miller_lw,real32)) + call transformer(structure_lw,tfmat,lw_map) SAV=get_best_match(& this%tolerance,& - basis_lw_,basis_up_,& + structure_lw,structure_up,& trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method) - elseif(any(miller_up_.ne.0))then + elseif(any(miller_up.ne.0))then SAV=get_best_match(& this%tolerance,& - basis_lw_,basis_up_,& + structure_lw,structure_up,& trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& - plane1=miller_lw_,plane2=miller_up_,nmiller=this%max_num_planes) + plane1=miller_lw,plane2=miller_up,nmiller=this%max_num_planes) else SAV=get_best_match(& this%tolerance,& - basis_lw_,basis_up_,& + structure_lw,structure_up,& trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& - plane1=miller_lw_,nmiller=this%max_num_planes) + plane1=miller_lw,nmiller=this%max_num_planes) end if - elseif(any(miller_up_.ne.0))then + elseif(any(miller_up.ne.0))then SAV=get_best_match(& this%tolerance,& - basis_lw_,basis_up_,& + structure_lw,structure_up,& trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& - plane2=miller_up_,nmiller=this%max_num_planes) + plane2=miller_up,nmiller=this%max_num_planes) else SAV=get_best_match(& this%tolerance,& - basis_lw_,basis_up_,& + structure_lw,structure_up,& trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& nmiller=this%max_num_planes) end if @@ -913,8 +1031,8 @@ subroutine generate_interfaces( & !!!----------------------------------------------------------------------------- intf_loop: do ifit = intf_start, intf_end write(*,'("Fit number: ",I0)') ifit - call supercell_lw%copy(basis_lw_) - call supercell_up%copy(basis_up_) + call supercell_lw%copy(structure_lw) + call supercell_up%copy(structure_up) if(allocated(t1lw_map)) deallocate(t1lw_map) if(allocated(t1up_map)) deallocate(t1up_map) allocate(t1lw_map,source=lw_map) @@ -957,7 +1075,7 @@ subroutine generate_interfaces( & dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) - !call err_abort_print_struc(basis_up_,"bulk_up_term.vasp",& + !call err_abort_print_struc(structure_up,"bulk_up_term.vasp",& ! "",.false.) end if @@ -986,7 +1104,7 @@ subroutine generate_interfaces( & end if if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 call transformer(supercell_lw,tfmat,t1lw_map) - if(.not.compare_stoichiometry(basis_lw_,supercell_lw))then + if(.not.compare_stoichiometry(structure_lw,supercell_lw))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the lower material on match ",I0)') ifit if(ierror.eq.1)then @@ -1067,7 +1185,7 @@ subroutine generate_interfaces( & if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 call transformer(supercell_up,tfmat,t1up_map) ! check the stoichiometry ratios are still maintained - if(.not.compare_stoichiometry(basis_up_,supercell_up))then + if(.not.compare_stoichiometry(structure_up,supercell_up))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the upper material on match ",I0)') ifit if(ierror.eq.1)then @@ -1170,24 +1288,24 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------- !! Checks stoichiometry !!----------------------------------------------------------------- - if(slab_lw%nspec.ne.basis_lw_%nspec.or.any(& - (basis_lw_%spec(1)%num*slab_lw%spec(:)%num)& - /slab_lw%spec(1)%num.ne.basis_lw_%spec(:)%num))then + if(slab_lw%nspec.ne.structure_lw%nspec.or.any(& + (structure_lw%spec(1)%num*slab_lw%spec(:)%num)& + /slab_lw%spec(1)%num.ne.structure_lw%spec(:)%num))then write(*,'("WARNING: This lower surface termination is not & &stoichiometric")') - if(is_layered_lw_)then + if(this%is_layered_lw)then write(*,'(2X,"As lower structure is layered, stoichiometric & &surfaces are required.")') write(*,'(2X,"Skipping this termination...")') cycle lw_term_loop end if end if - if(slab_up%nspec.ne.basis_up_%nspec.or.any(& - (basis_up_%spec(1)%num*slab_up%spec(:)%num)& - /slab_up%spec(1)%num.ne.basis_up_%spec(:)%num))then + if(slab_up%nspec.ne.structure_up%nspec.or.any(& + (structure_up%spec(1)%num*slab_up%spec(:)%num)& + /slab_up%spec(1)%num.ne.structure_up%spec(:)%num))then write(*,'("WARNING: This upper surface termination is not & &stoichiometric")') - if(is_layered_up_)then + if(this%is_layered_up)then write(*,'(2X,"As upper structure is layered, stoichiometric & &surfaces are required.")') write(*,'(2X,"Skipping this termination...")') @@ -1196,23 +1314,43 @@ subroutine generate_interfaces( & end if - !!----------------------------------------------------------------- - !! Use the bulk moduli to determine the strain sharing - !!----------------------------------------------------------------- - if( all(abs(elastic_constants_lw_).gt.0.E0) .and. & - all(abs(elastic_constants_up_).gt.0.E0) & - )then - call share_strain(slab_lw%lat,slab_up%lat,& - elastic_constants_lw_(1), & - elastic_constants_up_(1), & - lcompensate = .not.this%fix_normal & - ) + !------------------------------------------------------------------ + ! Use the bulk moduli to determine the strain sharing + !------------------------------------------------------------------ + if(allocated(this%elastic_constants_lw).and. & + allocated(this%elastic_constants_up))then + select case(size(this%elastic_constants_lw)) + case(1) + if( abs(this%elastic_constants_lw(1)).gt.0.E0 .and. & + abs(this%elastic_constants_up(1)).gt.0.E0 & + )then + call share_strain(slab_lw%lat,slab_up%lat,& + this%elastic_constants_lw(1), & + this%elastic_constants_up(1), & + lcompensate = .not.this%fix_normal & + ) + end if + case default + write(err_msg,'("Elastic constants not yet set up to handle & + &the full tensor.")') + call stop_program(trim(err_msg)) + exit_code_ = 1 + return + end select + elseif(allocated(this%elastic_constants_lw).neqv. & + allocated(this%elastic_constants_up))then + write(err_msg,'(A)') & + "Elastic constants not set up for both materials." + call stop_program(trim(err_msg)) + exit_code_ = 1 + return end if - - !!----------------------------------------------------------------- - !! Merge the two bases and lattices and define the interface loc - !!----------------------------------------------------------------- + + + !------------------------------------------------------------------ + ! Merge the two bases and lattices and define the interface loc + !------------------------------------------------------------------ intf_basis = basis_stack(& basis1 = slab_lw, basis2 = slab_up, & axis = this%axis, offset = init_offset(:), & @@ -1240,33 +1378,24 @@ subroutine generate_interfaces( & end if - !!----------------------------------------------------------------- - !! Saves current directory and moves to new directory - !!----------------------------------------------------------------- - if(this%num_structures.gt.old_intf)then - iunique=iunique+1 - ! if(this%shift_method.gt.0.and.this%num_shifts.gt.1) & - ! write(*,'(1X,"Generating shifts for unique interface ",& - ! &I0,":")') iunique - ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique - ! call system('mkdir -p '//trim(adjustl(dirpath))) - else - ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),iunique - end if - ! call chdir(dirpath) - old_intf = this%num_structures + + !------------------------------------------------------------------ + ! Saves current directory and moves to new directory + !------------------------------------------------------------------ + if(this%num_structures.gt.num_structures_old) iunique = iunique + 1 + num_structures_old = this%num_structures - !!----------------------------------------------------------------- - !! Writes information of current match to file in save directory - !!----------------------------------------------------------------- + !------------------------------------------------------------------ + ! Write information of current match to file in save directory + !------------------------------------------------------------------ call output_intf_data(SAV, ifit, lw_term, iterm_lw, up_term, iterm_up,& - use_pricel_lw_,use_pricel_up_) + this%use_pricel_lw, this%use_pricel_up) - !!----------------------------------------------------------------- - !! Generates shifts and swaps and prints the subsequent structures - !!----------------------------------------------------------------- + !------------------------------------------------------------------ + ! Generate shifts and swaps and prints the subsequent structures + !------------------------------------------------------------------ call this%generate_perturbations( & intf_basis, intf_loc, avg_min_bond, & bulk_DON, & @@ -1276,24 +1405,14 @@ subroutine generate_interfaces( & ) if(this%num_structures.ge.this%max_num_structures) exit intf_loop - !call chdir(dirname) - ! call chdir(intf_dir) if(ludef_surface_up) exit up_term_loop end do up_term_loop if(ludef_surface_lw) exit lw_term_loop end do lw_term_loop - !!----------------------------------------------------------------------- - !! Returns to working directory - !!----------------------------------------------------------------------- - ! call chdir(intf_dir) end do intf_loop - ! call chdir(pwd) - - - return end subroutine generate_interfaces !############################################################################### diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 62cf480..7ce5a34 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -54,6 +54,7 @@ module artemis__misc_types contains procedure, pass(this) :: write_structures procedure, pass(this) :: get_structures + procedure, pass(this) :: set_structures end type abstract_artemis_generator_type @@ -127,4 +128,20 @@ function get_structures(this) result(structures) end function get_structures !############################################################################### + +!############################################################################### + subroutine set_structures(this, structures) + !! Set the generated structures. + implicit none + ! Arguments + class(abstract_artemis_generator_type), intent(inout) :: this + !! Instance of the raffle generator. + type(basis_type), dimension(:), allocatable :: structures + !! Generated structures. + + this%structures = structures + this%num_structures = size(structures) + end subroutine set_structures +!############################################################################### + end module artemis__misc_types diff --git a/src/wrapper/f90wrap_mod_intf_generator.f90 b/src/wrapper/f90wrap_mod_intf_generator.f90 index 0ea5600..e63c498 100644 --- a/src/wrapper/f90wrap_mod_intf_generator.f90 +++ b/src/wrapper/f90wrap_mod_intf_generator.f90 @@ -56,6 +56,331 @@ subroutine f90wrap_artemis_intf_gen_type__set__max_num_structures(this, f90wrap_ this_ptr%p%max_num_structures = f90wrap_max_num_structures end subroutine f90wrap_artemis_intf_gen_type__set__max_num_structures + +subroutine f90wrap_artemis_intf_gen_type__get__structure_lw(this, f90wrap_structure_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_structure_lw(2) + type(basis_type_ptr_type) :: structure_lw_ptr + + this_ptr = transfer(this, this_ptr) + structure_lw_ptr%p => this_ptr%p%structure_lw + f90wrap_structure_lw = transfer(structure_lw_ptr,f90wrap_structure_lw) +end subroutine f90wrap_artemis_intf_gen_type__get__structure_lw + +subroutine f90wrap_artemis_intf_gen_type__set__structure_lw(this, f90wrap_structure_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_structure_lw(2) + type(basis_type_ptr_type) :: structure_lw_ptr + + this_ptr = transfer(this, this_ptr) + structure_lw_ptr = transfer(f90wrap_structure_lw,structure_lw_ptr) + this_ptr%p%structure_lw = structure_lw_ptr%p +end subroutine f90wrap_artemis_intf_gen_type__set__structure_lw + +subroutine f90wrap_artemis_intf_gen_type__get__structure_up(this, f90wrap_structure_up) + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_structure_up(2) + type(basis_type_ptr_type) :: structure_up_ptr + + this_ptr = transfer(this, this_ptr) + structure_up_ptr%p => this_ptr%p%structure_up + f90wrap_structure_up = transfer(structure_up_ptr,f90wrap_structure_up) +end subroutine f90wrap_artemis_intf_gen_type__get__structure_up + +subroutine f90wrap_artemis_intf_gen_type__set__structure_up(this, f90wrap_structure_up) + use artemis__interface_generator, only: artemis_interface_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_structure_up(2) + type(basis_type_ptr_type) :: structure_up_ptr + + this_ptr = transfer(this, this_ptr) + structure_up_ptr = transfer(f90wrap_structure_up,structure_up_ptr) + this_ptr%p%structure_up = structure_up_ptr%p +end subroutine f90wrap_artemis_intf_gen_type__set__structure_up + +subroutine f90wrap_artemis_intf_gen_type__array__elastic_co4c3f(this, nd, dtype, dshape, dloc) + use artemis__interface_generator, only: artemis_interface_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_interface_generator_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) + if (allocated(this_ptr%p%elastic_constants_lw)) then + dshape(1:1) = shape(this_ptr%p%elastic_constants_lw) + dloc = loc(this_ptr%p%elastic_constants_lw) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_intf_gen_type__array__elastic_co4c3f + +subroutine f90wrap_artemis_intf_gen_type__array__elastic_coedb6(this, nd, dtype, dshape, dloc) + use artemis__interface_generator, only: artemis_interface_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_interface_generator_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) + if (allocated(this_ptr%p%elastic_constants_up)) then + dshape(1:1) = shape(this_ptr%p%elastic_constants_up) + dloc = loc(this_ptr%p%elastic_constants_up) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_intf_gen_type__array__elastic_coedb6 + +subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_lw(this, f90wrap_use_pricel_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_use_pricel_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_use_pricel_lw = this_ptr%p%use_pricel_lw +end subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_lw + +subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_lw(this, f90wrap_use_pricel_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_use_pricel_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%use_pricel_lw = f90wrap_use_pricel_lw +end subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_lw + +subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_up(this, f90wrap_use_pricel_up) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_use_pricel_up + + this_ptr = transfer(this, this_ptr) + f90wrap_use_pricel_up = this_ptr%p%use_pricel_up +end subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_up + +subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_up(this, f90wrap_use_pricel_up) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_use_pricel_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%use_pricel_up = f90wrap_use_pricel_up +end subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_up + +subroutine f90wrap_artemis_intf_gen_type__array__miller_lw(this, nd, dtype, dshape, dloc) + use artemis__interface_generator, only: artemis_interface_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_interface_generator_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%miller_lw) + dloc = loc(this_ptr%p%miller_lw) +end subroutine f90wrap_artemis_intf_gen_type__array__miller_lw + +subroutine f90wrap_artemis_intf_gen_type__get__is_layered_lw(this, f90wrap_is_layered_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_is_layered_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_is_layered_lw = this_ptr%p%is_layered_lw +end subroutine f90wrap_artemis_intf_gen_type__get__is_layered_lw + +subroutine f90wrap_artemis_intf_gen_type__set__is_layered_lw(this, f90wrap_is_layered_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_is_layered_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%is_layered_lw = f90wrap_is_layered_lw +end subroutine f90wrap_artemis_intf_gen_type__set__is_layered_lw + +subroutine f90wrap_artemis_intf_gen_type__get__is_layered_up(this, f90wrap_is_layered_up) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_is_layered_up + + this_ptr = transfer(this, this_ptr) + f90wrap_is_layered_up = this_ptr%p%is_layered_up +end subroutine f90wrap_artemis_intf_gen_type__get__is_layered_up + +subroutine f90wrap_artemis_intf_gen_type__set__is_layered_up(this, f90wrap_is_layered_up) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_is_layered_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%is_layered_up = f90wrap_is_layered_up +end subroutine f90wrap_artemis_intf_gen_type__set__is_layered_up + +subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay4aa6(this, f90wrap_ludef_is_layered_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_ludef_is_layered_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_ludef_is_layered_lw = this_ptr%p%ludef_is_layered_lw +end subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay4aa6 + +subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_lay87a5(this, f90wrap_ludef_is_layered_lw) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_ludef_is_layered_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%ludef_is_layered_lw = f90wrap_ludef_is_layered_lw +end subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_lay87a5 + +subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay60fd(this, f90wrap_ludef_is_layered_up) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_ludef_is_layered_up + + this_ptr = transfer(this, this_ptr) + f90wrap_ludef_is_layered_up = this_ptr%p%ludef_is_layered_up +end subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay60fd + +subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_laye6e4(this, f90wrap_ludef_is_layered_up) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_interface_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_ludef_is_layered_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%ludef_is_layered_up = f90wrap_ludef_is_layered_up +end subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_laye6e4 + + + + + + subroutine f90wrap_artemis_intf_gen_type__get__shift_method(this, f90wrap_shift_method) use artemis__interface_generator, only: artemis_interface_generator_type implicit none @@ -684,17 +1009,8 @@ subroutine f90wrap_intf_gen__set_shift_method__bin4dc1(this, method, num_shifts, separation_scale=separation_scale, depth_method=depth_method) end subroutine f90wrap_intf_gen__set_shift_method__bin4dc1 -subroutine f90wrap_intf_gen__generate__binding__aigt( & - this, basis_lw, basis_up, miller_lw, & - miller_up, surface_lw, surface_up, & - thickness_lw, thickness_up, & - num_layers_lw, num_layers_up, & - use_pricel_lw, use_pricel_up, & - is_layered_lw, is_layered_up, & - elastic_constants_lw, elastic_constants_up, & - print_lattice_match_info, print_termination_info, print_shift_info, & - break_on_fail, icheck_match, interface_idx, generate_structures, seed, exit_code, & - n0, n1, n2, n3) +subroutine f90wrap_intf_gen__set_materials__bindin017c(this, structure_lw, structure_up, & + elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) use artemis__interface_generator, only: artemis_interface_generator_type use artemis__geom_rw, only: basis_type implicit none @@ -707,24 +1023,104 @@ subroutine f90wrap_intf_gen__generate__binding__aigt( & end type artemis_interface_generator_type_ptr_type type(artemis_interface_generator_type_ptr_type) :: this_ptr integer, intent(in), dimension(2) :: this - type(basis_type_ptr_type) :: basis_lw_ptr - integer, intent(in), dimension(2) :: basis_lw - type(basis_type_ptr_type) :: basis_up_ptr - integer, intent(in), dimension(2) :: basis_up - integer, intent(in), optional, dimension(3) :: miller_lw - integer, intent(in), optional, dimension(3) :: miller_up + type(basis_type_ptr_type) :: structure_lw_ptr + integer, intent(in), dimension(2) :: structure_lw + type(basis_type_ptr_type) :: structure_up_ptr + integer, intent(in), dimension(2) :: structure_up + real(4), intent(in), optional, dimension(n0) :: elastic_constants_lw + real(4), intent(in), optional, dimension(n1) :: elastic_constants_up + logical, intent(in), optional :: use_pricel_lw + logical, intent(in), optional :: use_pricel_up + integer :: n0 + !f2py intent(hide), depend(elastic_constants_lw) :: n0 = shape(elastic_constants_lw,0) + integer :: n1 + !f2py intent(hide), depend(elastic_constants_up) :: n1 = shape(elastic_constants_up,0) + this_ptr = transfer(this, this_ptr) + structure_lw_ptr = transfer(structure_lw, structure_lw_ptr) + structure_up_ptr = transfer(structure_up, structure_up_ptr) + call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & + elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & + use_pricel_up=use_pricel_up) +end subroutine f90wrap_intf_gen__set_materials__bindin017c + +subroutine f90wrap_intf_gen__set_surface_propertie615d(this, miller_lw, miller_up, is_layered_lw, & + is_layered_up) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, dimension(3), intent(in), optional :: miller_lw + integer, dimension(3), intent(in), optional :: miller_up + logical, intent(in), optional :: is_layered_lw + logical, intent(in), optional :: is_layered_up + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_surface_properties(miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, & + is_layered_up=is_layered_up) +end subroutine f90wrap_intf_gen__set_surface_propertie615d + +subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8(this) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%reset_is_layered_lw() +end subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8 + +subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c(this) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%reset_is_layered_up() +end subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c + + + + + + + + + + + +subroutine f90wrap_intf_gen__generate__binding__aigt( & + this, surface_lw, surface_up, & + thickness_lw, thickness_up, & + num_layers_lw, num_layers_up, & + print_lattice_match_info, print_termination_info, print_shift_info, & + break_on_fail, icheck_match, interface_idx, & + generate_structures, & + seed, verbose, exit_code, & + n0, n1) + use artemis__interface_generator, only: artemis_interface_generator_type + implicit none + + type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type), pointer :: p => NULL() + end type artemis_interface_generator_type_ptr_type + type(artemis_interface_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this integer, intent(in), optional, dimension(n0) :: surface_lw integer, intent(in), optional, dimension(n1) :: surface_up real(4), intent(in), optional :: thickness_lw real(4), intent(in), optional :: thickness_up integer, intent(in), optional :: num_layers_lw integer, intent(in), optional :: num_layers_up - logical, intent(in), optional :: use_pricel_lw - logical, intent(in), optional :: use_pricel_up - logical, intent(in), optional :: is_layered_lw - logical, intent(in), optional :: is_layered_up - real(4), intent(in), optional, dimension(n2) :: elastic_constants_lw - real(4), intent(in), optional, dimension(n3) :: elastic_constants_up logical, intent(in), optional :: print_lattice_match_info logical, intent(in), optional :: print_termination_info logical, intent(in), optional :: print_shift_info @@ -733,26 +1129,19 @@ subroutine f90wrap_intf_gen__generate__binding__aigt( & integer, intent(in), optional :: interface_idx logical, intent(in), optional :: generate_structures integer, intent(in), optional :: seed - integer, intent(out), optional :: exit_code + integer, intent(in), optional :: verbose + integer, optional, intent(inout) :: exit_code integer :: n0 !f2py intent(hide), depend(surface_lw) :: n0 = shape(surface_lw,0) integer :: n1 !f2py intent(hide), depend(surface_up) :: n1 = shape(surface_up,0) - integer :: n2 - !f2py intent(hide), depend(elastic_constants_lw) :: n2 = shape(elastic_constants_lw,0) - integer :: n3 - !f2py intent(hide), depend(elastic_constants_up) :: n3 = shape(elastic_constants_up,0) - this_ptr = transfer(this, this_ptr) - basis_lw_ptr = transfer(basis_lw, basis_lw_ptr) - basis_up_ptr = transfer(basis_up, basis_up_ptr) - call this_ptr%p%generate(basis_lw=basis_lw_ptr%p, basis_up=basis_up_ptr%p, miller_lw=miller_lw, miller_up=miller_up, & - surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, thickness_up=thickness_up, & - num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, use_pricel_lw=use_pricel_lw, use_pricel_up=use_pricel_up, & - is_layered_lw=is_layered_lw, is_layered_up=is_layered_up, elastic_constants_lw=elastic_constants_lw, & - elastic_constants_up=elastic_constants_up, print_lattice_match_info=print_lattice_match_info, & - print_termination_info=print_termination_info, print_shift_info=print_shift_info, break_on_fail=break_on_fail, & - icheck_match=icheck_match, interface_idx=interface_idx, generate_structures=generate_structures, seed=seed, exit_code=exit_code & - ) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%generate(surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, & + thickness_up=thickness_up, num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, & + print_lattice_match_info=print_lattice_match_info, print_termination_info=print_termination_info, & + print_shift_info=print_shift_info, break_on_fail=break_on_fail, icheck_match=icheck_match, & + interface_idx=interface_idx, generate_structures=generate_structures, seed=seed, verbose=verbose, & + exit_code=exit_code) end subroutine f90wrap_intf_gen__generate__binding__aigt subroutine f90wrap_intf_gen__restart__binding__aigt(this, basis, interface_location, & From 9ea6c8d4468c83d1b459c4b6b0f25155091a0f0a Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sun, 20 Apr 2025 07:26:41 +0100 Subject: [PATCH 065/137] Remove makefile --- Makefile | 107 ------------------------------------------------------- 1 file changed, 107 deletions(-) delete mode 100644 Makefile diff --git a/Makefile b/Makefile deleted file mode 100644 index e86e47b..0000000 --- a/Makefile +++ /dev/null @@ -1,107 +0,0 @@ -########################################## -# CODE DIRECTORIES AND FILES -########################################## -mkfile_path := $(abspath $(firstword $(MAKEFILE_LIST))) -mkfile_dir := $(dir $(mkfile_path)) -BIN_DIR := ./bin -SRC_DIR := ./src -LIB_DIR := ./lib -BUILD_DIR = ./obj -LIBS := mod_constants.f90 \ - mod_misc.f90 \ - mod_misc_maths.f90 \ - mod_misc_linalg.f90 \ - mod_tools_infile.f90 \ - mod_rw_geom.f90 \ - mod_edit_geom.f90 \ - mod_sym.f90 -OBJS := $(addprefix $(LIB_DIR)/,$(LIBS)) -#$(info VAR is $(OBJS)) -SRCS := io.F90 \ - aspect.f90 \ - mod_help.f90 \ - mod_intf_identifier.f90 \ - mod_plane_matching.f90 \ - mod_lat_compare.f90 \ - mod_swapping.f90 \ - mod_shifting.f90 \ - default_infile.f90 \ - inputs.f90 \ - interfaces.f90 \ - main.f90 -SRCS := $(OBJS) $(SRCS) -OBJS := $(addprefix $(SRC_DIR)/,$(SRCS)) - - -########################################## -# COMPILER CHOICE SECTION -########################################## -FFLAGS = -O2 -#PPFLAGS = -cpp -FC=gfortran -ifeq ($(FC),ifort) - MPIFLAG = -qopenmp - MODULEFLAG = -module - DEVFLAGS = -check all -warn #all - DEBUGFLAGS = -check all -fpe0 -warn -tracekback -debug extended -else - MPIFLAG = -fopenmp - MODULEFLAG = -J - DEVFLAGS = -g -fbacktrace -fcheck=all - DEBUGFLAGS = -fbounds-check -Wall -Wno-maybe-uninitialized -endif - - -########################################## -# LAPACK SECTION -########################################## -MKLROOT?="/usr/local/intel/parallel_studio_xe_2017/compilers_and_libraries_2017/linux/mkl/lib/intel64_lin" -LLAPACK = $(MKLROOT)/libmkl_lapack95_lp64.a \ - -Wl,--start-group \ - $(MKLROOT)/libmkl_intel_lp64.a \ - $(MKLROOT)/libmkl_sequential.a \ - $(MKLROOT)/libmkl_core.a \ - -Wl,--end-group \ - -lpthread - -#$(MKLROOT)/libmkl_scalapack_lp64.a \ -#$(MKLROOT)/libmkl_solver_lp64_sequential.a \ - - -########################################## -# COMPILATION SECTION -########################################## -INSTALL_DIR?=$(HOME)/bin -ARTEMIS = artemis -programs = $(BIN_DIR)/$(ARTEMIS) - -.PHONY: all debug install uninstall dev mpi clean - -all: $(programs) - -$(BIN_DIR): - mkdir -p $@ - -$(BUILD_DIR): - mkdir -p $@ - -$(BIN_DIR)/$(ARTEMIS): $(OBJS) | $(BIN_DIR) $(BUILD_DIR) - $(FC) $(MODULEFLAG) $(BUILD_DIR) $(OBJS) -o $@ - -install: $(OBJS) | $(INSTALL_DIR) $(BUILD_DIR) - $(FC) $(MODULEFLAG) $(BUILD_DIR) $(OBJS) -o $(INSTALL_DIR)/$(ARTEMIS) - -debug: $(OBJS) | $(BIN_DIR) $(BUILD_DIR) - $(FC) $(DEBUGFLAGS) $(MODULEFLAG) $(BUILD_DIR) $(OBJS) -o $(programs) - -dev: $(OBJS) | $(BIN_DIR) $(BUILD_DIR) - $(FC) $(DEVFLAGS) $(MODULEFLAG) $(BUILD_DIR) $(OBJS) -o $(programs) - -mpi: $(OBJS) | $(BIN_DIR) $(BUILD_DIR) - $(FC) $(MPIFLAG) $(MODULEFLAG) $(BUILD_DIR) $(OBJS) -o $(programs) - -clean: $(BUILD_DIR) $(BIN_DIR) - rm -r $(BUILD_DIR)/ $(BIN_DIR)/ - -uninstall: $(INSTALL_DIR)/$(ARTEMIS) - rm $(INSTALL_DIR)/$(ARTEMIS) From 98b26f2b344ab2289e0924e668a6883b6555cabd Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sun, 20 Apr 2025 07:28:09 +0100 Subject: [PATCH 066/137] Merge generator types --- CMakeLists.txt | 9 +- app/main.f90 | 15 +- src/artemis/__init__.py | 9 +- src/artemis/artemis.py | 511 +++--- src/fortran/artemis.f90 | 6 +- src/fortran/lib/mod_cache.f90 | 31 + ...d_intf_generator.f90 => mod_generator.f90} | 406 ++++- src/fortran/lib/mod_term_generator.f90 | 237 --- src/fortran/lib/mod_terminations.f90 | 21 +- src/wrapper/f90wrap_mod_generator.f90 | 1371 +++++++++++++++++ src/wrapper/f90wrap_mod_intf_generator.f90 | 1293 ---------------- src/wrapper/f90wrap_mod_term_generator.f90 | 91 -- 12 files changed, 2060 insertions(+), 1940 deletions(-) create mode 100644 src/fortran/lib/mod_cache.f90 rename src/fortran/lib/{mod_intf_generator.f90 => mod_generator.f90} (83%) delete mode 100644 src/fortran/lib/mod_term_generator.f90 create mode 100644 src/wrapper/f90wrap_mod_generator.f90 delete mode 100644 src/wrapper/f90wrap_mod_intf_generator.f90 delete mode 100644 src/wrapper/f90wrap_mod_term_generator.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 3f35c3d..47b08de 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -71,13 +71,13 @@ set(LIB_FILES mod_lat_compare.f90 mod_swapping.f90 mod_shifting.f90 + mod_cache.f90 ) # Main source files set(SPECIAL_LIB_FILES mod_geom_rw.f90 - mod_term_generator.f90 - mod_intf_generator.f90 + mod_generator.f90 ) @@ -283,8 +283,7 @@ if (BUILD_PYTHON) # Generate f90wrap signature file set(F90WRAP_FILE - ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_term_generator.f90 - ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_intf_generator.f90 + ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_generator.f90 ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_geom_rw.f90 ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_artemis.f90 ) @@ -298,7 +297,7 @@ if (BUILD_PYTHON) -m ${PROJECT_NAME} -k ${KIND_MAP} ${F90WRAP_FORTRAN_SRC_FILES} - --only artemis_interface_generator_type artemis_termination_generator_type basis_type: + --only artemis_generator_type basis_type: DEPENDS ${F90WRAP_FORTRAN_SRC_FILES} WORKING_DIRECTORY ${CMAKE_BUILD_DIR} COMMENT "Generating f90wrap signature file" diff --git a/app/main.f90 b/app/main.f90 index 6b52542..e54ee81 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -94,11 +94,20 @@ program artemis_executable call intf_gen%set_tolerance( & tolerance = tolerance & ) + call intf_gen%set_materials( & + structure_lw = struc1_bas, structure_up = struc2_bas, & + use_pricel_lw = lw_use_pricel, use_pricel_up = up_use_pricel, & + elastic_constants_lw = [ lw_bulk_modulus ], & + elastic_constants_up = [ up_bulk_modulus ] & + ) + call intf_gen%set_surface_properties( & + miller_lw = lw_mplane, miller_up = up_mplane, & + is_layered_lw = lw_layered, is_layered_up = up_layered & + ) + if(.not.ludef_lw_layered) call intf_gen%reset_is_layered_lw() + if(.not.ludef_up_layered) call intf_gen%reset_is_layered_up() call intf_gen%generate( & - struc1_bas, struc2_bas, & - miller_lw = lw_mplane, miller_up = up_mplane, & surface_lw = lw_surf, surface_up = up_surf, & - use_pricel_lw = lw_use_pricel, use_pricel_up = up_use_pricel, & print_lattice_match_info = lprint_matches, & print_termination_info = lprint_terms, & print_shift_info = lprint_shifts & diff --git a/src/artemis/__init__.py b/src/artemis/__init__.py index 8f62bc6..90ebfc8 100644 --- a/src/artemis/__init__.py +++ b/src/artemis/__init__.py @@ -11,8 +11,7 @@ except PackageNotFoundError: __version__ = "unknown" -from .artemis import interface_generator as _interface_generator_class -from .artemis import termination_generator as _termination_generator_class +from .artemis import generator as _generator_class from .artemis import geom_rw as _geom_rw_class # from .artemis import generator @@ -23,8 +22,7 @@ geom = types.ModuleType('geom') # Assign the respective class to the simulated 'generator' and 'geom' modules -generator.artemis_interface_generator = _interface_generator_class.artemis_interface_generator -generator.artemis_termination_generator = _termination_generator_class.artemis_termination_generator +generator.artemis_generator = _generator_class.artemis_generator # Assign the class to the simulated 'geom' module geom.basis_array = _geom_rw_class.basis_array @@ -37,8 +35,7 @@ sys.modules['artemis.geom'] = geom # Clean up internal imports (remove access to the direct classes) -del _interface_generator_class -del _termination_generator_class +del _generator_class del _geom_rw_class del PackageNotFoundError del version diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 55182b1..11cc6b3 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -240,7 +240,7 @@ def toase(self, calculator=None): for i in range(self.nspec): for j in range(self.spec[i].num): species_string += str(self.spec[i].name.decode()).strip() - positions.append(self.spec[i].atom[j]) + positions.append(self.spec[i].atom[j][:3]) # Set the atoms if(self.lcart): @@ -484,7 +484,7 @@ def _init_array_items(self): """, Geom_Rw.basis) return self.items - def toase(self): + def toase(self, calculator=None): """ Convert the basis_array object to a list of ASE Atoms objects. """ @@ -492,7 +492,7 @@ def toase(self): # Set the species list atoms = [] for i in range(len(self.items)): - atoms.append(self.items[i].toase()) + atoms.append(self.items[i].toase(calculator=calculator)) return atoms def allocate(self, size): @@ -1194,147 +1194,9 @@ def deallocate(self): # geom_rw = Geom_Rw() -class Termination_Generator(f90wrap.runtime.FortranModule): - """ - Module artemis__termination_generator - - - Defined at \ - ../src/fortran/lib/mod_term_generator.f90 \ - lines 7-202 - - """ - @f90wrap.runtime.register_class("artemis.artemis_termination_generator") - class artemis_termination_generator(f90wrap.runtime.FortranDerivedType): - """ - Type(name=artemis_termination_generator_type) - - - Defined at \ - ../src/fortran/lib/mod_term_generator.f90 \ - lines 21-24 - - """ - def __init__(self, handle=None): - """ - self = Artemis_Termination_Generator_Type() - - - Defined at \ - ../src/fortran/lib/mod_term_generator.f90 \ - lines 21-24 - - - Returns - ------- - this : Artemis_Termination_Generator_Type - Object to be constructed - - - Automatically generated constructor for artemis_termination_generator_type - """ - f90wrap.runtime.FortranDerivedType.__init__(self) - result = \ - _artemis.f90wrap_term_gen__artemis_termination293d() - self._handle = result[0] if isinstance(result, tuple) else result - - def __del__(self): - """ - Destructor for class Artemis_Termination_Generator_Type - - - Defined at \ - ../src/fortran/lib/mod_term_generator.f90 \ - lines 21-24 - - Parameters - ---------- - this : Artemis_Termination_Generator_Type - Object to be destructed - - - Automatically generated destructor for artemis_termination_generator_type - """ - if self._alloc: - _artemis.f90wrap_term_gen__artemis_terminationdf16(this=self._handle) - - def generate(self, basis, miller_plane, axis, surface=None, num_layers=None, \ - thickness=None, orthogonalise=None, normalise=None, break_on_fail=None): - """ - generate__binding__artemis_termination_generator_type(self, basis, miller_plane, \ - axis[, surface, num_layers, thickness, orthogonalise, normalise, \ - break_on_fail]) - - - Defined at \ - ../src/fortran/lib/mod_term_generator.f90 \ - lines 31-201 - - Parameters - ---------- - this : Artemis_Termination_Generator_Type - basis : Basis_Type - miller_plane : int array - axis : int - surface : int array - num_layers : int - thickness : float - orthogonalise : bool - normalise : bool - break_on_fail : bool - - --------------------------------------------------------------------------- - Finds smallest thickness of the slab and increases to ... - ... user-defined thickness - --------------------------------------------------------------------------- - """ - - # check if host is ase.Atoms object or a Fortran derived type basis_type - if isinstance(basis, Atoms): - basis = geom_rw.basis(atoms=basis) - - _artemis.f90wrap_term_gen__generate__binding__2af7(this=self._handle, \ - basis=basis._handle, miller_plane=miller_plane, axis=axis, surface=surface, \ - num_layers=num_layers, thickness=thickness, orthogonalise=orthogonalise, \ - normalise=normalise, break_on_fail=break_on_fail) - - @property - def layer_separation_cutoff(self): - """ - Element layer_separation_cutoff ftype=real(real32) pytype=float - - - Defined at \ - ../src/fortran/lib/mod_term_generator.f90 \ - line 22 - - """ - return \ - _artemis.f90wrap_artemis_termination_generator_type__get__layer_sepace78(self._handle) - - @layer_separation_cutoff.setter - def layer_separation_cutoff(self, layer_separation_cutoff): - _artemis.f90wrap_artemis_termination_generator_type__set__layer_sepae7ef(self._handle, \ - layer_separation_cutoff) - - def __str__(self): - ret = ['{\n'] - ret.append(' layer_separation_cutoff : ') - ret.append(repr(self.layer_separation_cutoff)) - ret.append('}') - return ''.join(ret) - - _dt_array_initialisers = [] - - - _dt_array_initialisers = [] - - -termination_generator = Termination_Generator() - -class Interface_Generator(f90wrap.runtime.FortranModule): +class Generator(f90wrap.runtime.FortranModule): """ - Module artemis__interface_generator + Module artemis__generator Defined at \ @@ -1342,10 +1204,10 @@ class Interface_Generator(f90wrap.runtime.FortranModule): lines 7-1373 """ - @f90wrap.runtime.register_class("artemis.artemis_interface_generator") - class artemis_interface_generator(f90wrap.runtime.FortranDerivedType): + @f90wrap.runtime.register_class("artemis.artemis_generator") + class artemis_generator(f90wrap.runtime.FortranDerivedType): """ - Type(name=artemis_interface_generator_type) + Type(name=artemis_generator_type) Defined at \ @@ -1355,7 +1217,7 @@ class artemis_interface_generator(f90wrap.runtime.FortranDerivedType): """ def __init__(self, handle=None): """ - self = Artemis_Interface_Generator_Type() + self = Artemis_generator_Type() Defined at \ @@ -1365,11 +1227,11 @@ def __init__(self, handle=None): Returns ------- - this : Artemis_Interface_Generator_Type + this : Artemis_generator_Type Object to be constructed - Automatically generated constructor for artemis_interface_generator_type + Automatically generated constructor for artemis_generator_type """ f90wrap.runtime.FortranDerivedType.__init__(self) result = \ @@ -1378,7 +1240,7 @@ def __init__(self, handle=None): def __del__(self): """ - Destructor for class Artemis_Interface_Generator_Type + Destructor for class Artemis_generator_Type Defined at \ @@ -1387,11 +1249,11 @@ def __del__(self): Parameters ---------- - this : Artemis_Interface_Generator_Type + this : Artemis_generator_Type Object to be destructed - Automatically generated destructor for artemis_interface_generator_type + Automatically generated destructor for artemis_generator_type """ if self._alloc: _artemis.f90wrap_intf_gen__artemis_interface_genbc51(this=self._handle) @@ -1400,7 +1262,7 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ area_mismatch=None, max_length=None, max_area=None, max_fit=None, \ max_extension=None, angle_weight=None, area_weight=None): """ - set_tolerance__binding__artemis_interface_generator_type(self[, vector_mismatch, \ + set_tolerance__binding__artemis_generator_type(self[, vector_mismatch, \ angle_mismatch, area_mismatch, max_length, max_area, max_fit, max_extension, \ angle_weight, area_weight]) @@ -1411,7 +1273,7 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ Parameters ---------- - this : Artemis_Interface_Generator_Type + this : Artemis_generator_Type vector_mismatch : float angle_mismatch : float area_mismatch : float @@ -1432,7 +1294,7 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ interface_depth=None, separation_scale=None, depth_method=None): """ - set_shift_method__binding__artemis_interface_generator_type(self[, method, \ + set_shift_method__binding__artemis_generator_type(self[, method, \ num_shifts, shifts, interface_depth, separation_scale, depth_method]) @@ -1442,7 +1304,7 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ Parameters ---------- - this : Artemis_Interface_Generator_Type + this : Artemis_generator_Type method : int num_shifts : int shifts : float array @@ -1456,6 +1318,160 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ interface_depth=interface_depth, separation_scale=separation_scale, \ depth_method=depth_method) + def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ + elastic_constants_up=None, use_pricel_lw=None, use_pricel_up=None): + """ + set_materials__binding__artemis_generator_type(self, structure_lw, \ + structure_up[, elastic_constants_lw, elastic_constants_up, use_pricel_lw, \ + use_pricel_up]) + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + lines 252-287 + + Parameters + ---------- + this : Artemis_generator_Type + structure_lw : Basis_Type + structure_up : Basis_Type + elastic_constants_lw : float array + elastic_constants_up : float array + use_pricel_lw : bool + use_pricel_up : bool + + --------------------------------------------------------------------------- + Handle the elastic constants + --------------------------------------------------------------------------- + """ + + # check if host is ase.Atoms object or a Fortran derived type basis_type + if isinstance(structure_lw, Atoms): + structure_lw = geom_rw.basis(atoms=structure_lw) + + if isinstance(structure_up, Atoms): + structure_up = geom_rw.basis(atoms=structure_up) + + _artemis.f90wrap_intf_gen__set_materials__bindin017c(this=self._handle, \ + structure_lw=structure_lw._handle, structure_up=structure_up._handle, \ + elastic_constants_lw=elastic_constants_lw, \ + elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, \ + use_pricel_up=use_pricel_up) + + def set_surface_properties(self, miller_lw=None, miller_up=None, \ + is_layered_lw=None, is_layered_up=None): + """ + set_surface_properties__binding__artemis_generator_type(self[, \ + miller_lw, miller_up, is_layered_lw, is_layered_up]) + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + lines 295-318 + + Parameters + ---------- + this : Artemis_generator_Type + miller_lw : int array + miller_up : int array + is_layered_lw : bool + is_layered_up : bool + + """ + _artemis.f90wrap_intf_gen__set_surface_propertie615d(this=self._handle, \ + miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, \ + is_layered_up=is_layered_up) + + def reset_is_layered_lw(self): + """ + reset_is_layered_lw__binding__artemis_generator_type(self) + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + lines 322-329 + + Parameters + ---------- + this : Artemis_generator_Type + + """ + _artemis.f90wrap_intf_gen__reset_is_layered_lw__69b8(this=self._handle) + + def reset_is_layered_up(self): + """ + reset_is_layered_up__binding__artemis_generator_type(self) + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + lines 333-340 + + Parameters + ---------- + this : Artemis_generator_Type + + """ + _artemis.f90wrap_intf_gen__reset_is_layered_up__0b2c(this=self._handle) + + def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ + thickness=None, orthogonalise=None, normalise=None, break_on_fail=None, + verbose=None, calc=None): + """ + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + + Parameters + ---------- + """ + + exit_code, n_structs = _artemis.f90wrap_intf_gen__get_terminations__binding__agt(this=self._handle, + identifier=1, + miller=miller, surface=surface, + num_layers=num_layers, thickness=thickness, + orthogonalise=orthogonalise, normalise=normalise, + break_on_fail=break_on_fail, + verbose=verbose) + atoms = [] + + # allocate the structures + structures = geom_rw.basis_array() #.allocate(n_structs) + structures.allocate(n_structs) + _artemis.f90wrap_retrieve_last_generated_structures(n_structs, structures._handle) + atoms = structures.toase() + + return atoms, exit_code + + def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ + thickness=None, orthogonalise=None, normalise=None, break_on_fail=None, + verbose=None, calc=None): + """ + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + + Parameters + ---------- + """ + + exit_code, n_structs = _artemis.f90wrap_intf_gen__get_terminations__binding__agt(this=self._handle, + identifier=2, + miller=miller, surface=surface, + num_layers=num_layers, thickness=thickness, + orthogonalise=orthogonalise, normalise=normalise, + break_on_fail=break_on_fail, + verbose=verbose) + atoms = [] + + # allocate the structures + structures = geom_rw.basis_array() #.allocate(n_structs) + structures.allocate(n_structs) + _artemis.f90wrap_retrieve_last_generated_structures(n_structs, structures._handle) + atoms = structures.toase() + + return atoms, exit_code + def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ thickness_up=None, num_layers_lw=None, num_layers_up=None, \ print_lattice_match_info=None, print_termination_info=None, \ @@ -1463,7 +1479,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ interface_idx=None, generate_structures=None, seed=None, verbose=None, \ exit_code=None, calc=None): """ - generate__binding__artemis_interface_generator_type(self[, surface_lw, \ + generate__binding__artemis_generator_type(self[, surface_lw, \ surface_up, thickness_lw, thickness_up, num_layers_lw, num_layers_up, \ print_lattice_match_info, print_termination_info, print_shift_info, \ break_on_fail, icheck_match, interface_idx, generate_structures, seed, \ @@ -1476,7 +1492,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ Parameters ---------- - this : Artemis_Interface_Generator_Type + this : Artemis_generator_Type surface_lw : int array surface_up : int array thickness_lw : float @@ -1499,14 +1515,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ exit_code = 0 structures = None - # check if host is ase.Atoms object or a Fortran derived type basis_type - if isinstance(basis_lw, Atoms): - basis_lw = geom_rw.basis(atoms=basis_lw) - - if isinstance(basis_up, Atoms): - basis_up = geom_rw.basis(atoms=basis_up) - - exit_code = _artemis.f90wrap_artemis__interface_generator__generate__binding__ar04c1(this=self._handle, \ + exit_code = _artemis.f90wrap_intf_gen__generate__binding__ar04c1(this=self._handle, \ surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, \ thickness_up=thickness_up, num_layers_lw=num_layers_lw, \ num_layers_up=num_layers_up, \ @@ -1523,7 +1532,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ def restart(self, basis, interface_location=None, print_shift_info=None, \ seed=None): """ - restart__binding__artemis_interface_generator_type(self, basis[, \ + restart__binding__artemis_generator_type(self, basis[, \ interface_location, print_shift_info, seed]) @@ -1533,7 +1542,7 @@ def restart(self, basis, interface_location=None, print_shift_info=None, \ Parameters ---------- - this : Artemis_Interface_Generator_Type + this : Artemis_generator_Type basis : Basis_Type interface_location : float array print_shift_info : bool @@ -1543,7 +1552,7 @@ def restart(self, basis, interface_location=None, print_shift_info=None, \ Set the random seed --------------------------------------------------------------------------- """ - _artemis.f90wrap_intf_gen__restart__binding__aigt(this=self._handle, \ + _artemis.f90wrap_intf_gen__restart__binding__agt(this=self._handle, \ basis=basis._handle, interface_location=interface_location, \ print_shift_info=print_shift_info, seed=seed) @@ -1565,11 +1574,11 @@ def num_structures(self): """ The number of generated structures currently stored in the generator. """ - return _artemis.f90wrap_artemis_intf_gen_type__get__num_structures(self._handle) + return _artemis.f90wrap_artemis_gen_type__get__num_structures(self._handle) @num_structures.setter def num_structures(self, num_structures): - _raffle.f90wrap_artemis_intf_gen_type__set__num_structures(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__num_structures(self._handle, \ num_structures) @property @@ -1577,11 +1586,11 @@ def max_num_structures(self): """ The maximum number of generated structures that can be stored in the generator. """ - return _artemis.f90wrap_artemis_intf_gen_type__get__num_structures(self._handle) + return _artemis.f90wrap_artemis_gen_type__get__num_structures(self._handle) @max_num_structures.setter def max_num_structures(self, max_num_structures): - _raffle.f90wrap_artemis_intf_gen_type__set__max_num_structures(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__max_num_structures(self._handle, \ max_num_structures) @property @@ -1596,7 +1605,7 @@ def structure_lw(self): """ structure_lw_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__get__structure_lw(self._handle) + _artemis.f90wrap_artemis_generator_type__get__structure_lw(self._handle) if tuple(structure_lw_handle) in self._objs: structure_lw = self._objs[tuple(structure_lw_handle)] else: @@ -1607,7 +1616,7 @@ def structure_lw(self): @structure_lw.setter def structure_lw(self, structure_lw): structure_lw = structure_lw._handle - _artemis.f90wrap_artemis_interface_generator_type__set__structure_lw(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__structure_lw(self._handle, \ structure_lw) @property @@ -1622,7 +1631,7 @@ def structure_up(self): """ structure_up_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__get__structure_up(self._handle) + _artemis.f90wrap_artemis_generator_type__get__structure_up(self._handle) if tuple(structure_up_handle) in self._objs: structure_up = self._objs[tuple(structure_up_handle)] else: @@ -1633,7 +1642,7 @@ def structure_up(self): @structure_up.setter def structure_up(self, structure_up): structure_up = structure_up._handle - _artemis.f90wrap_artemis_interface_generator_type__set__structure_up(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__structure_up(self._handle, \ structure_up) @property @@ -1648,14 +1657,14 @@ def elastic_constants_lw(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__array__elastic_co4c3f(self._handle) + _artemis.f90wrap_artemis_generator_type__array__elastic_co4c3f(self._handle) if array_handle in self._arrays: elastic_constants_lw = self._arrays[array_handle] else: elastic_constants_lw = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_interface_generator_type__array__elastic_co4c3f) + _artemis.f90wrap_artemis_generator_type__array__elastic_co4c3f) self._arrays[array_handle] = elastic_constants_lw return elastic_constants_lw @@ -1675,14 +1684,14 @@ def elastic_constants_up(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__array__elastic_coedb6(self._handle) + _artemis.f90wrap_artemis_generator_type__array__elastic_coedb6(self._handle) if array_handle in self._arrays: elastic_constants_up = self._arrays[array_handle] else: elastic_constants_up = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_interface_generator_type__array__elastic_coedb6) + _artemis.f90wrap_artemis_generator_type__array__elastic_coedb6) self._arrays[array_handle] = elastic_constants_up return elastic_constants_up @@ -1702,11 +1711,11 @@ def use_pricel_lw(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__use_pricel_lw(self._handle) + _artemis.f90wrap_artemis_generator_type__get__use_pricel_lw(self._handle) @use_pricel_lw.setter def use_pricel_lw(self, use_pricel_lw): - _artemis.f90wrap_artemis_interface_generator_type__set__use_pricel_lw(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__use_pricel_lw(self._handle, \ use_pricel_lw) @property @@ -1721,11 +1730,11 @@ def use_pricel_up(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__use_pricel_up(self._handle) + _artemis.f90wrap_artemis_generator_type__get__use_pricel_up(self._handle) @use_pricel_up.setter def use_pricel_up(self, use_pricel_up): - _artemis.f90wrap_artemis_interface_generator_type__set__use_pricel_up(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__use_pricel_up(self._handle, \ use_pricel_up) @property @@ -1740,13 +1749,13 @@ def miller_lw(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_interface_generator_type__array__miller_lw(self._handle) + _artemis.f90wrap_artemis_generator_type__array__miller_lw(self._handle) if array_handle in self._arrays: miller_lw = self._arrays[array_handle] else: miller_lw = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_interface_generator_type__array__miller_lw) + _artemis.f90wrap_artemis_generator_type__array__miller_lw) self._arrays[array_handle] = miller_lw return miller_lw @@ -1754,6 +1763,28 @@ def miller_lw(self): def miller_lw(self, miller_lw): self.miller_lw[...] = miller_lw + @property + def miller_up(self): + """ + Element miller_up ftype=integer pytype=int + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + line 38 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_artemis_generator_type__array__miller_up(self._handle) + if array_handle in self._arrays: + miller_up = self._arrays[array_handle] + else: + miller_up = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_artemis_generator_type__array__miller_up) + self._arrays[array_handle] = miller_up + return miller_up + @miller_up.setter def miller_up(self, miller_up): self.miller_up[...] = miller_up @@ -1770,11 +1801,11 @@ def is_layered_lw(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__is_layered_lw(self._handle) + _artemis.f90wrap_artemis_generator_type__get__is_layered_lw(self._handle) @is_layered_lw.setter def is_layered_lw(self, is_layered_lw): - _artemis.f90wrap_artemis_interface_generator_type__set__is_layered_lw(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__is_layered_lw(self._handle, \ is_layered_lw) @property @@ -1789,11 +1820,11 @@ def is_layered_up(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__is_layered_up(self._handle) + _artemis.f90wrap_artemis_generator_type__get__is_layered_up(self._handle) @is_layered_up.setter def is_layered_up(self, is_layered_up): - _artemis.f90wrap_artemis_interface_generator_type__set__is_layered_up(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__is_layered_up(self._handle, \ is_layered_up) @property @@ -1808,11 +1839,11 @@ def ludef_is_layered_lw(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__ludef_is_lay4aa6(self._handle) + _artemis.f90wrap_artemis_generator_type__get__ludef_is_lay4aa6(self._handle) @ludef_is_layered_lw.setter def ludef_is_layered_lw(self, ludef_is_layered_lw): - _artemis.f90wrap_artemis_interface_generator_type__set__ludef_is_lay87a5(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__ludef_is_lay87a5(self._handle, \ ludef_is_layered_lw) @property @@ -1827,11 +1858,11 @@ def ludef_is_layered_up(self): """ return \ - _artemis.f90wrap_artemis_interface_generator_type__get__ludef_is_lay60fd(self._handle) + _artemis.f90wrap_artemis_generator_type__get__ludef_is_lay60fd(self._handle) @ludef_is_layered_up.setter def ludef_is_layered_up(self, ludef_is_layered_up): - _artemis.f90wrap_artemis_interface_generator_type__set__ludef_is_laye6e4(self._handle, \ + _artemis.f90wrap_artemis_generator_type__set__ludef_is_laye6e4(self._handle, \ ludef_is_layered_up) @property @@ -1846,11 +1877,11 @@ def shift_method(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__shift_method(self._handle) + _artemis.f90wrap_artemis_gen_type__get__shift_method(self._handle) @shift_method.setter def shift_method(self, shift_method): - _artemis.f90wrap_artemis_intf_gen_type__set__shift_method(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__shift_method(self._handle, \ shift_method) @property @@ -1865,11 +1896,11 @@ def num_shifts(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__num_shifts(self._handle) + _artemis.f90wrap_artemis_gen_type__get__num_shifts(self._handle) @num_shifts.setter def num_shifts(self, num_shifts): - _artemis.f90wrap_artemis_intf_gen_type__set__num_shifts(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__num_shifts(self._handle, \ num_shifts) @property @@ -1884,13 +1915,13 @@ def shifts(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_intf_gen_type__array__shifts(self._handle) + _artemis.f90wrap_artemis_gen_type__array__shifts(self._handle) if array_handle in self._arrays: shifts = self._arrays[array_handle] else: shifts = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_intf_gen_type__array__shifts) + _artemis.f90wrap_artemis_gen_type__array__shifts) self._arrays[array_handle] = shifts return shifts @@ -1910,11 +1941,11 @@ def interface_depth(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__interface_depth(self._handle) + _artemis.f90wrap_artemis_gen_type__get__interface_depth(self._handle) @interface_depth.setter def interface_depth(self, interface_depth): - _artemis.f90wrap_artemis_intf_gen_type__set__interface_depth(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__interface_depth(self._handle, \ interface_depth) @property @@ -1929,11 +1960,11 @@ def separation_scale(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__separation_scale(self._handle) + _artemis.f90wrap_artemis_gen_type__get__separation_scale(self._handle) @separation_scale.setter def separation_scale(self, separation_scale): - _artemis.f90wrap_artemis_intf_gen_type__set__separation_scale(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__separation_scale(self._handle, \ separation_scale) @property @@ -1948,11 +1979,11 @@ def depth_method(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__depth_method(self._handle) + _artemis.f90wrap_artemis_gen_type__get__depth_method(self._handle) @depth_method.setter def depth_method(self, depth_method): - _artemis.f90wrap_artemis_intf_gen_type__set__depth_method(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__depth_method(self._handle, \ depth_method) @property @@ -1967,13 +1998,13 @@ def shift_data(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_intf_gen_type__array__shift_data(self._handle) + _artemis.f90wrap_artemis_gen_type__array__shift_data(self._handle) if array_handle in self._arrays: shift_data = self._arrays[array_handle] else: shift_data = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_intf_gen_type__array__shift_data) + _artemis.f90wrap_artemis_gen_type__array__shift_data) self._arrays[array_handle] = shift_data return shift_data @@ -1993,11 +2024,11 @@ def swap_method(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__swap_method(self._handle) + _artemis.f90wrap_artemis_gen_type__get__swap_method(self._handle) @swap_method.setter def swap_method(self, swap_method): - _artemis.f90wrap_artemis_intf_gen_type__set__swap_method(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__swap_method(self._handle, \ swap_method) @property @@ -2012,11 +2043,11 @@ def num_swaps(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__num_swaps(self._handle) + _artemis.f90wrap_artemis_gen_type__get__num_swaps(self._handle) @num_swaps.setter def num_swaps(self, num_swaps): - _artemis.f90wrap_artemis_intf_gen_type__set__num_swaps(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__num_swaps(self._handle, \ num_swaps) @property @@ -2031,11 +2062,11 @@ def swap_density(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__swap_density(self._handle) + _artemis.f90wrap_artemis_gen_type__get__swap_density(self._handle) @swap_density.setter def swap_density(self, swap_density): - _artemis.f90wrap_artemis_intf_gen_type__set__swap_density(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__swap_density(self._handle, \ swap_density) @property @@ -2050,11 +2081,11 @@ def swap_depth(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__swap_depth(self._handle) + _artemis.f90wrap_artemis_gen_type__get__swap_depth(self._handle) @swap_depth.setter def swap_depth(self, swap_depth): - _artemis.f90wrap_artemis_intf_gen_type__set__swap_depth(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__swap_depth(self._handle, \ swap_depth) @property @@ -2069,11 +2100,11 @@ def swap_sigma(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__swap_sigma(self._handle) + _artemis.f90wrap_artemis_gen_type__get__swap_sigma(self._handle) @swap_sigma.setter def swap_sigma(self, swap_sigma): - _artemis.f90wrap_artemis_intf_gen_type__set__swap_sigma(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__swap_sigma(self._handle, \ swap_sigma) @property @@ -2088,11 +2119,11 @@ def require_mirror_swaps(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__require_mirr41cf(self._handle) + _artemis.f90wrap_artemis_gen_type__get__require_mirr41cf(self._handle) @require_mirror_swaps.setter def require_mirror_swaps(self, require_mirror_swaps): - _artemis.f90wrap_artemis_intf_gen_type__set__require_mirr3bfa(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__require_mirr3bfa(self._handle, \ require_mirror_swaps) @property @@ -2107,11 +2138,11 @@ def match_method(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__match_method(self._handle) + _artemis.f90wrap_artemis_gen_type__get__match_method(self._handle) @match_method.setter def match_method(self, match_method): - _artemis.f90wrap_artemis_intf_gen_type__set__match_method(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__match_method(self._handle, \ match_method) @property @@ -2126,11 +2157,11 @@ def max_num_matches(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__max_num_matches(self._handle) + _artemis.f90wrap_artemis_gen_type__get__max_num_matches(self._handle) @max_num_matches.setter def max_num_matches(self, max_num_matches): - _artemis.f90wrap_artemis_intf_gen_type__set__max_num_matches(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__max_num_matches(self._handle, \ max_num_matches) @property @@ -2145,11 +2176,11 @@ def max_num_terms(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__max_num_terms(self._handle) + _artemis.f90wrap_artemis_gen_type__get__max_num_terms(self._handle) @max_num_terms.setter def max_num_terms(self, max_num_terms): - _artemis.f90wrap_artemis_intf_gen_type__set__max_num_terms(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__max_num_terms(self._handle, \ max_num_terms) @property @@ -2164,11 +2195,11 @@ def max_num_planes(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__max_num_planes(self._handle) + _artemis.f90wrap_artemis_gen_type__get__max_num_planes(self._handle) @max_num_planes.setter def max_num_planes(self, max_num_planes): - _artemis.f90wrap_artemis_intf_gen_type__set__max_num_planes(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__max_num_planes(self._handle, \ max_num_planes) @property @@ -2183,11 +2214,11 @@ def fix_normal(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__fix_normal(self._handle) + _artemis.f90wrap_artemis_gen_type__get__fix_normal(self._handle) @fix_normal.setter def fix_normal(self, fix_normal): - _artemis.f90wrap_artemis_intf_gen_type__set__fix_normal(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__fix_normal(self._handle, \ fix_normal) @property @@ -2202,11 +2233,11 @@ def bondlength_cutoff(self): """ return \ - _artemis.f90wrap_artemis_intf_gen_type__get__bondlength_c21a8(self._handle) + _artemis.f90wrap_artemis_gen_type__get__bondlength_c21a8(self._handle) @bondlength_cutoff.setter def bondlength_cutoff(self, bondlength_cutoff): - _artemis.f90wrap_artemis_intf_gen_type__set__bondlength_cbd11(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__bondlength_cbd11(self._handle, \ bondlength_cutoff) @property @@ -2221,14 +2252,14 @@ def layer_separation_cutoff(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_intf_gen_type__array__layer_sepa90a5(self._handle) + _artemis.f90wrap_artemis_gen_type__array__layer_sepa90a5(self._handle) if array_handle in self._arrays: layer_separation_cutoff = self._arrays[array_handle] else: layer_separation_cutoff = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_intf_gen_type__array__layer_sepa90a5) + _artemis.f90wrap_artemis_gen_type__array__layer_sepa90a5) self._arrays[array_handle] = layer_separation_cutoff return layer_separation_cutoff @@ -2243,9 +2274,9 @@ def _init_array_structures(self): It is not recommended to use this function directly. Use the `structures` property instead. """ self.structures = f90wrap.runtime.FortranDerivedTypeArray(self, - _artemis.f90wrap_artemis_intf_gen_type__array_getitem__structures, - _artemis.f90wrap_artemis_intf_gen_type__array_setitem__structures, - _artemis.f90wrap_artemis_intf_gen_type__array_len__structures, + _artemis.f90wrap_artemis_gen_type__array_getitem__structures, + _artemis.f90wrap_artemis_gen_type__array_setitem__structures, + _artemis.f90wrap_artemis_gen_type__array_len__structures, """ Element items ftype=type(basis_type) pytype=basis @@ -2257,7 +2288,7 @@ def _init_array_structures(self): return self.structures def __str__(self): - ret = ['{\n'] + ret = ['{\n'] ret.append(' num_structures : ') ret.append(repr(self.num_structures)) ret.append(',\n max_num_structures : ') @@ -2337,7 +2368,7 @@ def __str__(self): _dt_array_initialisers = [] -interface_generator = Interface_Generator() +generator = Generator() class Artemis(f90wrap.runtime.FortranModule): """ diff --git a/src/fortran/artemis.f90 b/src/fortran/artemis.f90 index 992466e..e22a532 100644 --- a/src/fortran/artemis.f90 +++ b/src/fortran/artemis.f90 @@ -1,6 +1,8 @@ module artemis - use artemis__termination_generator - use artemis__interface_generator + use artemis__structure_cache, only: & + store_last_generated_structures, & + retrieve_last_generated_structures + use artemis__generator, only: artemis_generator_type implicit none diff --git a/src/fortran/lib/mod_cache.f90 b/src/fortran/lib/mod_cache.f90 new file mode 100644 index 0000000..d9fb806 --- /dev/null +++ b/src/fortran/lib/mod_cache.f90 @@ -0,0 +1,31 @@ +module artemis__structure_cache + use artemis__geom_rw, only: basis_type + implicit none + + private + public :: store_last_generated_structures, retrieve_last_generated_structures + + type(basis_type), allocatable, dimension(:), save :: cached_structures + +contains + + subroutine store_last_generated_structures(structures) + implicit none + type(basis_type), intent(in), allocatable :: structures(:) + if (allocated(cached_structures)) deallocate(cached_structures) + allocate(cached_structures(size(structures))) + cached_structures = structures + end subroutine store_last_generated_structures + + function retrieve_last_generated_structures() result(structures) + implicit none + type(basis_type), allocatable :: structures(:) + if (.not.allocated(cached_structures)) then + allocate(structures(0)) + else + allocate(structures(size(cached_structures))) + structures = cached_structures + end if + end function retrieve_last_generated_structures + +end module artemis__structure_cache diff --git a/src/fortran/lib/mod_intf_generator.f90 b/src/fortran/lib/mod_generator.f90 similarity index 83% rename from src/fortran/lib/mod_intf_generator.f90 rename to src/fortran/lib/mod_generator.f90 index c78b032..59d5049 100644 --- a/src/fortran/lib/mod_intf_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -4,7 +4,7 @@ !!! Code part of the ARTEMIS group (Hepplestone research group). !!! Think Hepplestone, think HRG. !!!############################################################################# -module artemis__interface_generator +module artemis__generator use artemis__constants, only: real32, ierror, pi use artemis__misc, only: to_lower,to_upper use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type @@ -29,10 +29,10 @@ module artemis__interface_generator private - public :: artemis_interface_generator_type + public :: artemis_generator_type - type, extends(abstract_artemis_generator_type) :: artemis_interface_generator_type + type, extends(abstract_artemis_generator_type) :: artemis_generator_type !! Interface generator type type(basis_type) :: structure_lw, structure_up !! Lower and upper bulk structures @@ -122,13 +122,17 @@ module artemis__interface_generator !! Reset the is_layered flags for the lower bulk structure procedure, pass(this) :: reset_is_layered_up !! Reset the is_layered flags for the upper bulk structure + + procedure, pass(this) :: get_terminations + !! Return the terminations for structure + procedure, pass(this) :: generate => generate_interfaces !! Generate interfaces from two bulk structures procedure, pass(this) :: restart => generate_intefaces_from_existing !! Generate interfaces from existing bulk structures procedure, pass(this) :: generate_perturbations => generate_shifts_and_swaps !! Generate perturbations for the given basis - end type artemis_interface_generator_type + end type artemis_generator_type contains @@ -144,7 +148,7 @@ subroutine set_tolerance( & implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type type(tol_type), intent(in), optional :: tolerance !! Tolerance structure @@ -198,7 +202,7 @@ subroutine set_shift_method( & implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type integer, intent(in), optional :: method !! Shift method @@ -281,7 +285,7 @@ subroutine set_materials( & implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type type(basis_type), intent(in) :: structure_lw !! Lower bulk structure @@ -334,7 +338,7 @@ subroutine set_surface_properties( & implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type integer, dimension(3), intent(in), optional :: miller_lw !! Miller indices for the lower bulk structure @@ -369,7 +373,7 @@ subroutine reset_is_layered_lw(this) implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type this%is_layered_lw = .false. @@ -385,7 +389,7 @@ subroutine reset_is_layered_up(this) implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type this%is_layered_up = .false. @@ -395,15 +399,292 @@ end subroutine reset_is_layered_up !############################################################################### +!############################################################################### + function get_terminations( & + this, identifier, miller, surface, num_layers, thickness, & + orthogonalise, normalise, break_on_fail, & + verbose, exit_code & + ) result(output) + !! Generate and prints terminations parallel to the supplied miller plane + implicit none + + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type + integer, intent(in) :: identifier + !! Identifier for the material (1=lower, 2=upper) + integer, dimension(3), intent(in), optional :: miller + !! Miller plane + integer, dimension(:), intent(in), optional :: surface + !! Surface termination indices + integer, intent(in), optional :: num_layers + !! Number of layers in the slab + real(real32), intent(in), optional :: thickness + !! Thickness of the slab (in Å) + logical, intent(in), optional :: orthogonalise + !! Boolean whether to orthogonalise the lattice + logical, intent(in), optional :: normalise + !! Boolean whether to normalise the lattice and basis + logical, intent(in), optional :: break_on_fail + !! Boolean whether to break on failure + integer, intent(in), optional :: verbose + !! Boolean whether to print verbose output + integer, intent(out), optional :: exit_code + !! Exit code for the program + + type(basis_type), dimension(:), allocatable :: output + !! Output structures + + ! Local variables + integer :: itmp1, iterm, term_start, term_end, term_step, i + !! Termination loop variables + integer :: num_cells, ntrans + !! Number of cells in the slab + integer :: num_structures + !! Number of structures to be generated + integer, dimension(2) :: surface_ + !! Surface termination indices + integer, dimension(3) :: miller_ + !! Miller plane + integer :: num_layers_ + !! Number of layers in the slab + real(real32) :: height, thickness_ + !! Height of the slab + logical :: lcycle + !! Boolean whether to cycle through the slab + type(basis_type) :: structure, structure_compare + !! Temporary basis structures + type(confine_type) :: confine + !! Confine structure along the specified axis + type(term_arr_type) :: term + !! List of terminations + real(real32), dimension(3,3) :: tfmat + !! Transformation matrix + logical :: orthogonalise_ + !! Boolean whether to orthogonalise the lattice + logical :: normalise_ + !! Boolean whether to normalise the lattice + logical :: break_on_fail_ + !! Boolean whether to break on failure + + + real(real32) :: layer_sep + character(len=2) :: prefix + character(len=256) :: warn_msg, err_msg + integer :: exit_code_ + !! Exit code for the program + integer :: verbose_ + !! Verbosity level + + integer, allocatable, dimension(:,:,:) :: bas_map,t1bas_map + real(real32), allocatable, dimension(:,:) :: trans + + + !--------------------------------------------------------------------------- + ! Initialise variables + !--------------------------------------------------------------------------- + exit_code_ = 0 + verbose_ = 0 + if(present(verbose)) verbose_ = verbose + + + !--------------------------------------------------------------------------- + ! Handle identifier + !--------------------------------------------------------------------------- + select case(identifier) + case(1) + call structure%copy(this%structure_lw, length=4) + call structure_compare%copy(this%structure_lw, length=4) + if(this%use_pricel_lw)then + if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for material")') + call get_primitive_cell(structure) + end if + miller_ = this%miller_lw + prefix = "lw" + layer_sep = this%layer_separation_cutoff(1) + case(2) + call structure%copy(this%structure_up, length=4) + call structure_compare%copy(this%structure_up, length=4) + if(this%use_pricel_up)then + if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for material")') + call get_primitive_cell(structure) + end if + miller_ = this%miller_up + prefix = "up" + layer_sep = this%layer_separation_cutoff(2) + case default + write(err_msg,'(A,I0,A)') & + "The identifier for the material is not valid: ", identifier + call stop_program(trim(err_msg)) + return + end select + ! check if the structures have anything (i.e. atoms) in them + if(structure%natom.eq.0)then + write(err_msg,'(A,I0,A)') & + "The structure has ", structure%natom, & + " atoms. It should have at least 1." + call stop_program(trim(err_msg)) + return + end if + + + ! set thickness if provided by user + thickness_ = 10._real32 + num_layers_ = 0 + if(present(num_layers)) num_layers_ = num_layers + if(present(thickness)) thickness_ = thickness + if(num_layers_.le.0.and.thickness_.le.0._real32)then + write(err_msg,'(A,I0,A)') & + "The number of layers for the material is ", & + num_layers_, " and the thickness is ", thickness_, & + " One of these must be greater than 0." + call stop_program(trim(err_msg)) + exit_code_ = 1 + return + end if + + + !--------------------------------------------------------------------------- + ! Handle the miller plane + !--------------------------------------------------------------------------- + if(present(miller)) miller_ = miller + if(all(miller_.eq.0))then + write(err_msg,'(A,I0,A)') & + "The miller plane is not valid: ", identifier + call stop_program(trim(err_msg)) + exit_code_ = 1 + return + end if + + + orthogonalise_ = .true. + if(present(orthogonalise)) orthogonalise_ = orthogonalise + break_on_fail_ = .false. + if(present(break_on_fail)) break_on_fail_ = break_on_fail + normalise_ = .true. + if(present(normalise)) normalise_ = normalise + surface_ = 0 + if(present(surface))then + select case(size(surface,dim=1)) + case(1) + surface_(:) = surface(1) + case(2) + surface_ = surface + case default + write(err_msg,'(A,I0,A)') & + "The surface termination indices have ", size(surface,dim=1), & + " components. It should have 1 or 2." + call stop_program(trim(err_msg)) + exit_code_ = 1 + return + end select + end if + + !! copy lattice and basis for manipulating + allocate(bas_map(structure%nspec,maxval(structure%spec(:)%num,dim=1),2)) + bas_map = -1 + + + if(verbose_.gt.0) write(*,'(1X,"Using supplied plane...")') + tfmat = planecutter(structure%lat,real(miller_,real32)) + call transformer(structure,tfmat,bas_map) + + + !--------------------------------------------------------------------------- + ! Finds smallest thickness of the slab and increases to ... + ! ... user-defined thickness + !--------------------------------------------------------------------------- + confine%l = .false. + confine%axis = this%axis + confine%laxis = .false. + confine%laxis(this%axis) = .true. + if(allocated(trans)) deallocate(trans) + allocate(trans(minval(structure%spec(:)%num+2),3)) + call gldfnd(confine, structure, structure, trans, ntrans) + tfmat(:,:) = 0._real32 + tfmat(1,1) = 1._real32 + tfmat(2,2) = 1._real32 + if(ntrans.eq.0)then + tfmat(3,3) = 1._real32 + else + itmp1=minloc(abs(trans(:ntrans,this%axis)),dim=1,& + mask=abs(trans(:ntrans,this%axis)).gt.1.D-3/modu(structure%lat(this%axis,:))) + tfmat(3,:) = trans(itmp1,:) + end if + if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 + call transformer(structure,tfmat,bas_map) + if(.not.compare_stoichiometry(structure,structure_compare))then + write(err_msg,'(A,I0,A)') & + "The transformed structure stoichiometry does not match the & + &original structure." + call stop_program(trim(err_msg)) + exit_code_ = 1 + return + end if + + + ! get the terminations + term = get_termination_info( & + structure, this%axis, & + verbose = verbose_, layer_sep = layer_sep, & + break_on_fail = break_on_fail_ & + ) + if(term%nterm .eq. 0)then + write(warn_msg, '(A,I0,1X,I0,1X,I0,A)') & + "No terminations found for Miller plane (",miller_,")" + call print_warning(trim(warn_msg)) + return + end if + + ! determine tolerance for layer separations (termination tolerance) + ! ... this is different from layer_sep + call set_layer_tol(term) + + ! determine required extension and perform that + call set_slab_height(structure, bas_map, term, surface_,& + height, num_layers_, thickness_, num_cells,& + term_start, term_end, term_step & + ) + + + !--------------------------------------------------------------------------- + ! Normalise lattice + !--------------------------------------------------------------------------- + if(normalise_)then + call reducer(structure) + structure%lat = MATNORM(structure%lat) + end if + + + !--------------------------------------------------------------------------- + ! loop over terminations and write them + !--------------------------------------------------------------------------- + num_structures = ( term_end - term_start ) / term_step + 1 + allocate(output(num_structures)) + do iterm = term_start, term_end, term_step + i = ( iterm - term_start ) / term_step + 1 + call output(i)%copy(structure, length=4) + if(allocated(t1bas_map)) deallocate(t1bas_map) + allocate(t1bas_map,source=bas_map) + call build_slab(output(i),bas_map,term,[iterm,surface_(2)],& + thickness_, num_cells, num_layers_, height,& + prefix, lcycle, orthogonalise_, this%vacuum_gap & + ) + end do + + end function get_terminations +!############################################################################### + + !############################################################################### subroutine generate_intefaces_from_existing(this, basis, interface_location, & - print_shift_info, seed & + print_shift_info, seed, verbose, exit_code & ) !! Generate interfaces for the given basis implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type type(basis_type), intent(in) :: basis !! Atomic structure data @@ -413,6 +694,10 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & !! Print shift information integer, intent(in), optional :: seed !! Random seed for generating random numbers + integer, intent(in), optional :: verbose + !! Verbosity level + integer, intent(out), optional :: exit_code + !! Exit code for the program ! Local variables integer :: is,ia,js,ja @@ -433,6 +718,21 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & type(bulk_DON_type), dimension(2) :: bulk_DON !! Distribution functions for the lower and upper bulk structures + integer :: verbose_ + !! Verbosity level + integer :: exit_code_ + !! Exit code for the program + character(len=256) :: err_msg + !! Error message + + + !--------------------------------------------------------------------------- + ! Initialise variables + !--------------------------------------------------------------------------- + exit_code_ = 0 + verbose_ = 0 + if(present(verbose)) verbose_ = verbose + !--------------------------------------------------------------------------- ! Set the random seed @@ -465,10 +765,10 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & write(*,*) "interface axis:",intf%axis write(*,*) "interface loc:",intf%loc !! write interface location to a file for user to refer back to - open(unit=10,file="interface_location.dat") - write(10,'(1X,"AXIS = ",I0)') intf%axis - write(10,'(1X,"INTF_LOC = ",2(2X,F9.6))') intf%loc - close(10) + ! open(unit=10,file="interface_location.dat") + ! write(10,'(1X,"AXIS = ",I0)') intf%axis + ! write(10,'(1X,"INTF_LOC = ",2(2X,F9.6))') intf%loc + ! close(10) end if specloop1: do is=1,basis%nspec atomloop1: do ia=1,basis%spec(is)%num @@ -506,8 +806,13 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond write(*,'(1X,"Trans-interfacial scaling factor:",F0.3)') this%separation_scale this%axis = intf%axis - call this%generate_perturbations(basis, intf%loc, min_bond, bulk_DON, print_shift_info_, seed_arr) + call this%generate_perturbations( & + basis, intf%loc, & + min_bond, bulk_DON, & + print_shift_info_, seed_arr, verbose_, exit_code_ & + ) + if(present(exit_code)) exit_code = exit_code_ end subroutine generate_intefaces_from_existing !############################################################################### @@ -529,7 +834,7 @@ subroutine generate_interfaces( & implicit none ! Arguments - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type integer, intent(in), dimension(:), optional :: surface_lw !! Surface indices for the lower bulk structure @@ -659,7 +964,7 @@ subroutine generate_interfaces( & if(present(icheck_match)) icheck_match_ = icheck_match if(present(interface_idx)) interface_idx_ = interface_idx - break_on_fail_ = .true. + break_on_fail_ = .false. if(present(break_on_fail)) break_on_fail_ = break_on_fail generate_structures_ = .true. @@ -720,20 +1025,20 @@ subroutine generate_interfaces( & ! Retrieve the primitive cells if necessary !--------------------------------------------------------------------------- if(this%use_pricel_lw)then - write(*,'(1X,"Using primitive cell for lower material")') + if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for lower material")') call get_primitive_cell(structure_lw) else - write(*,'(1X,"Using supplied cell for lower material")') + if(verbose_.gt.0) write(*,'(1X,"Using supplied cell for lower material")') call reducer(structure_lw) - structure_lw%lat=primitive_lat(structure_lw%lat) + structure_lw%lat = primitive_lat(structure_lw%lat) end if if(this%use_pricel_up)then - write(*,'(1X,"Using primitive cell for upper material")') + if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for upper material")') call get_primitive_cell(structure_up) else - write(*,'(1X,"Using supplied cell for upper material")') + if(verbose_.gt.0) write(*,'(1X,"Using supplied cell for upper material")') call reducer(structure_up) - structure_up%lat=primitive_lat(structure_up%lat) + structure_up%lat = primitive_lat(structure_up%lat) end if @@ -808,8 +1113,8 @@ subroutine generate_interfaces( & get_min_bulk_bond(structure_lw) + & get_min_bulk_bond(structure_up) & ) / 2._real32 - write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond - write(*,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale + if(verbose_.gt.0) write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond + if(verbose_.gt.0) write(*,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale if(this%shift_method.eq.-1) this%num_shifts = 1 @@ -994,33 +1299,28 @@ subroutine generate_interfaces( & nmiller=this%max_num_planes) end if if(min(this%tolerance%nstore,SAV%nfit).eq.0)then - write(0,'("No matches found.")') - write(0,'("Exiting...")') - call exit() + write(err_msg,'("No matches found between the two structures")') + call print_warning(trim(err_msg)) + return else - write(0,'(1X,"Number of matches found: ",I0)')& + if(verbose_.gt.0) write(*,'(1X,"Number of matches found: ",I0)')& min(this%tolerance%nstore,SAV%nfit) end if - write(*,'(1X,"Maximum number of generated interfaces will be: ",I0)')& + if(verbose_.gt.0) write(*,'(1X,"Maximum number of generated interfaces will be: ",I0)')& this%max_num_terms*this%num_shifts*this%tolerance%nstore if(.not.generate_structures_)then - write(0,'(1X,"Told not to generate interfaces, just find matches.")') - write(0,'("Exiting...")') - call exit() + if(verbose_.gt.0) write(*,'(1X,"Told not to generate structures, just find matches.")') + return end if !!!----------------------------------------------------------------------------- !!! Saves current directory and moves to new directory !!!----------------------------------------------------------------------------- - ! call system('mkdir -p '//trim(adjustl(dirname))) - ! call chdir(dirname) - ! call getcwd(intf_dir) - if(interface_idx_.gt.0)then intf_start=interface_idx_ intf_end=interface_idx_ - write(*,'(1X,"Generating only interfaces for match ",I0)') interface_idx_ + if(verbose_.gt.0) write(*,'(1X,"Generating only interfaces for match ",I0)') interface_idx_ else intf_start=1 intf_end=min(this%tolerance%nstore,SAV%nfit) @@ -1030,7 +1330,7 @@ subroutine generate_interfaces( & !!! Applies the best match transformations !!!----------------------------------------------------------------------------- intf_loop: do ifit = intf_start, intf_end - write(*,'("Fit number: ",I0)') ifit + if(verbose_.gt.0) write(*,'("Fit number: ",I0)') ifit call supercell_lw%copy(structure_lw) call supercell_up%copy(structure_up) if(allocated(t1lw_map)) deallocate(t1lw_map) @@ -1122,7 +1422,8 @@ subroutine generate_interfaces( & if(allocated(lw_term%arr)) deallocate(lw_term%arr) lw_term = get_termination_info( & supercell_lw, this%axis, & - lprint = print_termination_info_, layer_sep = this%layer_separation_cutoff(1), & + verbose = merge(1,verbose_,print_termination_info_), & + layer_sep = this%layer_separation_cutoff(1), & break_on_fail = break_on_fail_ & ) if(lw_term%nterm .eq. 0)then @@ -1203,7 +1504,8 @@ subroutine generate_interfaces( & if(allocated(up_term%arr)) deallocate(up_term%arr) up_term = get_termination_info( & supercell_up, this%axis, & - lprint = print_termination_info_, layer_sep = this%layer_separation_cutoff(2), & + verbose = merge(1,verbose_,print_termination_info_), & + layer_sep = this%layer_separation_cutoff(2), & break_on_fail = break_on_fail_ & ) if(up_term%nterm .eq. 0)then @@ -1248,7 +1550,7 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------------- !! Print termination plane locations !!----------------------------------------------------------------------- - write(*,'(1X,"Number of unique terminations: ",I0,2X,I0)') & + if(verbose_.gt.0) write(*,'(1X,"Number of unique terminations: ",I0,2X,I0)') & lw_term%nterm,up_term%nterm !!----------------------------------------------------------------------- @@ -1401,6 +1703,8 @@ subroutine generate_interfaces( & bulk_DON, & print_shift_info_, & seed_arr, & + verbose_, & + exit_code_, & t2lw_map & ) @@ -1419,14 +1723,14 @@ end subroutine generate_interfaces !!!############################################################################# !!! Takes input interface structure and generates a set of shifts and swaps. -!!! Prints these new structures to POSCARs. !!!############################################################################# !!! ISWAP METHOD NOT YET SET UP subroutine generate_shifts_and_swaps( & - this, basis, intf_loc, bond, bulk_DON, print_shift_info, seed_arr, map & + this, basis, intf_loc, bond, bulk_DON, print_shift_info, & + seed_arr, verbose, exit_code, map & ) implicit none - class(artemis_interface_generator_type), intent(inout) :: this + class(artemis_generator_type), intent(inout) :: this type(basis_type), intent(in) :: basis real(real32), dimension(2), intent(in) :: intf_loc real(real32), intent(in) :: bond @@ -1434,6 +1738,8 @@ subroutine generate_shifts_and_swaps( & !! Distribution functions for the lower and upper bulk structures logical, intent(in) :: print_shift_info integer, dimension(:), intent(in) :: seed_arr + integer, intent(in) :: verbose + integer, intent(inout) :: exit_code integer, dimension(:,:,:), optional, intent(in) :: map integer :: shift_unit @@ -1544,7 +1850,7 @@ subroutine generate_shifts_and_swaps( & !!!----------------------------------------------------------------------------- !!! Prints number of shifts to terminal !!!----------------------------------------------------------------------------- - write(*,'(3X,"Number of unique shifts structures: ",I0)') this%num_shifts + if(verbose.gt.0) write(*,'(3X,"Number of unique shifts structures: ",I0)') this%num_shifts !!!----------------------------------------------------------------------------- @@ -1552,7 +1858,7 @@ subroutine generate_shifts_and_swaps( & !!!----------------------------------------------------------------------------- nswaps_per_cell=nint(this%swap_density*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) if(this%swap_method.ne.0)then - write(*,& + if(verbose.gt.0) write(*,& '(" Generating ",I0," swaps per structure ")') nswaps_per_cell end if @@ -1710,4 +2016,4 @@ subroutine output_intf_data(SAV, ifit, lw_term, term_lw_idx, up_term, term_up_id end subroutine output_intf_data !!!############################################################################# -end module artemis__interface_generator +end module artemis__generator diff --git a/src/fortran/lib/mod_term_generator.f90 b/src/fortran/lib/mod_term_generator.f90 deleted file mode 100644 index 999330d..0000000 --- a/src/fortran/lib/mod_term_generator.f90 +++ /dev/null @@ -1,237 +0,0 @@ -!!!############################################################################# -!!! INTERFACES CARD SUBROUTINES -!!! Code written by Ned Thaddeus Taylor and Isiah Edward Mikel Rudkin -!!! Code part of the ARTEMIS group (Hepplestone research group). -!!! Think Hepplestone, think HRG. -!!!############################################################################# -module artemis__termination_generator - use artemis__constants, only: real32, ierror - use artemis__misc_types, only: abstract_artemis_generator_type - use artemis__geom_rw, only: basis_type - use artemis__io_utils, only: err_abort, print_warning - use artemis__io_utils_extd, only: err_abort_print_struc - use misc_linalg, only: modu - use edit_geom, only: planecutter, transformer, reducer, & - MATNORM, compare_stoichiometry - use artemis__sym, only: confine_type, gldfnd - use artemis__terminations, only: get_termination_info, term_arr_type, set_slab_height, set_layer_tol, build_slab - implicit none - - - private - - public :: artemis_termination_generator_type - - - type, extends(abstract_artemis_generator_type) :: artemis_termination_generator_type - - real(real32) :: layer_separation_cutoff = 1._real32 - - contains - procedure, pass(this) :: generate => generate_terminations - end type artemis_termination_generator_type - - - -contains - -!############################################################################### - subroutine generate_terminations( & - this, basis, miller_plane, axis, surface, num_layers, thickness, & - orthogonalise, normalise, break_on_fail & - ) - !! Generate and prints terminations parallel to the supplied miller plane - implicit none - - ! Arguments - class(artemis_termination_generator_type), intent(inout) :: this - !! Instance of artemis generator type - type(basis_type), intent(in) :: basis - !! Atomic structure data - integer, dimension(3), intent(in) :: miller_plane - !! Miller plane - integer, intent(in) :: axis - !! Axis along which to align the slab - integer, dimension(:), intent(in), optional :: surface - !! Surface termination indices - integer, intent(in), optional :: num_layers - !! Number of layers in the slab - real(real32), intent(in), optional :: thickness - !! Thickness of the slab (in Å) - logical, intent(in), optional :: orthogonalise - !! Boolean whether to orthogonalise the lattice - logical, intent(in), optional :: normalise - !! Boolean whether to normalise the lattice and basis - logical, intent(in), optional :: break_on_fail - !! Boolean whether to break on failure - - type(basis_type), dimension(:), allocatable :: output - !! Output structures - - ! Local variables - integer :: itmp1, iterm, term_start, term_end, iterm_step, i - !! Termination loop variables - integer :: num_cells, ntrans - !! Number of cells in the slab - integer :: num_structures - !! Number of structures to be generated - integer, dimension(2) :: surface_ - !! Surface termination indices - integer :: num_layers_ - !! Number of layers in the slab - real(real32) :: height - !! Height of the slab - logical :: lcycle - !! Boolean whether to cycle through the slab - type(basis_type) :: tmp_bas1,tmp_bas2 - !! Temporary basis structures - type(confine_type) :: confine - !! Confine structure along the specified axis - type(term_arr_type) :: term - !! List of terminations - real(real32), dimension(3,3) :: tfmat - !! Transformation matrix - logical :: orthogonalise_ - !! Boolean whether to orthogonalise the lattice - logical :: normalise_ - !! Boolean whether to normalise the lattice - logical :: break_on_fail_ - !! Boolean whether to break on failure - - - character(len=256) :: warn_msg - - integer, allocatable, dimension(:,:,:) :: bas_map,t1bas_map - real(real32), allocatable, dimension(:,:) :: trans - - - orthogonalise_ = .true. - if(present(orthogonalise)) orthogonalise_ = orthogonalise - break_on_fail_ = .true. - if(present(break_on_fail)) break_on_fail_ = break_on_fail - normalise_ = .true. - if(present(normalise)) normalise_ = normalise - surface_ = 0 - if(present(surface))then - select case(size(surface,dim=1)) - case(1) - surface_(:) = surface(1) - case(2) - surface_ = surface - case default - write(0,'(1X,"ERROR: Internal error in generate_terminations")') - write(0,'(2X,"The surface termination indices are not of the correct size")') - return - end select - end if - - !! copy lattice and basis for manipulating - call tmp_bas1%copy(basis) - allocate(bas_map(tmp_bas1%nspec,maxval(tmp_bas1%spec(:)%num,dim=1),2)) - bas_map = -1 - - - write(*,'(1X,"Using supplied plane...")') - tfmat = planecutter(tmp_bas1%lat,real(miller_plane,real32)) - call transformer(tmp_bas1,tfmat,bas_map) - !call err_abort_print_struc(bas,"check.vasp","stop") - - - !--------------------------------------------------------------------------- - ! Finds smallest thickness of the slab and increases to ... - ! ... user-defined thickness - !--------------------------------------------------------------------------- - confine%l = .false. - confine%axis = this%axis - confine%laxis = .false. - confine%laxis(this%axis) = .true. - if(allocated(trans)) deallocate(trans) - allocate(trans(minval(tmp_bas1%spec(:)%num+2),3)) - call gldfnd(confine, tmp_bas1, tmp_bas1, trans, ntrans) - tfmat(:,:) = 0._real32 - tfmat(1,1) = 1._real32 - tfmat(2,2) = 1._real32 - if(ntrans.eq.0)then - tfmat(3,3)=1._real32 - else - itmp1=minloc(abs(trans(:ntrans,this%axis)),dim=1,& - mask=abs(trans(:ntrans,this%axis)).gt.1.D-3/modu(tmp_bas1%lat(this%axis,:))) - tfmat(3,:)=trans(itmp1,:) - end if - if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 - call transformer(tmp_bas1,tfmat,bas_map) - if(.not.compare_stoichiometry(tmp_bas1,basis))then - write(0,'(1X,"ERROR: Internal error in generate_terminations")') - write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the material")') - if(ierror.eq.1)then - call err_abort_print_struc(tmp_bas1, "broken_primitive.vasp", & - "Code exiting due to IPRINT = 1") - end if - write(0,'(2X,"Skipping this lattice match")') - return - end if - - ! get the terminations - term = get_termination_info( & - tmp_bas1, this%axis, & - lprint = .true., layer_sep = this%layer_separation_cutoff, & - break_on_fail = break_on_fail_ & - ) - if(term%nterm .eq. 0)then - write(warn_msg, '(A,I0,1X,I0,1X,I0,A)') & - "No terminations found for Miller plane (",miller_plane,")" - call print_warning(trim(warn_msg)) - return - end if - - ! set thickness if provided by user - if(present(num_layers))then - num_layers_ = num_layers - else - num_layers_ = 1 - end if - - ! determine tolerance for layer separations (termination tolerance) - ! ... this is different from layer_sep - call set_layer_tol(term) - - ! determine required extension and perform that - call set_slab_height(tmp_bas1,bas_map,term,surface_,& - height,num_layers_, thickness, num_cells,& - term_start,term_end,iterm_step & - ) - - !--------------------------------------------------------------------------- - ! Normalise lattice - !--------------------------------------------------------------------------- - if(normalise_)then - call reducer(tmp_bas1) - tmp_bas1%lat = MATNORM(tmp_bas1%lat) - end if - - - !--------------------------------------------------------------------------- - ! loop over terminations and write them - !--------------------------------------------------------------------------- - num_structures = ( term_end - term_start ) / iterm_step + 1 - allocate(output(num_structures)) - do iterm = term_start, term_end, iterm_step - i = ( iterm - term_start ) / iterm_step + 1 - call output(i)%copy(tmp_bas1) - if(allocated(t1bas_map)) deallocate(t1bas_map) - allocate(t1bas_map,source=bas_map) - call build_slab(output(i),bas_map,term,[iterm,surface_(2)],& - thickness, num_cells, num_layers_, height,& - "lw", lcycle, orthogonalise_, this%vacuum_gap & - ) - end do - if(.not.allocated(this%structures))then - call move_alloc(output,this%structures) - else - this%structures = [ this%structures, output ] - end if - - end subroutine generate_terminations -!############################################################################### - -end module artemis__termination_generator diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index b9ed6ab..d4402e8 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -49,7 +49,7 @@ module artemis__terminations !############################################################################### function get_termination_info( & - basis, axis, lprint, layer_sep, break_on_fail & + basis, axis, verbose, layer_sep, break_on_fail & ) result(term) !! Function to find the terminations of a material along a given axis implicit none @@ -60,10 +60,10 @@ function get_termination_info( & integer, intent(in) :: axis !! Axis to find terminations along (1,2,3) !! 1=a, 2=b, 3=c + integer, intent(in) :: verbose + !! Verbosity level real(real32), intent(in), optional :: layer_sep !! Minimum separation between layers - logical, intent(in), optional :: lprint - !! Boolean whether to print terminations logical, intent(in), optional :: break_on_fail !! Boolean whether to break on failure to find terminations @@ -72,7 +72,7 @@ function get_termination_info( & !! Loop indices and dimensions integer :: itmp1, itmp2, init, min_loc !! Temporary indices - logical :: ludef_print, lunique, ltmp1, lmirror, break_on_fail_ + logical :: lunique, ltmp1, lmirror, break_on_fail_ !! Boolean flags real(real32) :: rtmp1, tol, height, max_sep, c_along, centre !! Temporary variables @@ -113,11 +113,6 @@ function get_termination_info( & !--------------------------------------------------------------------------- ! Set printing option !--------------------------------------------------------------------------- - if(present(lprint))then - ludef_print = lprint - else - ludef_print = .false. - end if break_on_fail_ = .false. if(present(break_on_fail)) break_on_fail_ = break_on_fail @@ -442,7 +437,7 @@ function get_termination_info( & term%axis=axis term%nterm=mterm term%lmirror = lmirror - if(ludef_print)& + if(verbose.gt.0)& write(*,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') rtmp1 = term_arr_uniq(1)%hmin-1.E-6_real32 itmp1 = 1 @@ -453,7 +448,7 @@ function get_termination_info( & term%arr(i)%natom = term_arr_uniq(itmp1)%natom term%arr(i)%nstep = term_arr_uniq(itmp1)%nstep term%arr(i)%ladder(:term%arr(i)%nstep) = term_arr_uniq(i)%ladder(:term%arr(i)%nstep) - if(ludef_print) write(*,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + if(verbose.gt.0) write(*,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & i,term%arr(i)%hmin,term%arr(i)%hmax,term%arr(i)%natom itmp1 = minloc(term_arr_uniq(:)%hmin,& mask=term_arr_uniq(:)%hmin.gt.rtmp1+layer_sep_,dim=1) @@ -576,8 +571,8 @@ end subroutine set_layer_tol !############################################################################### - subroutine set_slab_height( basis, map, term, surf,& - height, num_layers, thickness, num_cells,& + subroutine set_slab_height( basis, map, term, surf, & + height, num_layers, thickness, num_cells, & term_start, term_end, term_step & ) !! Extend the basis to the maximum required height for all terminations diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 new file mode 100644 index 0000000..bbc3b76 --- /dev/null +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -0,0 +1,1371 @@ +! Module artemis__generator defined in file ../src/fortran/lib/mod_intf_generator.f90 + +subroutine f90wrap_artemis_gen_type__get__num_structures(this, f90wrap_num_structures) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_structures + + this_ptr = transfer(this, this_ptr) + f90wrap_num_structures = this_ptr%p%num_structures +end subroutine f90wrap_artemis_gen_type__get__num_structures + +subroutine f90wrap_artemis_gen_type__set__num_structures(this, f90wrap_num_structures) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_structures + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_structures = f90wrap_num_structures +end subroutine f90wrap_artemis_gen_type__set__num_structures + +subroutine f90wrap_artemis_gen_type__get__max_num_structures(this, f90wrap_max_num_structures) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_structures + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_structures = this_ptr%p%max_num_structures +end subroutine f90wrap_artemis_gen_type__get__max_num_structures + +subroutine f90wrap_artemis_gen_type__set__max_num_structures(this, f90wrap_max_num_structures) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_structures + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_structures = f90wrap_max_num_structures +end subroutine f90wrap_artemis_gen_type__set__max_num_structures + + +subroutine f90wrap_artemis_gen_type__get__structure_lw(this, f90wrap_structure_lw) + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_structure_lw(2) + type(basis_type_ptr_type) :: structure_lw_ptr + + this_ptr = transfer(this, this_ptr) + structure_lw_ptr%p => this_ptr%p%structure_lw + f90wrap_structure_lw = transfer(structure_lw_ptr,f90wrap_structure_lw) +end subroutine f90wrap_artemis_gen_type__get__structure_lw + +subroutine f90wrap_artemis_gen_type__set__structure_lw(this, f90wrap_structure_lw) + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_structure_lw(2) + type(basis_type_ptr_type) :: structure_lw_ptr + + this_ptr = transfer(this, this_ptr) + structure_lw_ptr = transfer(f90wrap_structure_lw,structure_lw_ptr) + this_ptr%p%structure_lw = structure_lw_ptr%p +end subroutine f90wrap_artemis_gen_type__set__structure_lw + +subroutine f90wrap_artemis_gen_type__get__structure_up(this, f90wrap_structure_up) + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_structure_up(2) + type(basis_type_ptr_type) :: structure_up_ptr + + this_ptr = transfer(this, this_ptr) + structure_up_ptr%p => this_ptr%p%structure_up + f90wrap_structure_up = transfer(structure_up_ptr,f90wrap_structure_up) +end subroutine f90wrap_artemis_gen_type__get__structure_up + +subroutine f90wrap_artemis_gen_type__set__structure_up(this, f90wrap_structure_up) + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_structure_up(2) + type(basis_type_ptr_type) :: structure_up_ptr + + this_ptr = transfer(this, this_ptr) + structure_up_ptr = transfer(f90wrap_structure_up,structure_up_ptr) + this_ptr%p%structure_up = structure_up_ptr%p +end subroutine f90wrap_artemis_gen_type__set__structure_up + +subroutine f90wrap_artemis_gen_type__array__elastic_co4c3f(this, nd, dtype, dshape, dloc) + use artemis__generator, only: artemis_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_generator_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) + if (allocated(this_ptr%p%elastic_constants_lw)) then + dshape(1:1) = shape(this_ptr%p%elastic_constants_lw) + dloc = loc(this_ptr%p%elastic_constants_lw) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_gen_type__array__elastic_co4c3f + +subroutine f90wrap_artemis_gen_type__array__elastic_coedb6(this, nd, dtype, dshape, dloc) + use artemis__generator, only: artemis_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_generator_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) + if (allocated(this_ptr%p%elastic_constants_up)) then + dshape(1:1) = shape(this_ptr%p%elastic_constants_up) + dloc = loc(this_ptr%p%elastic_constants_up) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_gen_type__array__elastic_coedb6 + +subroutine f90wrap_artemis_gen_type__get__use_pricel_lw(this, f90wrap_use_pricel_lw) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_use_pricel_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_use_pricel_lw = this_ptr%p%use_pricel_lw +end subroutine f90wrap_artemis_gen_type__get__use_pricel_lw + +subroutine f90wrap_artemis_gen_type__set__use_pricel_lw(this, f90wrap_use_pricel_lw) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_use_pricel_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%use_pricel_lw = f90wrap_use_pricel_lw +end subroutine f90wrap_artemis_gen_type__set__use_pricel_lw + +subroutine f90wrap_artemis_gen_type__get__use_pricel_up(this, f90wrap_use_pricel_up) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_use_pricel_up + + this_ptr = transfer(this, this_ptr) + f90wrap_use_pricel_up = this_ptr%p%use_pricel_up +end subroutine f90wrap_artemis_gen_type__get__use_pricel_up + +subroutine f90wrap_artemis_gen_type__set__use_pricel_up(this, f90wrap_use_pricel_up) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_use_pricel_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%use_pricel_up = f90wrap_use_pricel_up +end subroutine f90wrap_artemis_gen_type__set__use_pricel_up + +subroutine f90wrap_artemis_gen_type__array__miller_lw(this, nd, dtype, dshape, dloc) + use artemis__generator, only: artemis_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_generator_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%miller_lw) + dloc = loc(this_ptr%p%miller_lw) +end subroutine f90wrap_artemis_gen_type__array__miller_lw + +subroutine f90wrap_artemis_gen_type__get__is_layered_lw(this, f90wrap_is_layered_lw) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_is_layered_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_is_layered_lw = this_ptr%p%is_layered_lw +end subroutine f90wrap_artemis_gen_type__get__is_layered_lw + +subroutine f90wrap_artemis_gen_type__set__is_layered_lw(this, f90wrap_is_layered_lw) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_is_layered_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%is_layered_lw = f90wrap_is_layered_lw +end subroutine f90wrap_artemis_gen_type__set__is_layered_lw + +subroutine f90wrap_artemis_gen_type__get__is_layered_up(this, f90wrap_is_layered_up) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_is_layered_up + + this_ptr = transfer(this, this_ptr) + f90wrap_is_layered_up = this_ptr%p%is_layered_up +end subroutine f90wrap_artemis_gen_type__get__is_layered_up + +subroutine f90wrap_artemis_gen_type__set__is_layered_up(this, f90wrap_is_layered_up) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_is_layered_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%is_layered_up = f90wrap_is_layered_up +end subroutine f90wrap_artemis_gen_type__set__is_layered_up + +subroutine f90wrap_artemis_gen_type__get__ludef_is_lay4aa6(this, f90wrap_ludef_is_layered_lw) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_ludef_is_layered_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_ludef_is_layered_lw = this_ptr%p%ludef_is_layered_lw +end subroutine f90wrap_artemis_gen_type__get__ludef_is_lay4aa6 + +subroutine f90wrap_artemis_gen_type__set__ludef_is_lay87a5(this, f90wrap_ludef_is_layered_lw) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_ludef_is_layered_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%ludef_is_layered_lw = f90wrap_ludef_is_layered_lw +end subroutine f90wrap_artemis_gen_type__set__ludef_is_lay87a5 + +subroutine f90wrap_artemis_gen_type__get__ludef_is_lay60fd(this, f90wrap_ludef_is_layered_up) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_ludef_is_layered_up + + this_ptr = transfer(this, this_ptr) + f90wrap_ludef_is_layered_up = this_ptr%p%ludef_is_layered_up +end subroutine f90wrap_artemis_gen_type__get__ludef_is_lay60fd + +subroutine f90wrap_artemis_gen_type__set__ludef_is_laye6e4(this, f90wrap_ludef_is_layered_up) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_ludef_is_layered_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%ludef_is_layered_up = f90wrap_ludef_is_layered_up +end subroutine f90wrap_artemis_gen_type__set__ludef_is_laye6e4 + + + + + + +subroutine f90wrap_artemis_gen_type__get__shift_method(this, f90wrap_shift_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_shift_method + + this_ptr = transfer(this, this_ptr) + f90wrap_shift_method = this_ptr%p%shift_method +end subroutine f90wrap_artemis_gen_type__get__shift_method + +subroutine f90wrap_artemis_gen_type__set__shift_method(this, f90wrap_shift_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_shift_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%shift_method = f90wrap_shift_method +end subroutine f90wrap_artemis_gen_type__set__shift_method + +subroutine f90wrap_artemis_gen_type__get__num_shifts(this, f90wrap_num_shifts) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_shifts + + this_ptr = transfer(this, this_ptr) + f90wrap_num_shifts = this_ptr%p%num_shifts +end subroutine f90wrap_artemis_gen_type__get__num_shifts + +subroutine f90wrap_artemis_gen_type__set__num_shifts(this, f90wrap_num_shifts) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_shifts + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_shifts = f90wrap_num_shifts +end subroutine f90wrap_artemis_gen_type__set__num_shifts + +subroutine f90wrap_artemis_gen_type__array__shifts(this, nd, dtype, dshape, dloc) + use artemis__generator, only: artemis_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_generator_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%shifts)) then + dshape(1:2) = shape(this_ptr%p%shifts) + dloc = loc(this_ptr%p%shifts) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_gen_type__array__shifts + +subroutine f90wrap_artemis_gen_type__get__interface_depth(this, f90wrap_interface_depth) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_interface_depth + + this_ptr = transfer(this, this_ptr) + f90wrap_interface_depth = this_ptr%p%interface_depth +end subroutine f90wrap_artemis_gen_type__get__interface_depth + +subroutine f90wrap_artemis_gen_type__set__interface_depth(this, f90wrap_interface_depth) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_interface_depth + + this_ptr = transfer(this, this_ptr) + this_ptr%p%interface_depth = f90wrap_interface_depth +end subroutine f90wrap_artemis_gen_type__set__interface_depth + +subroutine f90wrap_artemis_gen_type__get__separation_scale(this, f90wrap_separation_scale) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_separation_scale + + this_ptr = transfer(this, this_ptr) + f90wrap_separation_scale = this_ptr%p%separation_scale +end subroutine f90wrap_artemis_gen_type__get__separation_scale + +subroutine f90wrap_artemis_gen_type__set__separation_scale(this, f90wrap_separation_scale) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_separation_scale + + this_ptr = transfer(this, this_ptr) + this_ptr%p%separation_scale = f90wrap_separation_scale +end subroutine f90wrap_artemis_gen_type__set__separation_scale + +subroutine f90wrap_artemis_gen_type__get__depth_method(this, f90wrap_depth_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_depth_method + + this_ptr = transfer(this, this_ptr) + f90wrap_depth_method = this_ptr%p%depth_method +end subroutine f90wrap_artemis_gen_type__get__depth_method + +subroutine f90wrap_artemis_gen_type__set__depth_method(this, f90wrap_depth_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_depth_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%depth_method = f90wrap_depth_method +end subroutine f90wrap_artemis_gen_type__set__depth_method + +subroutine f90wrap_artemis_gen_type__array__shift_data(this, nd, dtype, dshape, dloc) + use artemis__generator, only: artemis_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_generator_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%shift_data)) then + dshape(1:2) = shape(this_ptr%p%shift_data) + dloc = loc(this_ptr%p%shift_data) + else + dloc = 0 + end if +end subroutine f90wrap_artemis_gen_type__array__shift_data + +subroutine f90wrap_artemis_gen_type__get__swap_method(this, f90wrap_swap_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_swap_method + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_method = this_ptr%p%swap_method +end subroutine f90wrap_artemis_gen_type__get__swap_method + +subroutine f90wrap_artemis_gen_type__set__swap_method(this, f90wrap_swap_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_swap_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_method = f90wrap_swap_method +end subroutine f90wrap_artemis_gen_type__set__swap_method + +subroutine f90wrap_artemis_gen_type__get__num_swaps(this, f90wrap_num_swaps) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_num_swaps + + this_ptr = transfer(this, this_ptr) + f90wrap_num_swaps = this_ptr%p%num_swaps +end subroutine f90wrap_artemis_gen_type__get__num_swaps + +subroutine f90wrap_artemis_gen_type__set__num_swaps(this, f90wrap_num_swaps) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_num_swaps + + this_ptr = transfer(this, this_ptr) + this_ptr%p%num_swaps = f90wrap_num_swaps +end subroutine f90wrap_artemis_gen_type__set__num_swaps + +subroutine f90wrap_artemis_gen_type__get__swap_density(this, f90wrap_swap_density) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_swap_density + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_density = this_ptr%p%swap_density +end subroutine f90wrap_artemis_gen_type__get__swap_density + +subroutine f90wrap_artemis_gen_type__set__swap_density(this, f90wrap_swap_density) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_swap_density + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_density = f90wrap_swap_density +end subroutine f90wrap_artemis_gen_type__set__swap_density + +subroutine f90wrap_artemis_gen_type__get__swap_depth(this, f90wrap_swap_depth) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_swap_depth + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_depth = this_ptr%p%swap_depth +end subroutine f90wrap_artemis_gen_type__get__swap_depth + +subroutine f90wrap_artemis_gen_type__set__swap_depth(this, f90wrap_swap_depth) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_swap_depth + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_depth = f90wrap_swap_depth +end subroutine f90wrap_artemis_gen_type__set__swap_depth + +subroutine f90wrap_artemis_gen_type__get__swap_sigma(this, f90wrap_swap_sigma) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_swap_sigma + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_sigma = this_ptr%p%swap_sigma +end subroutine f90wrap_artemis_gen_type__get__swap_sigma + +subroutine f90wrap_artemis_gen_type__set__swap_sigma(this, f90wrap_swap_sigma) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_swap_sigma + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_sigma = f90wrap_swap_sigma +end subroutine f90wrap_artemis_gen_type__set__swap_sigma + +subroutine f90wrap_artemis_gen_type__get__require_mirr41cf( & + this, f90wrap_require_mirror_swaps) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_require_mirror_swaps + + this_ptr = transfer(this, this_ptr) + f90wrap_require_mirror_swaps = this_ptr%p%require_mirror_swaps +end subroutine f90wrap_artemis_gen_type__get__require_mirr41cf + +subroutine f90wrap_artemis_gen_type__set__require_mirr3bfa( & + this, f90wrap_require_mirror_swaps) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_require_mirror_swaps + + this_ptr = transfer(this, this_ptr) + this_ptr%p%require_mirror_swaps = f90wrap_require_mirror_swaps +end subroutine f90wrap_artemis_gen_type__set__require_mirr3bfa + +subroutine f90wrap_artemis_gen_type__get__match_method(this, f90wrap_match_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_match_method + + this_ptr = transfer(this, this_ptr) + f90wrap_match_method = this_ptr%p%match_method +end subroutine f90wrap_artemis_gen_type__get__match_method + +subroutine f90wrap_artemis_gen_type__set__match_method(this, f90wrap_match_method) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_match_method + + this_ptr = transfer(this, this_ptr) + this_ptr%p%match_method = f90wrap_match_method +end subroutine f90wrap_artemis_gen_type__set__match_method + +subroutine f90wrap_artemis_gen_type__get__max_num_matches(this, f90wrap_max_num_matches) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_matches + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_matches = this_ptr%p%max_num_matches +end subroutine f90wrap_artemis_gen_type__get__max_num_matches + +subroutine f90wrap_artemis_gen_type__set__max_num_matches(this, f90wrap_max_num_matches) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_matches + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_matches = f90wrap_max_num_matches +end subroutine f90wrap_artemis_gen_type__set__max_num_matches + +subroutine f90wrap_artemis_gen_type__get__max_num_terms(this, f90wrap_max_num_terms) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_terms + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_terms = this_ptr%p%max_num_terms +end subroutine f90wrap_artemis_gen_type__get__max_num_terms + +subroutine f90wrap_artemis_gen_type__set__max_num_terms(this, f90wrap_max_num_terms) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_terms + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_terms = f90wrap_max_num_terms +end subroutine f90wrap_artemis_gen_type__set__max_num_terms + +subroutine f90wrap_artemis_gen_type__get__max_num_planes(this, f90wrap_max_num_planes) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_max_num_planes + + this_ptr = transfer(this, this_ptr) + f90wrap_max_num_planes = this_ptr%p%max_num_planes +end subroutine f90wrap_artemis_gen_type__get__max_num_planes + +subroutine f90wrap_artemis_gen_type__set__max_num_planes(this, f90wrap_max_num_planes) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_max_num_planes + + this_ptr = transfer(this, this_ptr) + this_ptr%p%max_num_planes = f90wrap_max_num_planes +end subroutine f90wrap_artemis_gen_type__set__max_num_planes + +subroutine f90wrap_artemis_gen_type__get__fix_normal(this, f90wrap_fix_normal) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_fix_normal + + this_ptr = transfer(this, this_ptr) + f90wrap_fix_normal = this_ptr%p%fix_normal +end subroutine f90wrap_artemis_gen_type__get__fix_normal + +subroutine f90wrap_artemis_gen_type__set__fix_normal(this, f90wrap_fix_normal) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_fix_normal + + this_ptr = transfer(this, this_ptr) + this_ptr%p%fix_normal = f90wrap_fix_normal +end subroutine f90wrap_artemis_gen_type__set__fix_normal + +subroutine f90wrap_artemis_gen_type__get__bondlength_c21a8(this, f90wrap_bondlength_cutoff) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_bondlength_cutoff + + this_ptr = transfer(this, this_ptr) + f90wrap_bondlength_cutoff = this_ptr%p%bondlength_cutoff +end subroutine f90wrap_artemis_gen_type__get__bondlength_c21a8 + +subroutine f90wrap_artemis_gen_type__set__bondlength_cbd11(this, f90wrap_bondlength_cutoff) + use artemis__generator, only: artemis_generator_type + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(in) :: this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_bondlength_cutoff + + this_ptr = transfer(this, this_ptr) + this_ptr%p%bondlength_cutoff = f90wrap_bondlength_cutoff +end subroutine f90wrap_artemis_gen_type__set__bondlength_cbd11 + +subroutine f90wrap_artemis_gen_type__array__layer_sepa90a5(this, nd, dtype, dshape, dloc) + use artemis__generator, only: artemis_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_generator_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%layer_separation_cutoff) + dloc = loc(this_ptr%p%layer_separation_cutoff) +end subroutine f90wrap_artemis_gen_type__array__layer_sepa90a5 + +subroutine f90wrap_intf_gen__artemis_interface_gen0ea8(this) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_intf_gen__artemis_interface_gen0ea8 + +subroutine f90wrap_intf_gen__artemis_interface_genbc51(this) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_intf_gen__artemis_interface_genbc51 + +subroutine f90wrap_intf_gen__set_tolerance__bindinfd58(this, vector_mismatch, angle_mismatch, & + area_mismatch, max_length, max_area, max_fit, max_extension, angle_weight, area_weight) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), intent(in), optional :: vector_mismatch + real(4), intent(in), optional :: angle_mismatch + real(4), intent(in), optional :: area_mismatch + real(4), intent(in), optional :: max_length + real(4), intent(in), optional :: max_area + integer, intent(in), optional :: max_fit + integer, intent(in), optional :: max_extension + real(4), intent(in), optional :: angle_weight + real(4), intent(in), optional :: area_weight + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_tolerance( & + vector_mismatch=vector_mismatch, & + angle_mismatch=angle_mismatch, & + area_mismatch=area_mismatch, max_length=max_length, & + max_area=max_area, max_fit=max_fit, max_extension=max_extension, & + angle_weight=angle_weight, area_weight=area_weight) +end subroutine f90wrap_intf_gen__set_tolerance__bindinfd58 + +subroutine f90wrap_intf_gen__set_shift_method__bin4dc1(this, method, num_shifts, shifts, & + interface_depth, separation_scale, depth_method, n0) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in), optional :: method + integer, intent(in), optional :: num_shifts + real(4), dimension(n0), intent(in), optional :: shifts + real(4), intent(in), optional :: interface_depth + real(4), intent(in), optional :: separation_scale + integer, intent(in), optional :: depth_method + integer :: n0 + !f2py intent(hide), depend(shifts) :: n0 = shape(shifts,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_shift_method( & + method=method, num_shifts=num_shifts, & + shifts=shifts, interface_depth=interface_depth, & + separation_scale=separation_scale, depth_method=depth_method) +end subroutine f90wrap_intf_gen__set_shift_method__bin4dc1 + +subroutine f90wrap_intf_gen__set_materials__bindin017c(this, structure_lw, structure_up, & + elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_ptr_type) :: structure_lw_ptr + integer, intent(in), dimension(2) :: structure_lw + type(basis_type_ptr_type) :: structure_up_ptr + integer, intent(in), dimension(2) :: structure_up + real(4), intent(in), optional, dimension(n0) :: elastic_constants_lw + real(4), intent(in), optional, dimension(n1) :: elastic_constants_up + logical, intent(in), optional :: use_pricel_lw + logical, intent(in), optional :: use_pricel_up + integer :: n0 + !f2py intent(hide), depend(elastic_constants_lw) :: n0 = shape(elastic_constants_lw,0) + integer :: n1 + !f2py intent(hide), depend(elastic_constants_up) :: n1 = shape(elastic_constants_up,0) + this_ptr = transfer(this, this_ptr) + structure_lw_ptr = transfer(structure_lw, structure_lw_ptr) + structure_up_ptr = transfer(structure_up, structure_up_ptr) + call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & + elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & + use_pricel_up=use_pricel_up) +end subroutine f90wrap_intf_gen__set_materials__bindin017c + +subroutine f90wrap_intf_gen__set_surface_propertie615d(this, miller_lw, miller_up, is_layered_lw, & + is_layered_up) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, dimension(3), intent(in), optional :: miller_lw + integer, dimension(3), intent(in), optional :: miller_up + logical, intent(in), optional :: is_layered_lw + logical, intent(in), optional :: is_layered_up + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_surface_properties(miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, & + is_layered_up=is_layered_up) +end subroutine f90wrap_intf_gen__set_surface_propertie615d + +subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8(this) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%reset_is_layered_lw() +end subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8 + +subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c(this) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%reset_is_layered_up() +end subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c + + + + + + + + + + + +subroutine f90wrap_intf_gen__get_terminations__binding__agt( & + this, identifier, miller, surface, num_layers, thickness, & + orthogonalise, normalise, break_on_fail, & + verbose, exit_code, & + n_ret_structures, n0) + use artemis__geom_rw, only: basis_type + use artemis__generator, only: artemis_generator_type + use artemis__structure_cache, only: store_last_generated_structures + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_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(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in):: identifier + integer, dimension(3), intent(in), optional :: miller + integer, intent(in), optional, dimension(n0) :: surface + real(4), intent(in), optional :: thickness + integer, intent(in), optional :: num_layers + logical, intent(in), optional :: orthogonalise + logical, intent(in), optional :: normalise + logical, intent(in), optional :: break_on_fail + integer, intent(in), optional :: verbose + integer, optional, intent(out) :: exit_code + integer :: n0 + !f2py intent(hide), depend(surface_lw) :: n0 = shape(surface_lw,0) + type(basis_type), allocatable, dimension(:) :: local_structures + integer, intent(out) :: n_ret_structures + + this_ptr = transfer(this, this_ptr) + local_structures = this_ptr%p%get_terminations( & + identifier=identifier, miller=miller, surface=surface, & + num_layers=num_layers, thickness=thickness, & + orthogonalise=orthogonalise, normalise=normalise, & + break_on_fail=break_on_fail, verbose=verbose, exit_code=exit_code) + + n_ret_structures = size(local_structures, dim=1) + + ! Store local_structures in a module-level array so Python can retrieve it + call store_last_generated_structures(local_structures) +end subroutine f90wrap_intf_gen__get_terminations__binding__agt + +subroutine f90wrap_retrieve_last_generated_structures(num_structures, structures) + use artemis__geom_rw, only: basis_type + use artemis__structure_cache, only: retrieve_last_generated_structures + implicit none + + 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 + integer, intent(in) :: num_structures + integer, intent(inout), dimension(2) :: structures + type(basis_type_xnum_array_ptr_type) :: structures_ptr + + structures_ptr = transfer(structures, structures_ptr) + structures_ptr%p%items = retrieve_last_generated_structures() + structures = transfer(structures_ptr, structures) +end subroutine f90wrap_retrieve_last_generated_structures + + + + + +subroutine f90wrap_intf_gen__generate__binding__agt( & + this, surface_lw, surface_up, & + thickness_lw, thickness_up, & + num_layers_lw, num_layers_up, & + print_lattice_match_info, print_termination_info, print_shift_info, & + break_on_fail, icheck_match, interface_idx, & + generate_structures, & + seed, verbose, exit_code, & + n0, n1) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in), optional, dimension(n0) :: surface_lw + integer, intent(in), optional, dimension(n1) :: surface_up + real(4), intent(in), optional :: thickness_lw + real(4), intent(in), optional :: thickness_up + integer, intent(in), optional :: num_layers_lw + integer, intent(in), optional :: num_layers_up + logical, intent(in), optional :: print_lattice_match_info + logical, intent(in), optional :: print_termination_info + logical, intent(in), optional :: print_shift_info + logical, intent(in), optional :: break_on_fail + integer, intent(in), optional :: icheck_match + integer, intent(in), optional :: interface_idx + logical, intent(in), optional :: generate_structures + integer, intent(in), optional :: seed + integer, intent(in), optional :: verbose + integer, optional, intent(inout) :: exit_code + integer :: n0 + !f2py intent(hide), depend(surface_lw) :: n0 = shape(surface_lw,0) + integer :: n1 + !f2py intent(hide), depend(surface_up) :: n1 = shape(surface_up,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%generate(surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, & + thickness_up=thickness_up, num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, & + print_lattice_match_info=print_lattice_match_info, print_termination_info=print_termination_info, & + print_shift_info=print_shift_info, break_on_fail=break_on_fail, icheck_match=icheck_match, & + interface_idx=interface_idx, generate_structures=generate_structures, seed=seed, verbose=verbose, & + exit_code=exit_code) +end subroutine f90wrap_intf_gen__generate__binding__agt + +subroutine f90wrap_intf_gen__restart__binding__agt(this, basis, interface_location, & + print_shift_info, seed, verbose, exit_code) + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_ptr_type) :: basis_ptr + integer, intent(in), dimension(2) :: basis + real(4), dimension(2), intent(in), optional :: interface_location + logical, intent(in), optional :: print_shift_info + integer, intent(in), optional :: seed + integer, intent(in), optional :: verbose + integer, optional, intent(inout) :: exit_code + this_ptr = transfer(this, this_ptr) + basis_ptr = transfer(basis, basis_ptr) + call this_ptr%p%restart(basis=basis_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & + seed=seed, verbose=verbose, exit_code=exit_code) +end subroutine f90wrap_intf_gen__restart__binding__agt + +subroutine f90wrap_intf_gen__get_structures__binding__agt(this, ret_structures) + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_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(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(out), dimension(2) :: ret_structures + type(basis_type_xnum_array_ptr_type) :: ret_structures_ptr + + this_ptr = transfer(this, this_ptr) + ret_structures_ptr%p%items = this_ptr%p%get_structures() + ret_structures = transfer(ret_structures_ptr,ret_structures) +end subroutine f90wrap_intf_gen__get_structures__binding__agt + + +!############################################################################### +! generated structures handling +!############################################################################### +subroutine f90wrap_artemis_gen_type__array_getitem__structures( & + f90wrap_this, f90wrap_i, structuresitem & +) + + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: f90wrap_this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(out) :: structuresitem(2) + type(basis_type_ptr_type) :: structures_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structures)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structures)) then + call f90wrap_abort("array index out of range") + else + structures_ptr%p => this_ptr%p%structures(f90wrap_i) + structuresitem = transfer(structures_ptr,structuresitem) + endif + else + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_artemis_gen_type__array_getitem__structures + +subroutine f90wrap_artemis_gen_type__array_setitem__structures( & + f90wrap_this, f90wrap_i, structuresitem & +) + + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + integer, intent(in) :: f90wrap_this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(in) :: structuresitem(2) + type(basis_type_ptr_type) :: structures_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structures)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structures)) then + call f90wrap_abort("array index out of range") + else + structures_ptr = transfer(structuresitem,structures_ptr) + this_ptr%p%structures(f90wrap_i) = structures_ptr%p + endif + else + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_artemis_gen_type__array_setitem__structures + +subroutine f90wrap_artemis_gen_type__array_len__structures( & + f90wrap_this, f90wrap_n & +) + + use artemis__generator, only: artemis_generator_type + use artemis__geom_rw, only: basis_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(out) :: f90wrap_n + integer, intent(in) :: f90wrap_this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structures)) then + f90wrap_n = size(this_ptr%p%structures) + else + f90wrap_n = 0 + end if +end subroutine f90wrap_artemis_gen_type__array_len__structures +!############################################################################### + +! End of module artemis__generator defined in file ../src/fortran/lib/mod_intf_generator.f90 + diff --git a/src/wrapper/f90wrap_mod_intf_generator.f90 b/src/wrapper/f90wrap_mod_intf_generator.f90 deleted file mode 100644 index e63c498..0000000 --- a/src/wrapper/f90wrap_mod_intf_generator.f90 +++ /dev/null @@ -1,1293 +0,0 @@ -! Module artemis__interface_generator defined in file ../src/fortran/lib/mod_intf_generator.f90 - -subroutine f90wrap_artemis_intf_gen_type__get__num_structures(this, f90wrap_num_structures) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_num_structures - - this_ptr = transfer(this, this_ptr) - f90wrap_num_structures = this_ptr%p%num_structures -end subroutine f90wrap_artemis_intf_gen_type__get__num_structures - -subroutine f90wrap_artemis_intf_gen_type__set__num_structures(this, f90wrap_num_structures) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_num_structures - - this_ptr = transfer(this, this_ptr) - this_ptr%p%num_structures = f90wrap_num_structures -end subroutine f90wrap_artemis_intf_gen_type__set__num_structures - -subroutine f90wrap_artemis_intf_gen_type__get__max_num_structures(this, f90wrap_max_num_structures) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_max_num_structures - - this_ptr = transfer(this, this_ptr) - f90wrap_max_num_structures = this_ptr%p%max_num_structures -end subroutine f90wrap_artemis_intf_gen_type__get__max_num_structures - -subroutine f90wrap_artemis_intf_gen_type__set__max_num_structures(this, f90wrap_max_num_structures) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_max_num_structures - - this_ptr = transfer(this, this_ptr) - this_ptr%p%max_num_structures = f90wrap_max_num_structures -end subroutine f90wrap_artemis_intf_gen_type__set__max_num_structures - - -subroutine f90wrap_artemis_intf_gen_type__get__structure_lw(this, f90wrap_structure_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_structure_lw(2) - type(basis_type_ptr_type) :: structure_lw_ptr - - this_ptr = transfer(this, this_ptr) - structure_lw_ptr%p => this_ptr%p%structure_lw - f90wrap_structure_lw = transfer(structure_lw_ptr,f90wrap_structure_lw) -end subroutine f90wrap_artemis_intf_gen_type__get__structure_lw - -subroutine f90wrap_artemis_intf_gen_type__set__structure_lw(this, f90wrap_structure_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_structure_lw(2) - type(basis_type_ptr_type) :: structure_lw_ptr - - this_ptr = transfer(this, this_ptr) - structure_lw_ptr = transfer(f90wrap_structure_lw,structure_lw_ptr) - this_ptr%p%structure_lw = structure_lw_ptr%p -end subroutine f90wrap_artemis_intf_gen_type__set__structure_lw - -subroutine f90wrap_artemis_intf_gen_type__get__structure_up(this, f90wrap_structure_up) - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_structure_up(2) - type(basis_type_ptr_type) :: structure_up_ptr - - this_ptr = transfer(this, this_ptr) - structure_up_ptr%p => this_ptr%p%structure_up - f90wrap_structure_up = transfer(structure_up_ptr,f90wrap_structure_up) -end subroutine f90wrap_artemis_intf_gen_type__get__structure_up - -subroutine f90wrap_artemis_intf_gen_type__set__structure_up(this, f90wrap_structure_up) - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_structure_up(2) - type(basis_type_ptr_type) :: structure_up_ptr - - this_ptr = transfer(this, this_ptr) - structure_up_ptr = transfer(f90wrap_structure_up,structure_up_ptr) - this_ptr%p%structure_up = structure_up_ptr%p -end subroutine f90wrap_artemis_intf_gen_type__set__structure_up - -subroutine f90wrap_artemis_intf_gen_type__array__elastic_co4c3f(this, nd, dtype, dshape, dloc) - use artemis__interface_generator, only: artemis_interface_generator_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(artemis_interface_generator_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) - if (allocated(this_ptr%p%elastic_constants_lw)) then - dshape(1:1) = shape(this_ptr%p%elastic_constants_lw) - dloc = loc(this_ptr%p%elastic_constants_lw) - else - dloc = 0 - end if -end subroutine f90wrap_artemis_intf_gen_type__array__elastic_co4c3f - -subroutine f90wrap_artemis_intf_gen_type__array__elastic_coedb6(this, nd, dtype, dshape, dloc) - use artemis__interface_generator, only: artemis_interface_generator_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(artemis_interface_generator_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) - if (allocated(this_ptr%p%elastic_constants_up)) then - dshape(1:1) = shape(this_ptr%p%elastic_constants_up) - dloc = loc(this_ptr%p%elastic_constants_up) - else - dloc = 0 - end if -end subroutine f90wrap_artemis_intf_gen_type__array__elastic_coedb6 - -subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_lw(this, f90wrap_use_pricel_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_use_pricel_lw - - this_ptr = transfer(this, this_ptr) - f90wrap_use_pricel_lw = this_ptr%p%use_pricel_lw -end subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_lw - -subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_lw(this, f90wrap_use_pricel_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_use_pricel_lw - - this_ptr = transfer(this, this_ptr) - this_ptr%p%use_pricel_lw = f90wrap_use_pricel_lw -end subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_lw - -subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_up(this, f90wrap_use_pricel_up) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_use_pricel_up - - this_ptr = transfer(this, this_ptr) - f90wrap_use_pricel_up = this_ptr%p%use_pricel_up -end subroutine f90wrap_artemis_intf_gen_type__get__use_pricel_up - -subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_up(this, f90wrap_use_pricel_up) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_use_pricel_up - - this_ptr = transfer(this, this_ptr) - this_ptr%p%use_pricel_up = f90wrap_use_pricel_up -end subroutine f90wrap_artemis_intf_gen_type__set__use_pricel_up - -subroutine f90wrap_artemis_intf_gen_type__array__miller_lw(this, nd, dtype, dshape, dloc) - use artemis__interface_generator, only: artemis_interface_generator_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(artemis_interface_generator_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%miller_lw) - dloc = loc(this_ptr%p%miller_lw) -end subroutine f90wrap_artemis_intf_gen_type__array__miller_lw - -subroutine f90wrap_artemis_intf_gen_type__get__is_layered_lw(this, f90wrap_is_layered_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_is_layered_lw - - this_ptr = transfer(this, this_ptr) - f90wrap_is_layered_lw = this_ptr%p%is_layered_lw -end subroutine f90wrap_artemis_intf_gen_type__get__is_layered_lw - -subroutine f90wrap_artemis_intf_gen_type__set__is_layered_lw(this, f90wrap_is_layered_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_is_layered_lw - - this_ptr = transfer(this, this_ptr) - this_ptr%p%is_layered_lw = f90wrap_is_layered_lw -end subroutine f90wrap_artemis_intf_gen_type__set__is_layered_lw - -subroutine f90wrap_artemis_intf_gen_type__get__is_layered_up(this, f90wrap_is_layered_up) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_is_layered_up - - this_ptr = transfer(this, this_ptr) - f90wrap_is_layered_up = this_ptr%p%is_layered_up -end subroutine f90wrap_artemis_intf_gen_type__get__is_layered_up - -subroutine f90wrap_artemis_intf_gen_type__set__is_layered_up(this, f90wrap_is_layered_up) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_is_layered_up - - this_ptr = transfer(this, this_ptr) - this_ptr%p%is_layered_up = f90wrap_is_layered_up -end subroutine f90wrap_artemis_intf_gen_type__set__is_layered_up - -subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay4aa6(this, f90wrap_ludef_is_layered_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_ludef_is_layered_lw - - this_ptr = transfer(this, this_ptr) - f90wrap_ludef_is_layered_lw = this_ptr%p%ludef_is_layered_lw -end subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay4aa6 - -subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_lay87a5(this, f90wrap_ludef_is_layered_lw) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_ludef_is_layered_lw - - this_ptr = transfer(this, this_ptr) - this_ptr%p%ludef_is_layered_lw = f90wrap_ludef_is_layered_lw -end subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_lay87a5 - -subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay60fd(this, f90wrap_ludef_is_layered_up) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_ludef_is_layered_up - - this_ptr = transfer(this, this_ptr) - f90wrap_ludef_is_layered_up = this_ptr%p%ludef_is_layered_up -end subroutine f90wrap_artemis_intf_gen_type__get__ludef_is_lay60fd - -subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_laye6e4(this, f90wrap_ludef_is_layered_up) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_ludef_is_layered_up - - this_ptr = transfer(this, this_ptr) - this_ptr%p%ludef_is_layered_up = f90wrap_ludef_is_layered_up -end subroutine f90wrap_artemis_intf_gen_type__set__ludef_is_laye6e4 - - - - - - -subroutine f90wrap_artemis_intf_gen_type__get__shift_method(this, f90wrap_shift_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_shift_method - - this_ptr = transfer(this, this_ptr) - f90wrap_shift_method = this_ptr%p%shift_method -end subroutine f90wrap_artemis_intf_gen_type__get__shift_method - -subroutine f90wrap_artemis_intf_gen_type__set__shift_method(this, f90wrap_shift_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_shift_method - - this_ptr = transfer(this, this_ptr) - this_ptr%p%shift_method = f90wrap_shift_method -end subroutine f90wrap_artemis_intf_gen_type__set__shift_method - -subroutine f90wrap_artemis_intf_gen_type__get__num_shifts(this, f90wrap_num_shifts) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_num_shifts - - this_ptr = transfer(this, this_ptr) - f90wrap_num_shifts = this_ptr%p%num_shifts -end subroutine f90wrap_artemis_intf_gen_type__get__num_shifts - -subroutine f90wrap_artemis_intf_gen_type__set__num_shifts(this, f90wrap_num_shifts) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_num_shifts - - this_ptr = transfer(this, this_ptr) - this_ptr%p%num_shifts = f90wrap_num_shifts -end subroutine f90wrap_artemis_intf_gen_type__set__num_shifts - -subroutine f90wrap_artemis_intf_gen_type__array__shifts(this, nd, dtype, dshape, dloc) - use artemis__interface_generator, only: artemis_interface_generator_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(artemis_interface_generator_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%shifts)) then - dshape(1:2) = shape(this_ptr%p%shifts) - dloc = loc(this_ptr%p%shifts) - else - dloc = 0 - end if -end subroutine f90wrap_artemis_intf_gen_type__array__shifts - -subroutine f90wrap_artemis_intf_gen_type__get__interface_depth(this, f90wrap_interface_depth) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_interface_depth - - this_ptr = transfer(this, this_ptr) - f90wrap_interface_depth = this_ptr%p%interface_depth -end subroutine f90wrap_artemis_intf_gen_type__get__interface_depth - -subroutine f90wrap_artemis_intf_gen_type__set__interface_depth(this, f90wrap_interface_depth) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_interface_depth - - this_ptr = transfer(this, this_ptr) - this_ptr%p%interface_depth = f90wrap_interface_depth -end subroutine f90wrap_artemis_intf_gen_type__set__interface_depth - -subroutine f90wrap_artemis_intf_gen_type__get__separation_scale(this, f90wrap_separation_scale) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_separation_scale - - this_ptr = transfer(this, this_ptr) - f90wrap_separation_scale = this_ptr%p%separation_scale -end subroutine f90wrap_artemis_intf_gen_type__get__separation_scale - -subroutine f90wrap_artemis_intf_gen_type__set__separation_scale(this, f90wrap_separation_scale) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_separation_scale - - this_ptr = transfer(this, this_ptr) - this_ptr%p%separation_scale = f90wrap_separation_scale -end subroutine f90wrap_artemis_intf_gen_type__set__separation_scale - -subroutine f90wrap_artemis_intf_gen_type__get__depth_method(this, f90wrap_depth_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_depth_method - - this_ptr = transfer(this, this_ptr) - f90wrap_depth_method = this_ptr%p%depth_method -end subroutine f90wrap_artemis_intf_gen_type__get__depth_method - -subroutine f90wrap_artemis_intf_gen_type__set__depth_method(this, f90wrap_depth_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_depth_method - - this_ptr = transfer(this, this_ptr) - this_ptr%p%depth_method = f90wrap_depth_method -end subroutine f90wrap_artemis_intf_gen_type__set__depth_method - -subroutine f90wrap_artemis_intf_gen_type__array__shift_data(this, nd, dtype, dshape, dloc) - use artemis__interface_generator, only: artemis_interface_generator_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(artemis_interface_generator_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%shift_data)) then - dshape(1:2) = shape(this_ptr%p%shift_data) - dloc = loc(this_ptr%p%shift_data) - else - dloc = 0 - end if -end subroutine f90wrap_artemis_intf_gen_type__array__shift_data - -subroutine f90wrap_artemis_intf_gen_type__get__swap_method(this, f90wrap_swap_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_swap_method - - this_ptr = transfer(this, this_ptr) - f90wrap_swap_method = this_ptr%p%swap_method -end subroutine f90wrap_artemis_intf_gen_type__get__swap_method - -subroutine f90wrap_artemis_intf_gen_type__set__swap_method(this, f90wrap_swap_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_swap_method - - this_ptr = transfer(this, this_ptr) - this_ptr%p%swap_method = f90wrap_swap_method -end subroutine f90wrap_artemis_intf_gen_type__set__swap_method - -subroutine f90wrap_artemis_intf_gen_type__get__num_swaps(this, f90wrap_num_swaps) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_num_swaps - - this_ptr = transfer(this, this_ptr) - f90wrap_num_swaps = this_ptr%p%num_swaps -end subroutine f90wrap_artemis_intf_gen_type__get__num_swaps - -subroutine f90wrap_artemis_intf_gen_type__set__num_swaps(this, f90wrap_num_swaps) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_num_swaps - - this_ptr = transfer(this, this_ptr) - this_ptr%p%num_swaps = f90wrap_num_swaps -end subroutine f90wrap_artemis_intf_gen_type__set__num_swaps - -subroutine f90wrap_artemis_intf_gen_type__get__swap_density(this, f90wrap_swap_density) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_swap_density - - this_ptr = transfer(this, this_ptr) - f90wrap_swap_density = this_ptr%p%swap_density -end subroutine f90wrap_artemis_intf_gen_type__get__swap_density - -subroutine f90wrap_artemis_intf_gen_type__set__swap_density(this, f90wrap_swap_density) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_swap_density - - this_ptr = transfer(this, this_ptr) - this_ptr%p%swap_density = f90wrap_swap_density -end subroutine f90wrap_artemis_intf_gen_type__set__swap_density - -subroutine f90wrap_artemis_intf_gen_type__get__swap_depth(this, f90wrap_swap_depth) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_swap_depth - - this_ptr = transfer(this, this_ptr) - f90wrap_swap_depth = this_ptr%p%swap_depth -end subroutine f90wrap_artemis_intf_gen_type__get__swap_depth - -subroutine f90wrap_artemis_intf_gen_type__set__swap_depth(this, f90wrap_swap_depth) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_swap_depth - - this_ptr = transfer(this, this_ptr) - this_ptr%p%swap_depth = f90wrap_swap_depth -end subroutine f90wrap_artemis_intf_gen_type__set__swap_depth - -subroutine f90wrap_artemis_intf_gen_type__get__swap_sigma(this, f90wrap_swap_sigma) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_swap_sigma - - this_ptr = transfer(this, this_ptr) - f90wrap_swap_sigma = this_ptr%p%swap_sigma -end subroutine f90wrap_artemis_intf_gen_type__get__swap_sigma - -subroutine f90wrap_artemis_intf_gen_type__set__swap_sigma(this, f90wrap_swap_sigma) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_swap_sigma - - this_ptr = transfer(this, this_ptr) - this_ptr%p%swap_sigma = f90wrap_swap_sigma -end subroutine f90wrap_artemis_intf_gen_type__set__swap_sigma - -subroutine f90wrap_artemis_intf_gen_type__get__require_mirr41cf( & - this, f90wrap_require_mirror_swaps) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_require_mirror_swaps - - this_ptr = transfer(this, this_ptr) - f90wrap_require_mirror_swaps = this_ptr%p%require_mirror_swaps -end subroutine f90wrap_artemis_intf_gen_type__get__require_mirr41cf - -subroutine f90wrap_artemis_intf_gen_type__set__require_mirr3bfa( & - this, f90wrap_require_mirror_swaps) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_require_mirror_swaps - - this_ptr = transfer(this, this_ptr) - this_ptr%p%require_mirror_swaps = f90wrap_require_mirror_swaps -end subroutine f90wrap_artemis_intf_gen_type__set__require_mirr3bfa - -subroutine f90wrap_artemis_intf_gen_type__get__match_method(this, f90wrap_match_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_match_method - - this_ptr = transfer(this, this_ptr) - f90wrap_match_method = this_ptr%p%match_method -end subroutine f90wrap_artemis_intf_gen_type__get__match_method - -subroutine f90wrap_artemis_intf_gen_type__set__match_method(this, f90wrap_match_method) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_match_method - - this_ptr = transfer(this, this_ptr) - this_ptr%p%match_method = f90wrap_match_method -end subroutine f90wrap_artemis_intf_gen_type__set__match_method - -subroutine f90wrap_artemis_intf_gen_type__get__max_num_matches(this, f90wrap_max_num_matches) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_max_num_matches - - this_ptr = transfer(this, this_ptr) - f90wrap_max_num_matches = this_ptr%p%max_num_matches -end subroutine f90wrap_artemis_intf_gen_type__get__max_num_matches - -subroutine f90wrap_artemis_intf_gen_type__set__max_num_matches(this, f90wrap_max_num_matches) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_max_num_matches - - this_ptr = transfer(this, this_ptr) - this_ptr%p%max_num_matches = f90wrap_max_num_matches -end subroutine f90wrap_artemis_intf_gen_type__set__max_num_matches - -subroutine f90wrap_artemis_intf_gen_type__get__max_num_terms(this, f90wrap_max_num_terms) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_max_num_terms - - this_ptr = transfer(this, this_ptr) - f90wrap_max_num_terms = this_ptr%p%max_num_terms -end subroutine f90wrap_artemis_intf_gen_type__get__max_num_terms - -subroutine f90wrap_artemis_intf_gen_type__set__max_num_terms(this, f90wrap_max_num_terms) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_max_num_terms - - this_ptr = transfer(this, this_ptr) - this_ptr%p%max_num_terms = f90wrap_max_num_terms -end subroutine f90wrap_artemis_intf_gen_type__set__max_num_terms - -subroutine f90wrap_artemis_intf_gen_type__get__max_num_planes(this, f90wrap_max_num_planes) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out) :: f90wrap_max_num_planes - - this_ptr = transfer(this, this_ptr) - f90wrap_max_num_planes = this_ptr%p%max_num_planes -end subroutine f90wrap_artemis_intf_gen_type__get__max_num_planes - -subroutine f90wrap_artemis_intf_gen_type__set__max_num_planes(this, f90wrap_max_num_planes) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_max_num_planes - - this_ptr = transfer(this, this_ptr) - this_ptr%p%max_num_planes = f90wrap_max_num_planes -end subroutine f90wrap_artemis_intf_gen_type__set__max_num_planes - -subroutine f90wrap_artemis_intf_gen_type__get__fix_normal(this, f90wrap_fix_normal) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_fix_normal - - this_ptr = transfer(this, this_ptr) - f90wrap_fix_normal = this_ptr%p%fix_normal -end subroutine f90wrap_artemis_intf_gen_type__get__fix_normal - -subroutine f90wrap_artemis_intf_gen_type__set__fix_normal(this, f90wrap_fix_normal) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_fix_normal - - this_ptr = transfer(this, this_ptr) - this_ptr%p%fix_normal = f90wrap_fix_normal -end subroutine f90wrap_artemis_intf_gen_type__set__fix_normal - -subroutine f90wrap_artemis_intf_gen_type__get__bondlength_c21a8(this, f90wrap_bondlength_cutoff) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_bondlength_cutoff - - this_ptr = transfer(this, this_ptr) - f90wrap_bondlength_cutoff = this_ptr%p%bondlength_cutoff -end subroutine f90wrap_artemis_intf_gen_type__get__bondlength_c21a8 - -subroutine f90wrap_artemis_intf_gen_type__set__bondlength_cbd11(this, f90wrap_bondlength_cutoff) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_bondlength_cutoff - - this_ptr = transfer(this, this_ptr) - this_ptr%p%bondlength_cutoff = f90wrap_bondlength_cutoff -end subroutine f90wrap_artemis_intf_gen_type__set__bondlength_cbd11 - -subroutine f90wrap_artemis_intf_gen_type__array__layer_sepa90a5(this, nd, dtype, dshape, dloc) - use artemis__interface_generator, only: artemis_interface_generator_type - use, intrinsic :: iso_c_binding, only : c_int - implicit none - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer(c_int), intent(in) :: this(2) - type(artemis_interface_generator_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%layer_separation_cutoff) - dloc = loc(this_ptr%p%layer_separation_cutoff) -end subroutine f90wrap_artemis_intf_gen_type__array__layer_sepa90a5 - -subroutine f90wrap_intf_gen__artemis_interface_gen0ea8(this) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(out), dimension(2) :: this - allocate(this_ptr%p) - this = transfer(this_ptr, this) -end subroutine f90wrap_intf_gen__artemis_interface_gen0ea8 - -subroutine f90wrap_intf_gen__artemis_interface_genbc51(this) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - deallocate(this_ptr%p) -end subroutine f90wrap_intf_gen__artemis_interface_genbc51 - -subroutine f90wrap_intf_gen__set_tolerance__bindinfd58(this, vector_mismatch, angle_mismatch, & - area_mismatch, max_length, max_area, max_fit, max_extension, angle_weight, area_weight) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - real(4), intent(in), optional :: vector_mismatch - real(4), intent(in), optional :: angle_mismatch - real(4), intent(in), optional :: area_mismatch - real(4), intent(in), optional :: max_length - real(4), intent(in), optional :: max_area - integer, intent(in), optional :: max_fit - integer, intent(in), optional :: max_extension - real(4), intent(in), optional :: angle_weight - real(4), intent(in), optional :: area_weight - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_tolerance( & - vector_mismatch=vector_mismatch, & - angle_mismatch=angle_mismatch, & - area_mismatch=area_mismatch, max_length=max_length, & - max_area=max_area, max_fit=max_fit, max_extension=max_extension, & - angle_weight=angle_weight, area_weight=area_weight) -end subroutine f90wrap_intf_gen__set_tolerance__bindinfd58 - -subroutine f90wrap_intf_gen__set_shift_method__bin4dc1(this, method, num_shifts, shifts, & - interface_depth, separation_scale, depth_method, n0) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - integer, intent(in), optional :: method - integer, intent(in), optional :: num_shifts - real(4), dimension(n0), intent(in), optional :: shifts - real(4), intent(in), optional :: interface_depth - real(4), intent(in), optional :: separation_scale - integer, intent(in), optional :: depth_method - integer :: n0 - !f2py intent(hide), depend(shifts) :: n0 = shape(shifts,0) - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_shift_method( & - method=method, num_shifts=num_shifts, & - shifts=shifts, interface_depth=interface_depth, & - separation_scale=separation_scale, depth_method=depth_method) -end subroutine f90wrap_intf_gen__set_shift_method__bin4dc1 - -subroutine f90wrap_intf_gen__set_materials__bindin017c(this, structure_lw, structure_up, & - elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - type(basis_type_ptr_type) :: structure_lw_ptr - integer, intent(in), dimension(2) :: structure_lw - type(basis_type_ptr_type) :: structure_up_ptr - integer, intent(in), dimension(2) :: structure_up - real(4), intent(in), optional, dimension(n0) :: elastic_constants_lw - real(4), intent(in), optional, dimension(n1) :: elastic_constants_up - logical, intent(in), optional :: use_pricel_lw - logical, intent(in), optional :: use_pricel_up - integer :: n0 - !f2py intent(hide), depend(elastic_constants_lw) :: n0 = shape(elastic_constants_lw,0) - integer :: n1 - !f2py intent(hide), depend(elastic_constants_up) :: n1 = shape(elastic_constants_up,0) - this_ptr = transfer(this, this_ptr) - structure_lw_ptr = transfer(structure_lw, structure_lw_ptr) - structure_up_ptr = transfer(structure_up, structure_up_ptr) - call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & - elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & - use_pricel_up=use_pricel_up) -end subroutine f90wrap_intf_gen__set_materials__bindin017c - -subroutine f90wrap_intf_gen__set_surface_propertie615d(this, miller_lw, miller_up, is_layered_lw, & - is_layered_up) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - integer, dimension(3), intent(in), optional :: miller_lw - integer, dimension(3), intent(in), optional :: miller_up - logical, intent(in), optional :: is_layered_lw - logical, intent(in), optional :: is_layered_up - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_surface_properties(miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, & - is_layered_up=is_layered_up) -end subroutine f90wrap_intf_gen__set_surface_propertie615d - -subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8(this) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - call this_ptr%p%reset_is_layered_lw() -end subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8 - -subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c(this) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - call this_ptr%p%reset_is_layered_up() -end subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c - - - - - - - - - - - -subroutine f90wrap_intf_gen__generate__binding__aigt( & - this, surface_lw, surface_up, & - thickness_lw, thickness_up, & - num_layers_lw, num_layers_up, & - print_lattice_match_info, print_termination_info, print_shift_info, & - break_on_fail, icheck_match, interface_idx, & - generate_structures, & - seed, verbose, exit_code, & - n0, n1) - use artemis__interface_generator, only: artemis_interface_generator_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - integer, intent(in), optional, dimension(n0) :: surface_lw - integer, intent(in), optional, dimension(n1) :: surface_up - real(4), intent(in), optional :: thickness_lw - real(4), intent(in), optional :: thickness_up - integer, intent(in), optional :: num_layers_lw - integer, intent(in), optional :: num_layers_up - logical, intent(in), optional :: print_lattice_match_info - logical, intent(in), optional :: print_termination_info - logical, intent(in), optional :: print_shift_info - logical, intent(in), optional :: break_on_fail - integer, intent(in), optional :: icheck_match - integer, intent(in), optional :: interface_idx - logical, intent(in), optional :: generate_structures - integer, intent(in), optional :: seed - integer, intent(in), optional :: verbose - integer, optional, intent(inout) :: exit_code - integer :: n0 - !f2py intent(hide), depend(surface_lw) :: n0 = shape(surface_lw,0) - integer :: n1 - !f2py intent(hide), depend(surface_up) :: n1 = shape(surface_up,0) - this_ptr = transfer(this, this_ptr) - call this_ptr%p%generate(surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, & - thickness_up=thickness_up, num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, & - print_lattice_match_info=print_lattice_match_info, print_termination_info=print_termination_info, & - print_shift_info=print_shift_info, break_on_fail=break_on_fail, icheck_match=icheck_match, & - interface_idx=interface_idx, generate_structures=generate_structures, seed=seed, verbose=verbose, & - exit_code=exit_code) -end subroutine f90wrap_intf_gen__generate__binding__aigt - -subroutine f90wrap_intf_gen__restart__binding__aigt(this, basis, interface_location, & - print_shift_info, seed) - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - type(basis_type_ptr_type) :: basis_ptr - integer, intent(in), dimension(2) :: basis - real(4), dimension(2), intent(in), optional :: interface_location - logical, intent(in), optional :: print_shift_info - integer, intent(in), optional :: seed - this_ptr = transfer(this, this_ptr) - basis_ptr = transfer(basis, basis_ptr) - call this_ptr%p%restart(basis=basis_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & - seed=seed) -end subroutine f90wrap_intf_gen__restart__binding__aigt - -subroutine f90wrap_intf_gen__get_structures__binding__aigt(this, ret_structures) - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_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(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - integer, intent(out), dimension(2) :: ret_structures - type(basis_type_xnum_array_ptr_type) :: ret_structures_ptr - - this_ptr = transfer(this, this_ptr) - ret_structures_ptr%p%items = this_ptr%p%get_structures() - ret_structures = transfer(ret_structures_ptr,ret_structures) -end subroutine f90wrap_intf_gen__get_structures__binding__aigt - - -!############################################################################### -! generated structures handling -!############################################################################### -subroutine f90wrap_artemis_intf_gen_type__array_getitem__structures( & - f90wrap_this, f90wrap_i, structuresitem & -) - - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - integer, intent(in) :: f90wrap_this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_i - integer, intent(out) :: structuresitem(2) - type(basis_type_ptr_type) :: structures_ptr - - this_ptr = transfer(f90wrap_this, this_ptr) - if (allocated(this_ptr%p%structures)) then - if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structures)) then - call f90wrap_abort("array index out of range") - else - structures_ptr%p => this_ptr%p%structures(f90wrap_i) - structuresitem = transfer(structures_ptr,structuresitem) - endif - else - call f90wrap_abort("derived type array not allocated") - end if -end subroutine f90wrap_artemis_intf_gen_type__array_getitem__structures - -subroutine f90wrap_artemis_intf_gen_type__array_setitem__structures( & - f90wrap_this, f90wrap_i, structuresitem & -) - - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - integer, intent(in) :: f90wrap_this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - integer, intent(in) :: f90wrap_i - integer, intent(in) :: structuresitem(2) - type(basis_type_ptr_type) :: structures_ptr - - this_ptr = transfer(f90wrap_this, this_ptr) - if (allocated(this_ptr%p%structures)) then - if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structures)) then - call f90wrap_abort("array index out of range") - else - structures_ptr = transfer(structuresitem,structures_ptr) - this_ptr%p%structures(f90wrap_i) = structures_ptr%p - endif - else - call f90wrap_abort("derived type array not allocated") - end if -end subroutine f90wrap_artemis_intf_gen_type__array_setitem__structures - -subroutine f90wrap_artemis_intf_gen_type__array_len__structures( & - f90wrap_this, f90wrap_n & -) - - use artemis__interface_generator, only: artemis_interface_generator_type - use artemis__geom_rw, only: basis_type - implicit none - - type artemis_interface_generator_type_ptr_type - type(artemis_interface_generator_type), pointer :: p => NULL() - end type artemis_interface_generator_type_ptr_type - integer, intent(out) :: f90wrap_n - integer, intent(in) :: f90wrap_this(2) - type(artemis_interface_generator_type_ptr_type) :: this_ptr - - this_ptr = transfer(f90wrap_this, this_ptr) - if (allocated(this_ptr%p%structures)) then - f90wrap_n = size(this_ptr%p%structures) - else - f90wrap_n = 0 - end if -end subroutine f90wrap_artemis_intf_gen_type__array_len__structures -!############################################################################### - -! End of module artemis__interface_generator defined in file ../src/fortran/lib/mod_intf_generator.f90 - diff --git a/src/wrapper/f90wrap_mod_term_generator.f90 b/src/wrapper/f90wrap_mod_term_generator.f90 deleted file mode 100644 index caf22b1..0000000 --- a/src/wrapper/f90wrap_mod_term_generator.f90 +++ /dev/null @@ -1,91 +0,0 @@ -! Module artemis__termination_generator defined in file ../src/fortran/lib/mod_term_generator.f90 - -subroutine f90wrap_artemis_termination_generator_type__get__layer_sepace78(this, f90wrap_layer_separation_cutoff) - use artemis__termination_generator, only: artemis_termination_generator_type - implicit none - type artemis_termination_generator_type_ptr_type - type(artemis_termination_generator_type), pointer :: p => NULL() - end type artemis_termination_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_termination_generator_type_ptr_type) :: this_ptr - real(4), intent(out) :: f90wrap_layer_separation_cutoff - - this_ptr = transfer(this, this_ptr) - f90wrap_layer_separation_cutoff = this_ptr%p%layer_separation_cutoff -end subroutine f90wrap_artemis_termination_generator_type__get__layer_sepace78 - -subroutine f90wrap_artemis_termination_generator_type__set__layer_sepae7ef(this, f90wrap_layer_separation_cutoff) - use artemis__termination_generator, only: artemis_termination_generator_type - implicit none - type artemis_termination_generator_type_ptr_type - type(artemis_termination_generator_type), pointer :: p => NULL() - end type artemis_termination_generator_type_ptr_type - integer, intent(in) :: this(2) - type(artemis_termination_generator_type_ptr_type) :: this_ptr - real(4), intent(in) :: f90wrap_layer_separation_cutoff - - this_ptr = transfer(this, this_ptr) - this_ptr%p%layer_separation_cutoff = f90wrap_layer_separation_cutoff -end subroutine f90wrap_artemis_termination_generator_type__set__layer_sepae7ef - -subroutine f90wrap_term_gen__artemis_termination293d(this) - use artemis__termination_generator, only: artemis_termination_generator_type - implicit none - - type artemis_termination_generator_type_ptr_type - type(artemis_termination_generator_type), pointer :: p => NULL() - end type artemis_termination_generator_type_ptr_type - type(artemis_termination_generator_type_ptr_type) :: this_ptr - integer, intent(out), dimension(2) :: this - allocate(this_ptr%p) - this = transfer(this_ptr, this) -end subroutine f90wrap_term_gen__artemis_termination293d - -subroutine f90wrap_term_gen__artemis_terminationdf16(this) - use artemis__termination_generator, only: artemis_termination_generator_type - implicit none - - type artemis_termination_generator_type_ptr_type - type(artemis_termination_generator_type), pointer :: p => NULL() - end type artemis_termination_generator_type_ptr_type - type(artemis_termination_generator_type_ptr_type) :: this_ptr - integer, intent(in), dimension(2) :: this - this_ptr = transfer(this, this_ptr) - deallocate(this_ptr%p) -end subroutine f90wrap_term_gen__artemis_terminationdf16 - -subroutine f90wrap_term_gen__generate__binding__2af7(this, basis, miller_plane, axis, surface, & - num_layers, thickness, orthogonalise, normalise, break_on_fail, n0) - use artemis__termination_generator, only: artemis_termination_generator_type - use artemis__geom_rw, only: basis_type - implicit none - - type artemis_termination_generator_type_ptr_type - type(artemis_termination_generator_type), pointer :: p => NULL() - end type artemis_termination_generator_type_ptr_type - type basis_type_ptr_type - type(basis_type), pointer :: p => NULL() - end type basis_type_ptr_type - type(artemis_termination_generator_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) :: miller_plane - integer, intent(in) :: axis - integer, intent(in), optional, dimension(n0) :: surface - integer, intent(in), optional :: num_layers - real(4), intent(in), optional :: thickness - logical, intent(in), optional :: orthogonalise - logical, intent(in), optional :: normalise - logical, intent(in), optional :: break_on_fail - integer :: n0 - !f2py intent(hide), depend(surface) :: n0 = shape(surface,0) - this_ptr = transfer(this, this_ptr) - basis_ptr = transfer(basis, basis_ptr) - call this_ptr%p%generate(basis=basis_ptr%p, miller_plane=miller_plane, axis=axis, surface=surface, & - num_layers=num_layers, thickness=thickness, orthogonalise=orthogonalise, normalise=normalise, & - break_on_fail=break_on_fail) -end subroutine f90wrap_term_gen__generate__binding__2af7 - -! End of module artemis__termination_generator defined in file ../src/fortran/lib/mod_term_generator.f90 - From 39caa393e1039c4f1f8fff1b34e38757c6bd5db1 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sun, 20 Apr 2025 09:11:08 +0100 Subject: [PATCH 067/137] Improve wrapper names --- docs/source/conf.py | 4 +- docs/source/index.rst | 56 ++ pyproject.toml | 2 +- src/artemis/artemis.py | 759 ++------------------------ src/fortran/lib/mod_generator.f90 | 2 +- src/wrapper/f90wrap_mod_generator.f90 | 32 +- 6 files changed, 131 insertions(+), 724 deletions(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index bf32c9d..e5989f4 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -7,8 +7,8 @@ # from unittest.mock import Mock # -# MOCK_MODULES = ["artemis._artemis"] # List any other modules if needed -# sys.modules.update((mod_name, Mock()) for mod_name in MOCK_MODULES) +MOCK_MODULES = ["artemis._artemis"] # List any other modules if needed +sys.modules.update((mod_name, Mock()) for mod_name in MOCK_MODULES) # sys.path.insert(0, os.path.abspath(os.path.join('..', '..', 'src', 'raffle'))) # Sets the base path to find your modules sys.path.insert(0, os.path.abspath(os.path.join('..', '..', 'src'))) # Sets the base path to find your modules diff --git a/docs/source/index.rst b/docs/source/index.rst index f4336c7..29f25c5 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -6,3 +6,59 @@ ARTEMIS (Ab Initio Restructuring Tool Enabling Modelling of Interface Structures ARTEMIS can be utilised as a Python package, a Fortran library, or a standalone Fortran executable. The Python package provides a high-level interface to the Fortran library, which contains the core functionality. +The Python package interfaces seemlessly with `ASE (Atomic Simulation Environment) `_, allowing for easy reading, writing, and manipulation of atomic structures. +Although the package comes with a built-in atomic structure reader and writer, it is recommended to use ASE due to its greater functionality and wide-reaching support. + +The code is provided freely available under the `GNU General Public License v3.0 `_. + +An example + +.. code-block:: python + + # A simple example of how to use ARTEMIS to generate lattice matches structures between silicon and germanium and write them to a single file. + from ase import Atoms + from ase.build import bulk + from ase.io import write + from artemis.generator import artemis_generator + from mace.calculators import mace_mp + + generator = artemis_generator() + + calc = mace_mp(model="medium", dispersion=False, default_dtype="float32", device='cpu') + + Si = bulk('Si', 'diamond', a=5.43, cubic=True) + Ge = bulk('Ge', 'diamond', a=5.66, cubic=True) + + generator.set_materials(Si, Ge) + + generator.set_surface_properties( + miller_lw = [ 1, 1, 0 ], + miller_up = [ 1, 1, 0 ], + ) + + structures = generator.generate(calc=calc) + + for structure in structures: + structure.calc = SinglePointCalculator( + structure, + energy=structure.get_potential_energy(), + forces=structure.get_forces() + ) + + write('structures.traj', structures) + +.. toctree:: + :maxdepth: 3 + :caption: Contents: + + about + install + tutorials/index + Python API + +.. Indices and tables +.. ================== + +.. * :ref:`genindex` +.. * :ref:`modindex` +.. * :ref:`search` \ No newline at end of file diff --git a/pyproject.toml b/pyproject.toml index 1313efb..280632f 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -55,7 +55,7 @@ classifiers = [ [project.urls] Homepage = "https://github.com/ExeQuantCode/artemis" -Documentation = "https://artemis-fortran.readthedocs.io/" +Documentation = "https://artemis-materials.readthedocs.io/" Repository = "https://github.com/ExeQuantCode/artemis" Issues = "https://github.com/ExeQuantCode/artemis/issues" diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 11cc6b3..97078f4 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -518,681 +518,7 @@ def deallocate(self): geom_rw = Geom_Rw() -# class Geom_Rw(f90wrap.runtime.FortranModule): -# """ -# Module geom_rw - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 13-1907 - -# """ -# @f90wrap.runtime.register_class("artemis.species_type") -# class species_type(f90wrap.runtime.FortranDerivedType): -# """ -# Type(name=species_type) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 34-47 - -# """ -# def __init__(self, handle=None): -# """ -# self = Species_Type() - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 34-47 - - -# Returns -# ------- -# this : Species_Type -# Object to be constructed - - -# Automatically generated constructor for species_type -# """ -# f90wrap.runtime.FortranDerivedType.__init__(self) -# result = _artemis.f90wrap_geom_rw__species_type_initialise() -# self._handle = result[0] if isinstance(result, tuple) else result - -# def __del__(self): -# """ -# Destructor for class Species_Type - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 34-47 - -# Parameters -# ---------- -# this : Species_Type -# Object to be destructed - - -# Automatically generated destructor for species_type -# """ -# if self._alloc: -# _artemis.f90wrap_geom_rw__species_type_finalise(this=self._handle) - -# @property -# def atom(self): -# """ -# Element atom ftype=real(real32) pytype=float - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 36 - -# """ -# array_ndim, array_type, array_shape, array_handle = \ -# _artemis.f90wrap_species_type__array__atom(self._handle) -# if array_handle in self._arrays: -# atom = self._arrays[array_handle] -# else: -# atom = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, -# self._handle, -# _artemis.f90wrap_species_type__array__atom) -# self._arrays[array_handle] = atom -# return atom - -# @atom.setter -# def atom(self, atom): -# self.atom[...] = atom - -# @property -# def mass(self): -# """ -# Element mass ftype=real(real32) pytype=float - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 38 - -# """ -# return _artemis.f90wrap_species_type__get__mass(self._handle) - -# @mass.setter -# def mass(self, mass): -# _artemis.f90wrap_species_type__set__mass(self._handle, mass) - -# @property -# def charge(self): -# """ -# Element charge ftype=real(real32) pytype=float - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 40 - -# """ -# return _artemis.f90wrap_species_type__get__charge(self._handle) - -# @charge.setter -# def charge(self, charge): -# _artemis.f90wrap_species_type__set__charge(self._handle, charge) - -# @property -# def radius(self): -# """ -# Element radius ftype=real(real32) pytype=float - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 42 - -# """ -# return _artemis.f90wrap_species_type__get__radius(self._handle) - -# @radius.setter -# def radius(self, radius): -# _artemis.f90wrap_species_type__set__radius(self._handle, radius) - -# @property -# def name(self): -# """ -# Element name ftype=character(len=3) pytype=str - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 44 - -# """ -# return _artemis.f90wrap_species_type__get__name(self._handle) - -# @name.setter -# def name(self, name): -# _artemis.f90wrap_species_type__set__name(self._handle, name) - -# @property -# def num(self): -# """ -# Element num ftype=integer pytype=int - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 46 - -# """ -# return _artemis.f90wrap_species_type__get__num(self._handle) - -# @num.setter -# def num(self, num): -# _artemis.f90wrap_species_type__set__num(self._handle, num) - -# def __str__(self): -# ret = ['{\n'] -# ret.append(' atom : ') -# ret.append(repr(self.atom)) -# ret.append(',\n mass : ') -# ret.append(repr(self.mass)) -# ret.append(',\n charge : ') -# ret.append(repr(self.charge)) -# ret.append(',\n radius : ') -# ret.append(repr(self.radius)) -# ret.append(',\n name : ') -# ret.append(repr(self.name)) -# ret.append(',\n num : ') -# ret.append(repr(self.num)) -# ret.append('}') -# return ''.join(ret) - -# _dt_array_initialisers = [] - - -# @f90wrap.runtime.register_class("artemis.basis_type") -# class basis_type(f90wrap.runtime.FortranDerivedType): -# """ -# Type(name=basis_type) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 49-83 - -# """ -# def __init__(self, handle=None): -# """ -# self = Basis_Type() - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 49-83 - - -# Returns -# ------- -# this : Basis_Type -# Object to be constructed - - -# Automatically generated constructor for basis_type -# """ -# f90wrap.runtime.FortranDerivedType.__init__(self) -# result = _artemis.f90wrap_geom_rw__basis_type_initialise() -# self._handle = result[0] if isinstance(result, tuple) else result - -# def __del__(self): -# """ -# Destructor for class Basis_Type - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 49-83 - -# Parameters -# ---------- -# this : Basis_Type -# Object to be destructed - - -# Automatically generated destructor for basis_type -# """ -# if self._alloc: -# _artemis.f90wrap_geom_rw__basis_type_finalise(this=self._handle) - -# def allocate_species(self, num_species=None, species_symbols=None, \ -# species_count=None, atoms=None): -# """ -# allocate_species__binding__basis_type(self[, num_species, species_symbols, \ -# species_count, atoms]) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 110-153 - -# Parameters -# ---------- -# this : Basis_Type -# num_species : int -# species_symbols : str array -# species_count : int array -# atoms : float array - -# """ -# _artemis.f90wrap_geom_rw__allocate_species__binding__basis_type(this=self._handle, \ -# num_species=num_species, species_symbols=species_symbols, \ -# species_count=species_count, atoms=atoms) - -# def convert(self): -# """ -# convert__binding__basis_type(self) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1035-1057 - -# Parameters -# ---------- -# this : Basis_Type - -# """ -# _artemis.f90wrap_geom_rw__convert__binding__basis_type(this=self._handle) - -# def change_lattice(self, lattice): -# """ -# change_lattice__binding__basis_type(self, lattice) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1061-1088 - -# Parameters -# ---------- -# this : Basis_Type -# lattice : float array - -# """ -# _artemis.f90wrap_geom_rw__change_lattice__binding__basis_type(this=self._handle, \ -# lattice=lattice) - -# def normalise(self, ceil_val=None, floor_coords=None, round_coords=None, \ -# zero_round=None): -# """ -# normalise__binding__basis_type(self[, ceil_val, floor_coords, round_coords, \ -# zero_round]) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1097-1147 - -# Parameters -# ---------- -# this : Basis_Type -# ceil_val : float -# floor_coords : bool -# round_coords : bool -# zero_round : float - -# """ -# _artemis.f90wrap_geom_rw__normalise__binding__basis_type(this=self._handle, \ -# ceil_val=ceil_val, floor_coords=floor_coords, round_coords=round_coords, \ -# zero_round=zero_round) - -# def copy(self, basis, length=None): -# """ -# copy__binding__basis_type(self, basis[, length]) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1229-1290 - -# Parameters -# ---------- -# this : Basis_Type -# basis : Basis_Type -# length : int - -# --------------------------------------------------------------------------- -# determines whether user wants output basis extra translational dimension -# --------------------------------------------------------------------------- -# """ -# _artemis.f90wrap_geom_rw__copy__binding__basis_type(this=self._handle, \ -# basis=basis._handle, length=length) - -# def get_lattice_constants(self, radians=None): -# """ -# output = get_lattice_constants__binding__basis_type(self[, radians]) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1210-1225 - -# Parameters -# ---------- -# this : Basis_Type -# radians : bool - -# Returns -# ------- -# output : float array - -# """ -# output = \ -# _artemis.f90wrap_geom_rw__get_lattice_constants__binding__bc9a1(this=self._handle, \ -# radians=radians) -# return output - -# def remove_atom(self, ispec, iatom): -# """ -# remove_atom__binding__basis_type(self, ispec, iatom) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1294-1336 - -# Parameters -# ---------- -# this : Basis_Type -# ispec : int -# iatom : int - -# --------------------------------------------------------------------------- -# remove atom from basis -# --------------------------------------------------------------------------- -# """ -# _artemis.f90wrap_geom_rw__remove_atom__binding__basis_type(this=self._handle, \ -# ispec=ispec, iatom=iatom) - -# def remove_atoms(self, atoms): -# """ -# remove_atoms__binding__basis_type(self, atoms) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1340-1403 - -# Parameters -# ---------- -# this : Basis_Type -# atoms : int array - -# --------------------------------------------------------------------------- -# reorder atoms to remove -# --------------------------------------------------------------------------- -# """ -# _artemis.f90wrap_geom_rw__remove_atoms__binding__basis_type(this=self._handle, \ -# atoms=atoms) - -# def init_array_spec(self): -# self.spec = f90wrap.runtime.FortranDerivedTypeArray(self, -# _artemis.f90wrap_basis_type__array_getitem__spec, -# _artemis.f90wrap_basis_type__array_setitem__spec, -# _artemis.f90wrap_basis_type__array_len__spec, -# """ -# Element spec ftype=type(species_type) pytype=Species_Type - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 51 - -# """, Geom_Rw.species_type) -# return self.spec - -# @property -# def nspec(self): -# """ -# Element nspec ftype=integer pytype=int - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 53 - -# """ -# return _artemis.f90wrap_basis_type__get__nspec(self._handle) - -# @nspec.setter -# def nspec(self, nspec): -# _artemis.f90wrap_basis_type__set__nspec(self._handle, nspec) - -# @property -# def natom(self): -# """ -# Element natom ftype=integer pytype=int - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 55 - -# """ -# return _artemis.f90wrap_basis_type__get__natom(self._handle) - -# @natom.setter -# def natom(self, natom): -# _artemis.f90wrap_basis_type__set__natom(self._handle, natom) - -# @property -# def energy(self): -# """ -# Element energy ftype=real(real32) pytype=float - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 57 - -# """ -# return _artemis.f90wrap_basis_type__get__energy(self._handle) - -# @energy.setter -# def energy(self, energy): -# _artemis.f90wrap_basis_type__set__energy(self._handle, energy) - -# @property -# def lat(self): -# """ -# Element lat ftype=real(real32) pytype=float - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 59 - -# """ -# array_ndim, array_type, array_shape, array_handle = \ -# _artemis.f90wrap_basis_type__array__lat(self._handle) -# if array_handle in self._arrays: -# lat = self._arrays[array_handle] -# else: -# lat = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, -# self._handle, -# _artemis.f90wrap_basis_type__array__lat) -# self._arrays[array_handle] = lat -# return lat - -# @lat.setter -# def lat(self, lat): -# self.lat[...] = lat - -# @property -# def lcart(self): -# """ -# Element lcart ftype=logical pytype=bool - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 61 - -# """ -# return _artemis.f90wrap_basis_type__get__lcart(self._handle) - -# @lcart.setter -# def lcart(self, lcart): -# _artemis.f90wrap_basis_type__set__lcart(self._handle, lcart) - -# @property -# def pbc(self): -# """ -# Element pbc ftype=logical pytype=bool - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 63 - -# """ -# array_ndim, array_type, array_shape, array_handle = \ -# _artemis.f90wrap_basis_type__array__pbc(self._handle) -# if array_handle in self._arrays: -# pbc = self._arrays[array_handle] -# else: -# pbc = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, -# self._handle, -# _artemis.f90wrap_basis_type__array__pbc) -# self._arrays[array_handle] = pbc -# return pbc - -# @pbc.setter -# def pbc(self, pbc): -# self.pbc[...] = pbc - -# @property -# def sysname(self): -# """ -# Element sysname ftype=character(len=128) pytype=str - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 65 - -# """ -# return _artemis.f90wrap_basis_type__get__sysname(self._handle) - -# @sysname.setter -# def sysname(self, sysname): -# _artemis.f90wrap_basis_type__set__sysname(self._handle, sysname) - -# def __str__(self): -# ret = ['{\n'] -# ret.append(' nspec : ') -# ret.append(repr(self.nspec)) -# ret.append(',\n natom : ') -# ret.append(repr(self.natom)) -# ret.append(',\n energy : ') -# ret.append(repr(self.energy)) -# ret.append(',\n lat : ') -# ret.append(repr(self.lat)) -# ret.append(',\n lcart : ') -# ret.append(repr(self.lcart)) -# ret.append(',\n pbc : ') -# ret.append(repr(self.pbc)) -# ret.append(',\n sysname : ') -# ret.append(repr(self.sysname)) -# ret.append('}') -# return ''.join(ret) - -# _dt_array_initialisers = [init_array_spec] - - -# @staticmethod -# def geom_read(unit, length=None, iostat=None): -# """ -# basis = geom_read(unit[, length, iostat]) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 157-212 - -# Parameters -# ---------- -# unit : int -# length : int -# iostat : int - -# Returns -# ------- -# basis : Basis_Type - -# """ -# basis = _artemis.f90wrap_geom_rw__geom_read(unit=unit, length=length, \ -# iostat=iostat) -# basis = f90wrap.runtime.lookup_class("artemis.basis_type").from_handle(basis, \ -# alloc=True) -# return basis - -# @staticmethod -# def geom_write(unit, basis): -# """ -# geom_write(unit, basis) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 216-240 - -# Parameters -# ---------- -# unit : int -# basis : Basis_Type - -# """ -# _artemis.f90wrap_geom_rw__geom_write(unit=unit, basis=basis._handle) - -# @staticmethod -# def get_element_properties(element, charge=None, mass=None, radius=None): -# """ -# get_element_properties(element[, charge, mass, radius]) - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# lines 1407-1906 - -# Parameters -# ---------- -# element : str -# charge : float -# mass : float -# radius : float - -# --------------------------------------------------------------------------- -# Return the values -# --------------------------------------------------------------------------- -# """ -# _artemis.f90wrap_geom_rw__get_element_properties(element=element, \ -# charge=charge, mass=mass, radius=radius) - -# @property -# def igeom_input(self): -# """ -# Element igeom_input ftype=integer pytype=int - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 24 - -# """ -# return _artemis.f90wrap_geom_rw__get__igeom_input() - -# @igeom_input.setter -# def igeom_input(self, igeom_input): -# _artemis.f90wrap_geom_rw__set__igeom_input(igeom_input) - -# @property -# def igeom_output(self): -# """ -# Element igeom_output ftype=integer pytype=int - - -# Defined at ../src/fortran/lib/mod_geom_rw.f90 \ -# line 32 - -# """ -# return _artemis.f90wrap_geom_rw__get__igeom_output() - -# @igeom_output.setter -# def igeom_output(self, igeom_output): -# _artemis.f90wrap_geom_rw__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 = [] - -# geom_rw = Geom_Rw() class Generator(f90wrap.runtime.FortranModule): """ @@ -1235,7 +561,7 @@ def __init__(self, handle=None): """ f90wrap.runtime.FortranDerivedType.__init__(self) result = \ - _artemis.f90wrap_intf_gen__artemis_interface_gen0ea8() + _artemis.f90wrap_intf_gen__artemis_gen_type_initialise() self._handle = result[0] if isinstance(result, tuple) else result def __del__(self): @@ -1256,13 +582,13 @@ def __del__(self): Automatically generated destructor for artemis_generator_type """ if self._alloc: - _artemis.f90wrap_intf_gen__artemis_interface_genbc51(this=self._handle) + _artemis.f90wrap_intf_gen__artemis_gen_type_finalise(this=self._handle) def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ area_mismatch=None, max_length=None, max_area=None, max_fit=None, \ max_extension=None, angle_weight=None, area_weight=None): """ - set_tolerance__binding__artemis_generator_type(self[, vector_mismatch, \ + set_tolerance__binding__artemis_gen_type(self[, vector_mismatch, \ angle_mismatch, area_mismatch, max_length, max_area, max_fit, max_extension, \ angle_weight, area_weight]) @@ -1285,7 +611,7 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ area_weight : float """ - _artemis.f90wrap_intf_gen__set_tolerance__bindinfd58(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_tolerance__bindind_agt(this=self._handle, \ vector_mismatch=vector_mismatch, angle_mismatch=angle_mismatch, \ area_mismatch=area_mismatch, max_length=max_length, max_area=max_area, \ max_fit=max_fit, max_extension=max_extension, angle_weight=angle_weight, \ @@ -1294,7 +620,7 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ interface_depth=None, separation_scale=None, depth_method=None): """ - set_shift_method__binding__artemis_generator_type(self[, method, \ + set_shift_method__binding__artemis_gen_type(self[, method, \ num_shifts, shifts, interface_depth, separation_scale, depth_method]) @@ -1313,7 +639,7 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ depth_method : int """ - _artemis.f90wrap_intf_gen__set_shift_method__bin4dc1(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_shift_method__binding_agt(this=self._handle, \ method=method, num_shifts=num_shifts, shifts=shifts, \ interface_depth=interface_depth, separation_scale=separation_scale, \ depth_method=depth_method) @@ -1321,7 +647,7 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ elastic_constants_up=None, use_pricel_lw=None, use_pricel_up=None): """ - set_materials__binding__artemis_generator_type(self, structure_lw, \ + set_materials__binding__artemis_gen_type(self, structure_lw, \ structure_up[, elastic_constants_lw, elastic_constants_up, use_pricel_lw, \ use_pricel_up]) @@ -1352,7 +678,7 @@ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ if isinstance(structure_up, Atoms): structure_up = geom_rw.basis(atoms=structure_up) - _artemis.f90wrap_intf_gen__set_materials__bindin017c(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_materials__binding_agt(this=self._handle, \ structure_lw=structure_lw._handle, structure_up=structure_up._handle, \ elastic_constants_lw=elastic_constants_lw, \ elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, \ @@ -1361,7 +687,7 @@ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ def set_surface_properties(self, miller_lw=None, miller_up=None, \ is_layered_lw=None, is_layered_up=None): """ - set_surface_properties__binding__artemis_generator_type(self[, \ + set_surface_properties__binding__artemis_gen_type(self[, \ miller_lw, miller_up, is_layered_lw, is_layered_up]) @@ -1378,13 +704,13 @@ def set_surface_properties(self, miller_lw=None, miller_up=None, \ is_layered_up : bool """ - _artemis.f90wrap_intf_gen__set_surface_propertie615d(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_surface_properties__binding_agt(this=self._handle, \ miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, \ is_layered_up=is_layered_up) def reset_is_layered_lw(self): """ - reset_is_layered_lw__binding__artemis_generator_type(self) + reset_is_layered_lw__binding__artemis_gen_type(self) Defined at \ @@ -1396,11 +722,11 @@ def reset_is_layered_lw(self): this : Artemis_generator_Type """ - _artemis.f90wrap_intf_gen__reset_is_layered_lw__69b8(this=self._handle) + _artemis.f90wrap_intf_gen__reset_is_layered_lw__binding_agt(this=self._handle) def reset_is_layered_up(self): """ - reset_is_layered_up__binding__artemis_generator_type(self) + reset_is_layered_up__binding__artemis_gen_type(self) Defined at \ @@ -1412,11 +738,11 @@ def reset_is_layered_up(self): this : Artemis_generator_Type """ - _artemis.f90wrap_intf_gen__reset_is_layered_up__0b2c(this=self._handle) + _artemis.f90wrap_intf_gen__reset_is_layered_up__binding_agt(this=self._handle) def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ thickness=None, orthogonalise=None, normalise=None, break_on_fail=None, - verbose=None, calc=None): + verbose=None, return_exit_code=False, calc=None): """ Defined at \ @@ -1425,6 +751,8 @@ def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ Parameters ---------- """ + exit_code = 0 + structures = None exit_code, n_structs = _artemis.f90wrap_intf_gen__get_terminations__binding__agt(this=self._handle, identifier=1, @@ -1433,19 +761,22 @@ def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ orthogonalise=orthogonalise, normalise=normalise, break_on_fail=break_on_fail, verbose=verbose) - atoms = [] + if ( exit_code != 0 and exit_code != None ) and not return_exit_code: + raise RuntimeError(f"Termination generation failed (exit code {exit_code})") # allocate the structures structures = geom_rw.basis_array() #.allocate(n_structs) structures.allocate(n_structs) _artemis.f90wrap_retrieve_last_generated_structures(n_structs, structures._handle) - atoms = structures.toase() + structures = structures.toase() - return atoms, exit_code + if return_exit_code: + return structures, exit_code + return structures def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ thickness=None, orthogonalise=None, normalise=None, break_on_fail=None, - verbose=None, calc=None): + verbose=None, return_exit_code=False, calc=None): """ Defined at \ @@ -1454,6 +785,8 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ Parameters ---------- """ + exit_code = 0 + structures = None exit_code, n_structs = _artemis.f90wrap_intf_gen__get_terminations__binding__agt(this=self._handle, identifier=2, @@ -1462,24 +795,27 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ orthogonalise=orthogonalise, normalise=normalise, break_on_fail=break_on_fail, verbose=verbose) - atoms = [] + if ( exit_code != 0 and exit_code != None ) and not return_exit_code: + raise RuntimeError(f"Termination generation failed (exit code {exit_code})") # allocate the structures structures = geom_rw.basis_array() #.allocate(n_structs) structures.allocate(n_structs) _artemis.f90wrap_retrieve_last_generated_structures(n_structs, structures._handle) - atoms = structures.toase() + structures = structures.toase() - return atoms, exit_code + if return_exit_code: + return structures, exit_code + return structures def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ thickness_up=None, num_layers_lw=None, num_layers_up=None, \ print_lattice_match_info=None, print_termination_info=None, \ print_shift_info=None, break_on_fail=None, icheck_match=None, \ interface_idx=None, generate_structures=None, seed=None, verbose=None, \ - exit_code=None, calc=None): + return_exit_code=False, calc=None): """ - generate__binding__artemis_generator_type(self[, surface_lw, \ + generate__binding__artemis_gen_type(self[, surface_lw, \ surface_up, thickness_lw, thickness_up, num_layers_lw, num_layers_up, \ print_lattice_match_info, print_termination_info, print_shift_info, \ break_on_fail, icheck_match, interface_idx, generate_structures, seed, \ @@ -1515,7 +851,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ exit_code = 0 structures = None - exit_code = _artemis.f90wrap_intf_gen__generate__binding__ar04c1(this=self._handle, \ + exit_code = _artemis.f90wrap_intf_gen__generate__binding__agt(this=self._handle, \ surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, \ thickness_up=thickness_up, num_layers_lw=num_layers_lw, \ num_layers_up=num_layers_up, \ @@ -1525,14 +861,18 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ icheck_match=icheck_match, interface_idx=interface_idx, \ generate_structures=generate_structures, seed=seed, verbose=verbose ) + if ( exit_code != 0 and exit_code != None ) and not return_exit_code: + raise RuntimeError(f"Interface generation failed (exit code {exit_code})") structures = self.get_structures(calc) - return structures, exit_code + if return_exit_code: + return structures, exit_code + return structures def restart(self, basis, interface_location=None, print_shift_info=None, \ - seed=None): + seed=None, verbose=None, return_exit_code=False, calc=None): """ - restart__binding__artemis_generator_type(self, basis[, \ + restart__binding__artemis_gen_type(self, basis[, \ interface_location, print_shift_info, seed]) @@ -1552,9 +892,20 @@ def restart(self, basis, interface_location=None, print_shift_info=None, \ Set the random seed --------------------------------------------------------------------------- """ - _artemis.f90wrap_intf_gen__restart__binding__agt(this=self._handle, \ + exit_code = 0 + structures = None + + exit_code = _artemis.f90wrap_intf_gen__restart__binding__agt(this=self._handle, \ basis=basis._handle, interface_location=interface_location, \ - print_shift_info=print_shift_info, seed=seed) + print_shift_info=print_shift_info, seed=seed, verbose=verbose) + + if ( exit_code != 0 and exit_code != None ) and not return_exit_code: + raise RuntimeError(f"Interface generation failed (exit code {exit_code})") + + structures = self.get_structures(calc) + if return_exit_code: + return structures, exit_code + return structures def get_structures(self, calculator=None): """ diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 59d5049..f8a3008 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1988,7 +1988,7 @@ subroutine output_intf_data(SAV, ifit, lw_term, term_lw_idx, up_term, term_up_id write(unit,'("Lower material primitive cell used: ",L1)') lw_pricel write(unit,'("Upper material primitive cell used: ",L1)') lw_pricel write(unit,*) - write(unit,'("Lattice match:")') + write(unit,'("Lattice match: ",I0)') ifit write(unit,'((1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & SAV%abc,SAV%abc,& SAV%tf1(ifit,1,1:3),SAV%tf2(ifit,1,1:3),& diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index bbc3b76..5c86a27 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -930,7 +930,7 @@ subroutine f90wrap_artemis_gen_type__array__layer_sepa90a5(this, nd, dtype, dsha dloc = loc(this_ptr%p%layer_separation_cutoff) end subroutine f90wrap_artemis_gen_type__array__layer_sepa90a5 -subroutine f90wrap_intf_gen__artemis_interface_gen0ea8(this) +subroutine f90wrap_intf_gen__artemis_gen_type_initialise(this) use artemis__generator, only: artemis_generator_type implicit none @@ -941,9 +941,9 @@ subroutine f90wrap_intf_gen__artemis_interface_gen0ea8(this) integer, intent(out), dimension(2) :: this allocate(this_ptr%p) this = transfer(this_ptr, this) -end subroutine f90wrap_intf_gen__artemis_interface_gen0ea8 +end subroutine f90wrap_intf_gen__artemis_gen_type_initialise -subroutine f90wrap_intf_gen__artemis_interface_genbc51(this) +subroutine f90wrap_intf_gen__artemis_gen_type_finalise(this) use artemis__generator, only: artemis_generator_type implicit none @@ -954,9 +954,9 @@ subroutine f90wrap_intf_gen__artemis_interface_genbc51(this) integer, intent(in), dimension(2) :: this this_ptr = transfer(this, this_ptr) deallocate(this_ptr%p) -end subroutine f90wrap_intf_gen__artemis_interface_genbc51 +end subroutine f90wrap_intf_gen__artemis_gen_type_finalise -subroutine f90wrap_intf_gen__set_tolerance__bindinfd58(this, vector_mismatch, angle_mismatch, & +subroutine f90wrap_intf_gen__set_tolerance__bindind_agt(this, vector_mismatch, angle_mismatch, & area_mismatch, max_length, max_area, max_fit, max_extension, angle_weight, area_weight) use artemis__generator, only: artemis_generator_type implicit none @@ -982,9 +982,9 @@ subroutine f90wrap_intf_gen__set_tolerance__bindinfd58(this, vector_mismatch, an area_mismatch=area_mismatch, max_length=max_length, & max_area=max_area, max_fit=max_fit, max_extension=max_extension, & angle_weight=angle_weight, area_weight=area_weight) -end subroutine f90wrap_intf_gen__set_tolerance__bindinfd58 +end subroutine f90wrap_intf_gen__set_tolerance__bindind_agt -subroutine f90wrap_intf_gen__set_shift_method__bin4dc1(this, method, num_shifts, shifts, & +subroutine f90wrap_intf_gen__set_shift_method__binding_agt(this, method, num_shifts, shifts, & interface_depth, separation_scale, depth_method, n0) use artemis__generator, only: artemis_generator_type implicit none @@ -1007,9 +1007,9 @@ subroutine f90wrap_intf_gen__set_shift_method__bin4dc1(this, method, num_shifts, method=method, num_shifts=num_shifts, & shifts=shifts, interface_depth=interface_depth, & separation_scale=separation_scale, depth_method=depth_method) -end subroutine f90wrap_intf_gen__set_shift_method__bin4dc1 +end subroutine f90wrap_intf_gen__set_shift_method__binding_agt -subroutine f90wrap_intf_gen__set_materials__bindin017c(this, structure_lw, structure_up, & +subroutine f90wrap_intf_gen__set_materials__binding_agt(this, structure_lw, structure_up, & elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) use artemis__generator, only: artemis_generator_type use artemis__geom_rw, only: basis_type @@ -1041,9 +1041,9 @@ subroutine f90wrap_intf_gen__set_materials__bindin017c(this, structure_lw, struc call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & use_pricel_up=use_pricel_up) -end subroutine f90wrap_intf_gen__set_materials__bindin017c +end subroutine f90wrap_intf_gen__set_materials__binding_agt -subroutine f90wrap_intf_gen__set_surface_propertie615d(this, miller_lw, miller_up, is_layered_lw, & +subroutine f90wrap_intf_gen__set_surface_properties__binding_agt(this, miller_lw, miller_up, is_layered_lw, & is_layered_up) use artemis__generator, only: artemis_generator_type implicit none @@ -1060,9 +1060,9 @@ subroutine f90wrap_intf_gen__set_surface_propertie615d(this, miller_lw, miller_u this_ptr = transfer(this, this_ptr) call this_ptr%p%set_surface_properties(miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, & is_layered_up=is_layered_up) -end subroutine f90wrap_intf_gen__set_surface_propertie615d +end subroutine f90wrap_intf_gen__set_surface_properties__binding_agt -subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8(this) +subroutine f90wrap_intf_gen__reset_is_layered_lw__binding_agt(this) use artemis__generator, only: artemis_generator_type implicit none @@ -1073,9 +1073,9 @@ subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8(this) integer, intent(in), dimension(2) :: this this_ptr = transfer(this, this_ptr) call this_ptr%p%reset_is_layered_lw() -end subroutine f90wrap_intf_gen__reset_is_layered_lw__69b8 +end subroutine f90wrap_intf_gen__reset_is_layered_lw__binding_agt -subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c(this) +subroutine f90wrap_intf_gen__reset_is_layered_up__binding_agt(this) use artemis__generator, only: artemis_generator_type implicit none @@ -1086,7 +1086,7 @@ subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c(this) integer, intent(in), dimension(2) :: this this_ptr = transfer(this, this_ptr) call this_ptr%p%reset_is_layered_up() -end subroutine f90wrap_intf_gen__reset_is_layered_up__0b2c +end subroutine f90wrap_intf_gen__reset_is_layered_up__binding_agt From 6cfad619048e05f5b4fdf37223535ecf8d52b5cd Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sun, 20 Apr 2025 14:53:15 +0100 Subject: [PATCH 068/137] Improve lattice match handling --- app/aspect.f90 | 2 +- app/inputs.f90 | 6 +- app/main.f90 | 90 ++++--- src/artemis/artemis.py | 128 ++++++--- src/fortran/artemis.f90 | 2 + src/fortran/lib/mod_constants.f90 | 2 +- src/fortran/lib/mod_generator.f90 | 368 +++++++++++++++++--------- src/fortran/lib/mod_geom_utils.f90 | 6 +- src/fortran/lib/mod_lat_compare.f90 | 302 +++++++-------------- src/fortran/lib/mod_misc_types.f90 | 64 ++++- src/fortran/lib/mod_shifting.f90 | 4 +- src/fortran/lib/mod_sym.f90 | 2 +- src/fortran/lib/mod_terminations.f90 | 2 +- src/wrapper/f90wrap_mod_generator.f90 | 127 ++++++--- 14 files changed, 661 insertions(+), 444 deletions(-) diff --git a/app/aspect.f90 b/app/aspect.f90 index 462bd5c..7069d27 100644 --- a/app/aspect.f90 +++ b/app/aspect.f90 @@ -7,7 +7,7 @@ module aspect use artemis__io_utils, only: err_abort use artemis__geom_rw, only: basis_type - use edit_geom + use artemis__geom_utils implicit none private diff --git a/app/inputs.f90 b/app/inputs.f90 index fb316cb..3c6a345 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -17,7 +17,7 @@ module inputs err_abort use artemis__io_utils_extd, only: setup_input_fmt, setup_output_fmt use aspect, only: aspect_type, edit_structure - use lat_compare, only: lreduce,tol_type + use lat_compare, only: reduce,tol_type use infile_tools use infile_print use artemis__sym, only: set_symmetry_tolerance @@ -126,7 +126,7 @@ subroutine set_global_vars() lprint_shifts=.false. lprint_matches=.false. lgen_interfaces=.true. - lreduce=.false. + reduce=.false. iswap = 0 nswap = 5 swap_den = 5.E-2_real32 @@ -798,7 +798,7 @@ subroutine read_card_interfaces(unit,count,skip) case("ISHIFT") call assign(buffer,ishift, readvar(22)) case("LREDUCE") - call assign(buffer,lreduce, readvar(23)) + call assign(buffer,reduce, readvar(23)) case("LPRINT_SHIFTS") call assign(buffer,lprint_shifts, readvar(24)) case("C_SCALE") diff --git a/app/main.f90 b/app/main.f90 index e54ee81..10b5e64 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -10,8 +10,10 @@ program artemis_executable implicit none - type(artemis_termination_generator_type) :: term_gen - type(artemis_interface_generator_type) :: intf_gen + integer :: i, unit + character(len=256) :: filename + type(artemis_generator_type) :: generator + type(basis_type), allocatable, dimension(:) :: structures @@ -33,12 +35,29 @@ program artemis_executable write(*,'(1X,"task ",I0," set",/,1X,"Performing Cell Edits")') task if(lsurf_gen)then write(0,'(1X,"Finding terminations for lower material.")') - term_gen%layer_separation_cutoff = layer_sep - call term_gen%generate(struc1_bas,lw_mplane,axis,& + + call generator%set_tolerance( & + tolerance = tolerance & + ) + call generator%set_materials( & + structure_lw = struc1_bas, & + use_pricel_lw = lw_use_pricel & + ) + call generator%set_surface_properties( & + miller_lw = lw_mplane, & + is_layered_lw = lw_layered & + ) + + structures = generator%get_terminations(1, & num_layers = lw_num_layers, & thickness = lw_thickness & ) - call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "term_") + do i = 1, size(structures) + write(filename, '(A,I0,A)') "term_", i, ".vasp" + open(newunit=unit, status='replace', file=trim(filename)) + call geom_write(unit, structures(i)) + close(unit) + end do write(0,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop end if @@ -49,38 +68,58 @@ program artemis_executable case(1) ! interfaces/ARTEMIS/SEARCH write(*,'(1X,"task ",I0," set",/,1X,"Performing Interface Generation")') task + call generator%set_tolerance( & + tolerance = tolerance & + ) + call generator%set_materials( & + structure_lw = struc1_bas, structure_up = struc2_bas, & + use_pricel_lw = lw_use_pricel, use_pricel_up = up_use_pricel, & + elastic_constants_lw = [ lw_bulk_modulus ], & + elastic_constants_up = [ up_bulk_modulus ] & + ) + call generator%set_surface_properties( & + miller_lw = lw_mplane, miller_up = up_mplane, & + is_layered_lw = lw_layered, is_layered_up = up_layered, & + layer_separation_cutoff = [ lw_layer_sep, up_layer_sep ] & + ) + if(.not.ludef_lw_layered) call generator%reset_is_layered_lw() + if(.not.ludef_up_layered) call generator%reset_is_layered_up() !!------------------------------------------------------------------------- !! surface generator !!------------------------------------------------------------------------- if(lsurf_gen)then - - call system('mkdir -p DTERMINATIONS') - call chdir("DTERMINATIONS") - if(all(lw_mplane.eq.0))then write(*,'("No Miller plane defined for lower material.")') write(*,'("Skipping...")') else write(*,'(1X,"Finding terminations for lower material.")') - term_gen%layer_separation_cutoff = lw_layer_sep - call term_gen%generate(struc1_bas,lw_mplane,axis,& + structures = generator%get_terminations(1, & num_layers = lw_num_layers, & thickness = lw_thickness & ) - call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "lw_") + do i = 1, size(structures) + write(filename, '(A,I0,A)') "lw_term_", i, ".vasp" + open(newunit=unit, status='replace', file=trim(filename)) + call geom_write(unit, structures(i)) + close(unit) + end do end if if(all(up_mplane.eq.0))then write(*,'("No Miller plane defined for upper material.")') write(*,'("Skipping...")') else write(*,'(1X,"Finding terminations for upper material.")') - term_gen%layer_separation_cutoff = up_layer_sep - call term_gen%generate(struc2_bas,up_mplane,axis,& + structures = generator%get_terminations(2, & num_layers = up_num_layers, & thickness = up_thickness & ) - call term_gen%write_structures(directory = "DTERMINATIONS", prefix= "up_") + do i = 1, size(structures) + write(filename, '(A,I0,A)') "up_term_", i, ".vasp" + open(newunit=unit, status='replace', file=trim(filename)) + call geom_write(unit, structures(i)) + close(unit) + end do end if write(*,'(1X,"Terminations printed.",/,1X,"Exiting...")') stop @@ -91,30 +130,15 @@ program artemis_executable !! interface generator !!------------------------------------------------------------------------- if(irestart.eq.0)then - call intf_gen%set_tolerance( & - tolerance = tolerance & - ) - call intf_gen%set_materials( & - structure_lw = struc1_bas, structure_up = struc2_bas, & - use_pricel_lw = lw_use_pricel, use_pricel_up = up_use_pricel, & - elastic_constants_lw = [ lw_bulk_modulus ], & - elastic_constants_up = [ up_bulk_modulus ] & - ) - call intf_gen%set_surface_properties( & - miller_lw = lw_mplane, miller_up = up_mplane, & - is_layered_lw = lw_layered, is_layered_up = up_layered & - ) - if(.not.ludef_lw_layered) call intf_gen%reset_is_layered_lw() - if(.not.ludef_up_layered) call intf_gen%reset_is_layered_up() - call intf_gen%generate( & + call generator%generate( & surface_lw = lw_surf, surface_up = up_surf, & print_lattice_match_info = lprint_matches, & print_termination_info = lprint_terms, & print_shift_info = lprint_shifts & ) - call intf_gen%write_structures(directory = "DINTERFACES", prefix= "") + call generator%write_structures(directory = "DINTERFACES", prefix= "") else - call intf_gen%restart(struc1_bas) + call generator%restart(struc1_bas) end if diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 97078f4..fd47a1e 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -618,31 +618,85 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ area_weight=area_weight) def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ - interface_depth=None, separation_scale=None, depth_method=None): + interface_depth=None, separation_scale=None, depth_method=None, \ + bondlength_cutoff=None): """ - set_shift_method__binding__artemis_gen_type(self[, method, \ - num_shifts, shifts, interface_depth, separation_scale, depth_method]) + set_shift_method__binding__artemis_generator_type(self[, method, num_shifts, \ + shifts, interface_depth, separation_scale, depth_method, bondlength_cutoff]) Defined at \ - ../src/fortran/lib/mod_intf_generator.f90 \ - lines 133-196 + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + lines 180-252 Parameters ---------- - this : Artemis_generator_Type + this : Artemis_Generator_Type method : int num_shifts : int shifts : float array interface_depth : float separation_scale : float depth_method : int + bondlength_cutoff : float """ _artemis.f90wrap_intf_gen__set_shift_method__binding_agt(this=self._handle, \ method=method, num_shifts=num_shifts, shifts=shifts, \ interface_depth=interface_depth, separation_scale=separation_scale, \ - depth_method=depth_method) + depth_method=depth_method, bondlength_cutoff=bondlength_cutoff) + + def set_swap_method(self, method=None, num_swaps=None, swap_density=None, \ + swap_depth=None, swap_sigma=None, require_mirror_swaps=None): + """ + set_swap_method__binding__artemis_generator_type(self[, method, num_swaps, \ + swap_density, swap_depth, swap_sigma, require_mirror_swaps]) + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + lines 259-283 + + Parameters + ---------- + this : Artemis_Generator_Type + method : int + num_swaps : int + swap_density : float + swap_depth : float + swap_sigma : float + require_mirror_swaps : bool + + """ + _artemis.f90wrap_intf_gen__set_swap_method__binding_agt(this=self._handle, \ + method=method, num_swaps=num_swaps, swap_density=swap_density, \ + swap_depth=swap_depth, swap_sigma=swap_sigma, \ + require_mirror_swaps=require_mirror_swaps) + + def set_match_method(self, method=None, max_num_matches=None, \ + max_num_terms=None, max_num_planes=None, compensate_normal=None): + """ + set_match_method__binding__artemis_generator_type(self[, method, \ + max_num_matches, max_num_terms, max_num_planes, compensate_normal]) + + + Defined at \ + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + lines 290-310 + + Parameters + ---------- + this : Artemis_Generator_Type + method : int + max_num_matches : int + max_num_terms : int + max_num_planes : int + compensate_normal : bool + + """ + _artemis.f90wrap_intf_gen__set_match_method__binding_agt(this=self._handle, \ + method=method, max_num_matches=max_num_matches, max_num_terms=max_num_terms, \ + max_num_planes=max_num_planes, compensate_normal=compensate_normal) def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ elastic_constants_up=None, use_pricel_lw=None, use_pricel_up=None): @@ -685,28 +739,38 @@ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ use_pricel_up=use_pricel_up) def set_surface_properties(self, miller_lw=None, miller_up=None, \ - is_layered_lw=None, is_layered_up=None): + is_layered_lw=None, is_layered_up=None, layer_separation_cutoff_lw=None, \ + layer_separation_cutoff_up=None, layer_separation_cutoff=None, \ + vacuum_gap=None): """ - set_surface_properties__binding__artemis_gen_type(self[, \ - miller_lw, miller_up, is_layered_lw, is_layered_up]) + set_surface_properties__binding__artemis_generator_type(self[, miller_lw, \ + miller_up, is_layered_lw, is_layered_up, layer_separation_cutoff_lw, \ + layer_separation_cutoff_up, layer_separation_cutoff, vacuum_gap]) Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ - lines 295-318 + /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + lines 364-435 Parameters ---------- - this : Artemis_generator_Type + this : Artemis_Generator_Type miller_lw : int array miller_up : int array is_layered_lw : bool is_layered_up : bool + layer_separation_cutoff_lw : float + layer_separation_cutoff_up : float + layer_separation_cutoff : float array + vacuum_gap : float """ _artemis.f90wrap_intf_gen__set_surface_properties__binding_agt(this=self._handle, \ miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, \ - is_layered_up=is_layered_up) + is_layered_up=is_layered_up, \ + layer_separation_cutoff_lw=layer_separation_cutoff_lw, \ + layer_separation_cutoff_up=layer_separation_cutoff_up, \ + layer_separation_cutoff=layer_separation_cutoff, vacuum_gap=vacuum_gap) def reset_is_layered_lw(self): """ @@ -801,7 +865,7 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ # allocate the structures structures = geom_rw.basis_array() #.allocate(n_structs) structures.allocate(n_structs) - _artemis.f90wrap_retrieve_last_generated_structures(n_structs, structures._handle) + _artemis.f90wrap_retrieve_last_generated_structures(structures._handle) structures = structures.toase() if return_exit_code: @@ -810,6 +874,7 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ thickness_up=None, num_layers_lw=None, num_layers_up=None, \ + reduce_matches=None, \ print_lattice_match_info=None, print_termination_info=None, \ print_shift_info=None, break_on_fail=None, icheck_match=None, \ interface_idx=None, generate_structures=None, seed=None, verbose=None, \ @@ -852,9 +917,10 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ structures = None exit_code = _artemis.f90wrap_intf_gen__generate__binding__agt(this=self._handle, \ - surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, \ - thickness_up=thickness_up, num_layers_lw=num_layers_lw, \ - num_layers_up=num_layers_up, \ + surface_lw=surface_lw, surface_up=surface_up, + thickness_lw=thickness_lw, thickness_up=thickness_up, + num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, \ + reduce_matches=reduce_matches, \ print_lattice_match_info=print_lattice_match_info, \ print_termination_info=print_termination_info, \ print_shift_info=print_shift_info, break_on_fail=break_on_fail, \ @@ -1474,7 +1540,7 @@ def require_mirror_swaps(self): @require_mirror_swaps.setter def require_mirror_swaps(self, require_mirror_swaps): - _artemis.f90wrap_artemis_gen_type__set__require_mirr3bfa(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__require_mirror_swaps(self._handle, \ require_mirror_swaps) @property @@ -1554,9 +1620,9 @@ def max_num_planes(self, max_num_planes): max_num_planes) @property - def fix_normal(self): + def compensate_normal(self): """ - Element fix_normal ftype=logical pytype=bool + Element compensate_normal ftype=logical pytype=bool Defined at \ @@ -1565,12 +1631,12 @@ def fix_normal(self): """ return \ - _artemis.f90wrap_artemis_gen_type__get__fix_normal(self._handle) + _artemis.f90wrap_artemis_gen_type__get__compensate_normal(self._handle) - @fix_normal.setter - def fix_normal(self, fix_normal): - _artemis.f90wrap_artemis_gen_type__set__fix_normal(self._handle, \ - fix_normal) + @compensate_normal.setter + def compensate_normal(self, compensate_normal): + _artemis.f90wrap_artemis_gen_type__set__compensate_normal(self._handle, \ + compensate_normal) @property def bondlength_cutoff(self): @@ -1584,11 +1650,11 @@ def bondlength_cutoff(self): """ return \ - _artemis.f90wrap_artemis_gen_type__get__bondlength_c21a8(self._handle) + _artemis.f90wrap_artemis_gen_type__get__bondlength_cutoff(self._handle) @bondlength_cutoff.setter def bondlength_cutoff(self, bondlength_cutoff): - _artemis.f90wrap_artemis_gen_type__set__bondlength_cbd11(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__bondlength_cutoff(self._handle, \ bondlength_cutoff) @property @@ -1610,7 +1676,7 @@ def layer_separation_cutoff(self): layer_separation_cutoff = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_gen_type__array__layer_sepa90a5) + _artemis.f90wrap_artemis_gen_type__array__layer_separation_cutoff) self._arrays[array_handle] = layer_separation_cutoff return layer_separation_cutoff @@ -1702,8 +1768,8 @@ def __str__(self): ret.append(repr(self.max_num_terms)) ret.append(',\n max_num_planes : ') ret.append(repr(self.max_num_planes)) - ret.append(',\n fix_normal : ') - ret.append(repr(self.fix_normal)) + ret.append(',\n compensate_normal : ') + ret.append(repr(self.compensate_normal)) ret.append(',\n bondlength_cutoff : ') ret.append(repr(self.bondlength_cutoff)) ret.append(',\n layer_separation_cutoff : ') diff --git a/src/fortran/artemis.f90 b/src/fortran/artemis.f90 index e22a532..e3a6fdd 100644 --- a/src/fortran/artemis.f90 +++ b/src/fortran/artemis.f90 @@ -1,4 +1,6 @@ module artemis + use artemis__geom_rw, only: basis_type, & + geom_write, geom_read use artemis__structure_cache, only: & store_last_generated_structures, & retrieve_last_generated_structures diff --git a/src/fortran/lib/mod_constants.f90 b/src/fortran/lib/mod_constants.f90 index e7ba879..88bca78 100644 --- a/src/fortran/lib/mod_constants.f90 +++ b/src/fortran/lib/mod_constants.f90 @@ -8,7 +8,7 @@ module artemis__constants real(real32), parameter, public :: avogadros=6.022e23_real32 real(real32), parameter, public :: bohrtoang=0.529177249_real32 real(real32), parameter, public :: pi = 4._real32*atan(1._real32) - real(real32), parameter, public :: INF = huge(1._real32) + real(real32), parameter, public :: INF = huge(0._real32) integer, public :: ierror = -1 real(real32), parameter, public :: tolerance = 1.E-6_real32 end MODULE artemis__constants diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index f8a3008..7de7b6e 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -9,13 +9,13 @@ module artemis__generator use artemis__misc, only: to_lower,to_upper use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type use artemis__geom_rw, only: basis_type,geom_write - use lat_compare, only: get_best_match + use lat_compare, only: lattice_matching, cyc_lat1 use artemis__io_utils, only: err_abort, print_warning, stop_program use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: uvec,modu,get_area,inverse,cross use interface_identifier, only: intf_info_type,& get_interface,get_layered_axis,gen_DON - use edit_geom, only: planecutter,primitive_lat,ortho_axis,& + use artemis__geom_utils, only: planecutter,primitive_lat,ortho_axis,& shift_region,set_vacuum,transformer,shifter,reducer,& get_min_bulk_bond,get_min_bond,get_shortest_bond,bond_type,& share_strain, MATNORM, basis_stack, compare_stoichiometry @@ -41,7 +41,7 @@ module artemis__generator logical :: use_pricel_lw = .true., use_pricel_up = .true. !! Use primitive cell for lower and upper bulk structures - integer, dimension(3) :: miller_lw = [ 0, 0, 0], miller_up = [ 0, 0, 0 ] + integer, dimension(3) :: miller_lw = [ 0, 0, 0 ], miller_up = [ 0, 0, 0 ] !! Miller indices for the lower and upper bulk structures logical :: is_layered_lw = .false., is_layered_up = .false. !! Boolean whether the lower and upper bulk structures are layered @@ -70,7 +70,6 @@ module artemis__generator !! Data of mismatches for each interface !! index 1 is length 3, element 1 = length, element 2 = angle, element 3 = area !! index 2 is the interface number in structures - real(real32), dimension(:,:), allocatable :: shift_data !! Data of shifts for each interface, where index 1 is the interface number in structures @@ -96,10 +95,10 @@ module artemis__generator integer :: max_num_planes = 10 !! Maximum number of planes - logical :: fix_normal = .true. !! compensate_strains_parallel = .true. - !! Fix the lattice constants parallel to the interface normal vector - !! Fix = true = strained - !! Fix = false = relaxed (compensate for interfacial strain by extending/compressing) + logical :: compensate_normal = .true. + !! Compensate mismatch strain by adjusting the axes parallel to the interface normal vector + !! Compensate = false = strained + !! Compensate = true = relaxed (compensate for interfacial strain by extending/compressing) real(real32) :: bondlength_cutoff = 6._real32 !! Maximum bond length cutoff for the bulk structures @@ -114,6 +113,11 @@ module artemis__generator !! Set tolerance for identifying good lattice matches procedure, pass(this) :: set_shift_method !! Set the shift method and associated data + procedure, pass(this) :: set_swap_method + !! Set the swap method and associated data + procedure, pass(this) :: set_match_method + !! Set the lattice match method and associated data + procedure, pass(this) :: set_materials !! Set the input materials for the interface generator procedure, pass(this) :: set_surface_properties @@ -196,7 +200,8 @@ end subroutine set_tolerance subroutine set_shift_method( & this, & method, num_shifts, shifts, & - interface_depth, separation_scale, depth_method & + interface_depth, separation_scale, depth_method, & + bondlength_cutoff & ) !! Set the shift method implicit none @@ -216,6 +221,8 @@ subroutine set_shift_method( & !! Separation scale integer, intent(in), optional :: depth_method !! Method for determining the depth to which consider atoms from interface + real(real32), intent(in), optional :: bondlength_cutoff + !! Bond length cutoff for the bulk structures ! Local variables character(len=256) :: err_msg @@ -225,6 +232,7 @@ subroutine set_shift_method( & if(present(interface_depth)) this%interface_depth = interface_depth if(present(separation_scale)) this%separation_scale = separation_scale if(present(depth_method)) this%depth_method = depth_method + if(present(bondlength_cutoff)) this%bondlength_cutoff = bondlength_cutoff if(present(shifts)) then if(allocated(this%shifts)) deallocate(this%shifts) select rank(shifts) @@ -275,6 +283,74 @@ end subroutine set_shift_method !############################################################################### +!############################################################################### + subroutine set_swap_method( & + this, method, num_swaps, swap_density, swap_depth, swap_sigma, & + require_mirror_swaps & + ) + !! Set the swap method + implicit none + + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type + integer, intent(in), optional :: method + !! Swap method + integer, intent(in), optional :: num_swaps + !! Number of swaps + real(real32), intent(in), optional :: swap_density + !! Swap density + real(real32), intent(in), optional :: swap_depth + !! Swap depth + real(real32), intent(in), optional :: swap_sigma + !! Swap sigma + logical, intent(in), optional :: require_mirror_swaps + !! Require mirror swaps + + if(present(method)) this%swap_method = method + if(present(num_swaps)) this%num_swaps = num_swaps + if(present(swap_density)) this%swap_density = swap_density + if(present(swap_depth)) this%swap_depth = swap_depth + if(present(swap_sigma)) this%swap_sigma = swap_sigma + if(present(require_mirror_swaps)) & + this%require_mirror_swaps = require_mirror_swaps + + end subroutine set_swap_method +!############################################################################### + + +!############################################################################### + subroutine set_match_method( & + this, method, max_num_matches, max_num_terms, max_num_planes, & + compensate_normal & + ) + !! Set the lattice match method + implicit none + + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type + integer, intent(in), optional :: method + !! Match method + integer, intent(in), optional :: max_num_matches + !! Maximum number of matches + integer, intent(in), optional :: max_num_terms + !! Maximum number of terminations + integer, intent(in), optional :: max_num_planes + !! Maximum number of planes + logical, intent(in), optional :: compensate_normal + !! Compensate mismatch strain by adjusting the axes parallel to the interface normal vector + + if(present(method)) this%match_method = method + if(present(max_num_matches)) this%max_num_matches = max_num_matches + if(present(max_num_terms)) this%max_num_terms = max_num_terms + if(present(max_num_planes)) this%max_num_planes = max_num_planes + if(present(compensate_normal)) this%compensate_normal = compensate_normal + + end subroutine set_match_method +!############################################################################### + + !############################################################################### subroutine set_materials( & this, structure_lw, structure_up, & @@ -287,9 +363,9 @@ subroutine set_materials( & ! Arguments class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type - type(basis_type), intent(in) :: structure_lw + type(basis_type), intent(in), optional :: structure_lw !! Lower bulk structure - type(basis_type), intent(in) :: structure_up + type(basis_type), intent(in), optional :: structure_up !! Upper bulk structure real(real32), dimension(:), intent(in), optional :: elastic_constants_lw !! Elastic constants for the lower bulk structure @@ -303,8 +379,8 @@ subroutine set_materials( & character(len=256) :: err_msg - this%structure_lw = structure_lw - this%structure_up = structure_up + if(present(structure_lw)) call this%structure_lw%copy(structure_lw, length=4) + if(present(structure_up)) call this%structure_up%copy(structure_up, length=4) !--------------------------------------------------------------------------- ! Handle the elastic constants @@ -332,7 +408,10 @@ end subroutine set_materials subroutine set_surface_properties( & this, & miller_lw, miller_up, & - is_layered_lw, is_layered_up & + is_layered_lw, is_layered_up, & + layer_separation_cutoff_lw, layer_separation_cutoff_up, & + layer_separation_cutoff, & + vacuum_gap & ) !! Set the surface properties for the interface generator implicit none @@ -350,6 +429,20 @@ subroutine set_surface_properties( & logical, intent(in), optional :: is_layered_up !! Boolean whether the upper bulk structure is layered + real(real32), intent(in), optional :: layer_separation_cutoff_lw + !! Layer separation cutoff for the lower bulk structure + real(real32), intent(in), optional :: layer_separation_cutoff_up + !! Layer separation cutoff for the upper bulk structure + real(real32), dimension(..), intent(in), optional :: layer_separation_cutoff + !! Layer separation cutoff + + real(real32), intent(in), optional :: vacuum_gap + !! Vacuum gap for termination generator + + ! Local variables + character(len=256) :: err_msg + !! Error message + if(present(miller_lw)) this%miller_lw = miller_lw if(present(miller_up)) this%miller_up = miller_up @@ -362,6 +455,46 @@ subroutine set_surface_properties( & this%is_layered_up = is_layered_up this%ludef_is_layered_up = .true. end if + + if(present(vacuum_gap)) this%vacuum_gap = vacuum_gap + + if(present(layer_separation_cutoff_lw)) & + this%layer_separation_cutoff(1) = layer_separation_cutoff_lw + if(present(layer_separation_cutoff_up)) & + this%layer_separation_cutoff(2) = layer_separation_cutoff_up + + if( ( present(layer_separation_cutoff_lw) .or. & + present(layer_separation_cutoff_up) ) .and. & + present(layer_separation_cutoff) ) then + write(err_msg,'(A)') & + "The layer separation cutoff is defined in two ways. Please use only one." + call stop_program(trim(err_msg)) + return + elseif(present(layer_separation_cutoff))then + select rank(layer_separation_cutoff) + rank(0) + this%layer_separation_cutoff(:) = layer_separation_cutoff + rank(1) + select case(size(layer_separation_cutoff,dim=1)) + case(1) + this%layer_separation_cutoff = layer_separation_cutoff(1) + case(2) + this%layer_separation_cutoff = layer_separation_cutoff + case default + write(err_msg,'(A,I0,A)') & + "The layer separation cutoff vector has ", & + size(layer_separation_cutoff,dim=1), & + " components. It should have 1 or 2." + call stop_program(trim(err_msg)) + return + end select + rank default + write(err_msg,'(A,I0,A)') & + "The layer separation cutoff only accepts rank 0 or 1." + call stop_program(trim(err_msg)) + return + end select + end if end subroutine set_surface_properties !############################################################################### @@ -677,16 +810,17 @@ end function get_terminations !############################################################################### - subroutine generate_intefaces_from_existing(this, basis, interface_location, & + subroutine generate_intefaces_from_existing( & + this, structure, interface_location, & print_shift_info, seed, verbose, exit_code & ) - !! Generate interfaces for the given basis + !! Generate swaps and shifts for an existing interface implicit none ! Arguments class(artemis_generator_type), intent(inout) :: this !! Instance of artemis generator type - type(basis_type), intent(in) :: basis + type(basis_type), intent(in) :: structure !! Atomic structure data real(real32), dimension(2), intent(in), optional :: interface_location !! Interface location @@ -760,38 +894,33 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & intf%axis = this%axis intf%loc = interface_location else - intf=get_interface(basis%lat,basis,this%axis) - intf%loc=intf%loc/modu(basis%lat(intf%axis,:)) - write(*,*) "interface axis:",intf%axis - write(*,*) "interface loc:",intf%loc - !! write interface location to a file for user to refer back to - ! open(unit=10,file="interface_location.dat") - ! write(10,'(1X,"AXIS = ",I0)') intf%axis - ! write(10,'(1X,"INTF_LOC = ",2(2X,F9.6))') intf%loc - ! close(10) + intf=get_interface(structure%lat,structure,this%axis) + intf%loc=intf%loc/modu(structure%lat(intf%axis,:)) + if(verbose_.gt.0) write(*,*) "interface axis:",intf%axis + if(verbose_.gt.0) write(*,*) "interface loc:",intf%loc end if - specloop1: do is=1,basis%nspec - atomloop1: do ia=1,basis%spec(is)%num + specloop1: do is=1,structure%nspec + atomloop1: do ia=1,structure%spec(is)%num - specloop2: do js=1,basis%nspec - atomloop2: do ja=1,basis%spec(js)%num + specloop2: do js=1,structure%nspec + atomloop2: do ja=1,structure%spec(js)%num if(is.eq.js.and.ia.eq.ja) cycle atomloop2 if( & - ( basis%spec(is)%atom(ia,intf%axis).gt.intf%loc(1).and.& - basis%spec(is)%atom(ia,intf%axis).lt.intf%loc(2) ).and.& - ( basis%spec(js)%atom(ja,intf%axis).gt.intf%loc(1).and.& - basis%spec(js)%atom(ja,intf%axis).lt.intf%loc(2) ) )then - vtmp1 = (basis%spec(is)%atom(ia,:3)-basis%spec(js)%atom(ja,:3)) - vtmp1 = matmul(vtmp1,basis%lat) + ( structure%spec(is)%atom(ia,intf%axis).gt.intf%loc(1).and.& + structure%spec(is)%atom(ia,intf%axis).lt.intf%loc(2) ).and.& + ( structure%spec(js)%atom(ja,intf%axis).gt.intf%loc(1).and.& + structure%spec(js)%atom(ja,intf%axis).lt.intf%loc(2) ) )then + vtmp1 = (structure%spec(is)%atom(ia,:3)-structure%spec(js)%atom(ja,:3)) + vtmp1 = matmul(vtmp1,structure%lat) dtmp1 = modu(vtmp1) if(dtmp1.lt.min_bond1) min_bond1 = dtmp1 elseif( & - ( basis%spec(is)%atom(ia,intf%axis).lt.intf%loc(1).or.& - basis%spec(is)%atom(ia,intf%axis).gt.intf%loc(2) ).and.& - ( basis%spec(js)%atom(ja,intf%axis).lt.intf%loc(1).or.& - basis%spec(js)%atom(ja,intf%axis).gt.intf%loc(2) ) )then - vtmp1 = (basis%spec(is)%atom(ia,:3)-basis%spec(js)%atom(ja,:3)) - vtmp1 = matmul(vtmp1,basis%lat) + ( structure%spec(is)%atom(ia,intf%axis).lt.intf%loc(1).or.& + structure%spec(is)%atom(ia,intf%axis).gt.intf%loc(2) ).and.& + ( structure%spec(js)%atom(ja,intf%axis).lt.intf%loc(1).or.& + structure%spec(js)%atom(ja,intf%axis).gt.intf%loc(2) ) )then + vtmp1 = (structure%spec(is)%atom(ia,:3)-structure%spec(js)%atom(ja,:3)) + vtmp1 = matmul(vtmp1,structure%lat) dtmp1 = modu(vtmp1) if(dtmp1.lt.min_bond2) min_bond2 = dtmp1 end if @@ -803,11 +932,11 @@ subroutine generate_intefaces_from_existing(this, basis, interface_location, & end do specloop1 min_bond = ( min_bond1 + min_bond2 ) / 2._real32 - write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond - write(*,'(1X,"Trans-interfacial scaling factor:",F0.3)') this%separation_scale + if(verbose_.gt.0) write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') min_bond + if(verbose_.gt.0) write(*,'(1X,"Trans-interfacial scaling factor:",F0.3)') this%separation_scale this%axis = intf%axis call this%generate_perturbations( & - basis, intf%loc, & + structure, intf%loc, & min_bond, bulk_DON, & print_shift_info_, seed_arr, verbose_, exit_code_ & ) @@ -824,6 +953,7 @@ subroutine generate_interfaces( & surface_lw, surface_up, & thickness_lw, thickness_up, & num_layers_lw, num_layers_up, & + reduce_matches, & print_lattice_match_info, print_termination_info, print_shift_info, & break_on_fail, & icheck_match, interface_idx, & @@ -848,6 +978,8 @@ subroutine generate_interfaces( & !! Number of layers in the lower slab integer, intent(in), optional :: num_layers_up !! Number of layers in the upper slab + logical, intent(in), optional :: reduce_matches + !! Reduce lattice matches to their smallest cell (UNSTABLE) logical, intent(in), optional :: break_on_fail !! Break on failure @@ -930,15 +1062,15 @@ subroutine generate_interfaces( & integer :: ntrans, iunique, itmp1, num_structures_old integer :: layered_axis_lw, layered_axis_up - real(real32) :: dtmp1,bondlength - character(3) :: abc - character(1024) :: pwd, intf_dir, dirpath, msg + real(real32) :: dtmp1, bondlength type(confine_type) :: confine type(latmatch_type) :: SAV type(term_arr_type) :: lw_term, up_term integer, dimension(3) :: ivtmp1 real(real32), dimension(2) :: intf_loc real(real32), dimension(3) :: init_offset + logical :: reduce_matches_ + !! Boolean whether to reduce lattice matches to their smallest cell real(real32), dimension(3,3) :: tfmat !! Transformation matrix type(bulk_DON_type), dimension(2) :: bulk_DON @@ -958,7 +1090,9 @@ subroutine generate_interfaces( & !--------------------------------------------------------------------------- exit_code_ = 0 verbose_ = 0 + reduce_matches_ = .false. if(present(verbose)) verbose_ = verbose + if(present(reduce_matches)) reduce_matches_ = reduce_matches icheck_match_ = -1; interface_idx_ = -1 if(present(icheck_match)) icheck_match_ = icheck_match @@ -1056,10 +1190,11 @@ subroutine generate_interfaces( & case(2) surface_lw_ = surface_lw case default - write(msg,'(A,I0,A)') & - "ERROR: The surface vector for the lower material has ", & + write(err_msg,'(A,I0,A)') & + "The surface vector for the lower material has ", & size(surface_lw, dim=1), " components. It should have 1 or 2." - call err_abort(trim(msg),fmtd=.true.) + call stop_program(trim(err_msg)) + return end select end if if(present(surface_up))then @@ -1069,10 +1204,10 @@ subroutine generate_interfaces( & case(2) surface_up_ = surface_up case default - write(msg,'(A,I0,A)') & - "ERROR: The surface vector for the upper material has ", & + write(err_msg,'(A,I0,A)') & + "The surface vector for the upper material has ", & size(surface_up, dim=1), " components. It should have 1 or 2." - call err_abort(trim(msg),fmtd=.true.) + call stop_program(trim(err_msg)) end select end if @@ -1090,18 +1225,18 @@ subroutine generate_interfaces( & if(present(thickness_lw)) thickness_lw_ = thickness_lw if(present(thickness_up)) thickness_up_ = thickness_up if(num_layers_lw_.le.0.and.thickness_lw_.le.0._real32)then - write(msg,'(A,I0,A)') & - "ERROR: The number of layers for the lower material is ", & + write(err_msg,'(A,I0,A)') & + "The number of layers for the lower material is ", & num_layers_lw_, " and the thickness is ", thickness_lw_, & " One of these must be greater than 0." - call err_abort(trim(msg),fmtd=.true.) + call stop_program(trim(err_msg)) end if if(num_layers_up_.le.0.and.thickness_up_.le.0._real32)then - write(msg,'(A,I0,A)') & - "ERROR: The number of layers for the upper material is ", & + write(err_msg,'(A,I0,A)') & + "The number of layers for the upper material is ", & num_layers_up_, " and the thickness is ", thickness_up_, & " One of these must be greater than 0." - call err_abort(trim(msg),fmtd=.true.) + call stop_program(trim(err_msg)) end if @@ -1136,18 +1271,18 @@ subroutine generate_interfaces( & do ia = 1, inlw_bas%spec(is)%num dtmp1 = modu(get_min_bond(inlw_lat, inlw_bas, is, ia)) if(dtmp1.lt.bondlength) bondlength = dtmp1 - if(dtmp1.gt.max_bondlength)then + if(dtmp1.gt.this%bondlength_cutoff)then write(filename,'("lw_DON_",I0,"_",I0,".dat")') is,ia open(unit=13,file=filename) do j=1,1000 write(13,*) & - (j-1)*max_bondlength/1000,& + (j-1)*this%bondlength_cutoff/1000,& bulk_DON(1)%spec(is)%atom(ia,j) end do close(13) end if end do - if(bondlength.gt.max_bondlength)then + if(bondlength.gt.this%bondlength_cutoff)then write(0,*) "Min bondlength for lower species ", & is, " is ", bondlength write(0,*) "To account for this, increase MBOND_MAXLEN to at & @@ -1167,18 +1302,18 @@ subroutine generate_interfaces( & do ia = 1, inup_bas%spec(is)%num dtmp1 = modu(get_min_bond(inup_lat, inup_bas, is, ia)) if(dtmp1.lt.bondlength) bondlength = dtmp1 - if(dtmp1.gt.max_bondlength)then + if(dtmp1.gt.this%bondlength_cutoff)then write(filename,'("up_DON_",I0,"_",I0,".dat")') is,ia open(unit=13,file=filename) do j=1,1000 write(13,*) & - (j-1)*max_bondlength/1000,& + (j-1)*this%bondlength_cutoff/1000,& bulk_DON(2)%spec(is)%atom(ia,j) end do close(13) end if end do - if(bondlength.gt.max_bondlength)then + if(bondlength.gt.this%bondlength_cutoff)then write(0,*) "Min bondlength for upper species ", & is, " is ", bondlength write(0,*) "To account for this, increase MBOND_MAXLEN to at & @@ -1201,16 +1336,16 @@ subroutine generate_interfaces( & ivtmp1 = 0 ivtmp1(layered_axis_lw)=1 if(this%ludef_is_layered_lw)then - write(msg,'("Lower crystal appears layered along axis ",I0,"\n& + write(err_msg,'("Lower crystal appears layered along axis ",I0,"\n& &Partial layer terminations will be generated\n& &We suggest using LW_MILLER =",3(1X,I1))') layered_axis_lw,ivtmp1 - call print_warning(trim(msg)) + call print_warning(trim(err_msg)) else - write(msg,'("Lower crystal has been identified as layered\nalong",3(1X,I1),"\n& + write(err_msg,'("Lower crystal has been identified as layered\nalong",3(1X,I1),"\n& &Confining crystal to this plane and\nstoichiometric terminations.\n& &If you don''t want this, set\nLW_LAYERED = .FALSE.")') & ivtmp1 - call print_warning(trim(msg)) + call print_warning(trim(err_msg)) miller_lw=ivtmp1 this%is_layered_lw=.true. end if @@ -1223,16 +1358,16 @@ subroutine generate_interfaces( & ivtmp1=0 ivtmp1(layered_axis_up)=1 if(this%ludef_is_layered_up)then - write(msg,'("Upper crystal appears layered along axis ",I0,"\n& + write(err_msg,'("Upper crystal appears layered along axis ",I0,"\n& &Partial layer terminations will be generated\n& &We suggest using UP_MILLER =",3(1X,I1))') layered_axis_up,ivtmp1 - call print_warning(trim(msg)) + call print_warning(trim(err_msg)) else - write(msg,'("Upper crystal has been identified as layered\nalong",3(1X,I1),"\n& + write(err_msg,'("Upper crystal has been identified as layered\nalong",3(1X,I1),"\n& &Confining crystal to this plane and\nstoichiometric terminations.\n& &If you don''t want this, set\nUP_LAYERED = .FALSE.")') & ivtmp1 - call print_warning(trim(msg)) + call print_warning(trim(err_msg)) miller_up=ivtmp1 this%is_layered_up=.true. end if @@ -1245,7 +1380,6 @@ subroutine generate_interfaces( & ! Finds and stores the best matches between the materials !--------------------------------------------------------------------------- num_structures_old = -1 - abc="abc" if(this%match_method.ne.0.and.(any(miller_lw.ne.0).or.any(miller_up.ne.0)))then call err_abort( '& &Cannot use LW_MILLER or UP_MILLER with IMATCH>0\n& @@ -1262,42 +1396,26 @@ subroutine generate_interfaces( & &limitations.& &")') call print_warning(trim(msg)) + tfmat = planecutter(structure_lw%lat,real(miller_lw,real32)) + call transformer(structure_lw,tfmat,lw_map) end if - if(any(miller_lw.ne.0))then - if(this%match_method.ne.0)then - abc="ab" - tfmat=planecutter(structure_lw%lat,real(miller_lw,real32)) - call transformer(structure_lw,tfmat,lw_map) - SAV=get_best_match(& - this%tolerance,& - structure_lw,structure_up,& - trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method) - elseif(any(miller_up.ne.0))then - SAV=get_best_match(& - this%tolerance,& - structure_lw,structure_up,& - trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& - plane1=miller_lw,plane2=miller_up,nmiller=this%max_num_planes) - else - SAV=get_best_match(& - this%tolerance,& - structure_lw,structure_up,& - trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& - plane1=miller_lw,nmiller=this%max_num_planes) - end if - elseif(any(miller_up.ne.0))then - SAV=get_best_match(& - this%tolerance,& - structure_lw,structure_up,& - trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& - plane2=miller_up,nmiller=this%max_num_planes) - else - SAV=get_best_match(& - this%tolerance,& - structure_lw,structure_up,& - trim(abc),"abc",print_lattice_match_info_,ierror,imatch=this%match_method,& - nmiller=this%max_num_planes) - end if + call SAV%init( & + this%tolerance, structure_lw%lat, structure_up%lat, & + reduce_matches_ & + ) + select case(this%match_method) + case(0) + call lattice_matching(& + SAV, this%tolerance, & + structure_lw, structure_up, & + miller_lw = miller_lw, miller_up = miller_up, & + max_num_planes = this%max_num_planes, & + verbose = merge(1,verbose_,print_lattice_match_info_) & + ) + case default + call SAV%constrain_axes(miller_lw, miller_up, verbose = verbose_) + call cyc_lat1(SAV, this%tolerance, this%match_method, verbose = verbose_) + end select if(min(this%tolerance%nstore,SAV%nfit).eq.0)then write(err_msg,'("No matches found between the two structures")') call print_warning(trim(err_msg)) @@ -1434,12 +1552,13 @@ subroutine generate_interfaces( & cycle intf_loop end if if(any(surface_lw_.gt.lw_term%nterm))then - write(msg, '("surface_lw_ACE VALUES INVALID!\nOne or more value & + write(err_msg, '("surface_lw_ACE VALUES INVALID!\nOne or more value & &exceeds the maximum number of terminations in the & structure.\n& & Supplied values: ",I0,1X,I0,"\n& & Maximum allowed: ",I0)') surface_lw_, lw_term%nterm - call err_abort(trim(msg),fmtd=.true.) + call err_abort(trim(err_msg),fmtd=.true.) + return end if @@ -1448,9 +1567,10 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------------- !call setup_ladder(supercell_lw%lat,supercell_lw,this%axis,lw_term) if(sum(lw_term%arr(:)%natom)*lw_term%nstep.ne.supercell_lw%natom)then - write(msg, '("ERROR: Number of atoms in lower layers not correct: "& + write(err_msg, '("Number of atoms in lower layers not correct: "& &I0,2X,I0)') sum(lw_term%arr(:)%natom)*lw_term%nstep,supercell_lw%natom - call err_abort(trim(msg),fmtd=.true.) + call err_abort(trim(err_msg),fmtd=.true.) + return end if call set_layer_tol(lw_term) @@ -1516,12 +1636,13 @@ subroutine generate_interfaces( & cycle intf_loop end if if(any(surface_up_.gt.up_term%nterm))then - write(msg, '("surface_up_ACE VALUES INVALID!\nOne or more value & + write(err_msg, '("surface_up_ACE VALUES INVALID!\nOne or more value & &exceeds the maximum number of terminations in the & structure.\n& & Supplied values: ",I0,1X,I0,"\n& & Maximum allowed: ",I0)') surface_up_, up_term%nterm - call err_abort(trim(msg),fmtd=.true.) + call err_abort(trim(err_msg),fmtd=.true.) + return end if @@ -1530,9 +1651,10 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------------- !call setup_ladder(supercell_up%lat,supercell_up,this%axis,up_term) if(sum(up_term%arr(:)%natom)*up_term%nstep.ne.supercell_up%natom)then - write(msg, '("ERROR: Number of atoms in upper layers not correct: "& + write(err_msg, '("Number of atoms in upper layers not correct: "& &I0,2X,I0)') sum(up_term%arr(:)%natom)*up_term%nstep,supercell_up%natom - call err_abort(trim(msg),fmtd=.true.) + call stop_program(trim(err_msg)) + return end if call set_layer_tol(up_term) @@ -1629,7 +1751,7 @@ subroutine generate_interfaces( & call share_strain(slab_lw%lat,slab_up%lat,& this%elastic_constants_lw(1), & this%elastic_constants_up(1), & - lcompensate = .not.this%fix_normal & + lcompensate = this%compensate_normal & ) end if case default @@ -1717,6 +1839,8 @@ subroutine generate_interfaces( & end do intf_loop + if(present(exit_code)) exit_code = exit_code_ + end subroutine generate_interfaces !############################################################################### @@ -1748,7 +1872,7 @@ subroutine generate_shifts_and_swaps( & real(real32) :: dtmp1 type(basis_type) :: tbas type(bond_type) :: min_bond - character(1024) :: filename,dirpath,pwd1,pwd2,msg + character(len=256) :: err_msg integer, dimension(3) :: abc real(real32), dimension(3) :: toffset type(basis_type), allocatable, dimension(:) :: bas_arr @@ -1886,8 +2010,8 @@ subroutine generate_shifts_and_swaps( & vac=toffset(this%axis)) min_bond = get_shortest_bond(tbas) if(min_bond%length.le.1.5_real32)then - write(msg,'("Smallest bond in the interface structure is\nless than 1.5 Å.")') - call print_warning(trim(msg)) + write(err_msg,'("Smallest bond in the interface structure is\nless than 1.5 Å.")') + call print_warning(trim(err_msg)) write(*,'(2X,"bond length: ",F9.6)') min_bond%length write(*,'(2X,"atom 1:",I4,2X,I4)') min_bond%atoms(1,:) write(*,'(2X,"atom 2:",I4,2X,I4)') min_bond%atoms(2,:) diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index d86bbdb..40f2a9e 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -35,7 +35,7 @@ !!! get_wyckoff (returns an array of the similar atoms) !!! get_shortest_bond !!!############################################################################# -module edit_geom +module artemis__geom_utils use artemis__constants, only: real32 use artemis__geom_rw, only: basis_type,geom_write use artemis__misc, only: swap @@ -2418,7 +2418,7 @@ function get_shortest_bond(basis) result(bond) real(real32), dimension(3) :: vec integer, dimension(2,2) :: atoms - min_bond = huge(1._real32) + min_bond = huge(0._real32) atoms = 0 do is = 1, basis%nspec do js = is, basis%nspec @@ -2494,4 +2494,4 @@ subroutine share_strain(lat1,lat2,bulk_mod1,bulk_mod2,axis,lcompensate) end subroutine share_strain !!!############################################################################# -end module edit_geom +end module artemis__geom_utils diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index 7612c7a..b55b39f 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -19,12 +19,11 @@ module lat_compare use misc_linalg, only: cross,uvec,modu,get_area,find_tf,det,reduce_vec_gcd,& inverse_3x3,get_vec_multiple,get_frac_denom use artemis__geom_rw, only: basis_type - use edit_geom, only: MATNORM,planecutter + use artemis__geom_utils, only: MATNORM,planecutter implicit none - integer :: ierr_compare + integer :: ierr_compare = 0 logical :: lstop=.true. - logical :: lreduce=.false. - integer, private :: match_method=0 + logical :: reduce=.false. @@ -32,116 +31,6 @@ module lat_compare contains -!!!############################################################################# -!!! -!!!############################################################################# - function get_best_match(tol,basis1,basis2,str1,str2,lprint,ierr,plane1,plane2,nmiller,imatch) result(SAV) - implicit none - integer :: num_miller - character(3) :: str1,str2 - logical :: lprint - type(tol_type) :: tol - type(basis_type) :: basis1,basis2 - type(latmatch_type) :: SAV - integer, optional :: ierr,imatch,nmiller - integer, dimension(3), optional :: plane1,plane2 - - if(present(imatch)) match_method=imatch - if(present(ierr))then - ierr_compare=ierr - else - ierr_compare=0 - end if - num_miller=10 - if(present(nmiller)) num_miller=nmiller - - allocate(SAV%tf1(tol%nstore,3,3)) - allocate(SAV%tf2(tol%nstore,3,3)) - allocate(SAV%tol(tol%nstore,3)) - - SAV%tol(:,:)=10000 - SAV%lat1=MATNORM(basis1%lat) - SAV%lat2=MATNORM(basis2%lat) - - if(match_method.eq.0)then - if(present(plane1))then - if(present(plane2))then - call lattice_matching(& - SAV,tol,basis1,basis2,& - plane1=plane1,plane2=plane2,nmiller=num_miller,& - lprint=lprint) - else - call lattice_matching(& - SAV,tol,basis1,basis2,& - plane1=plane1,nmiller=num_miller,& - lprint=lprint) - end if - elseif(present(plane2))then - call lattice_matching(& - SAV,tol,basis1,basis2,& - plane2=plane2,nmiller=num_miller,& - lprint=lprint) - else - call lattice_matching(& - SAV,tol,basis1,basis2,& - plane2=plane2,nmiller=num_miller,& - lprint=lprint) - end if - else - call pick_axis(SAV,(/str1,str2/),lprint) - call cyc_lat1(SAV,tol,lprint) - end if - if(lprint) call endcode(SAV) -! if(any(isnan(SAV%tf1(:,:,:))).or.any(isnan(SAV%tf2(:,:,:))))then -! write(0,*) "CODE BROKE ON FINDING A MATCH (NaN)" -! write(0,*) "Exiting..." -! call exit() -! end if - - - return - end function get_best_match -!!!############################################################################# - - -!!!############################################################################# -!!! Axis picker -!!!############################################################################# - subroutine pick_axis(SAV,str,lprint) - implicit none - integer :: i - logical :: lprint - character(3), dimension(2) :: str - type(latmatch_type) :: SAV - - - do i=1,2 - if(verify("abc",str(i)).eq.0) then - SAV%axes(i)=3 - if(lprint) write(*,*) "Finding matches of all possible planes." - elseif(verify("abc",str(i)).eq.3) then - SAV%axes(i)=2 - if(lprint) write(*,*) "Finding matches of the ab planes." - elseif(verify("abc",str(i)).eq.1) then - SAV%axes(i)=2 - SAV%abc=cshift(SAV%abc,shift=1) - SAV%lat1(:,:)=cshift(SAV%lat1(:,:),shift=1,dim=1) - SAV%lat2(:,:)=cshift(SAV%lat2(:,:),shift=1,dim=1) - if(lprint) write(*,*) "Finding matches of the bc planes." - elseif(verify("abc",str(i)).eq.2) then - SAV%axes(i)=2 - SAV%abc=cshift(SAV%abc,shift=2) - SAV%lat1(:,:)=cshift(SAV%lat1(:,:),shift=2,dim=1) - SAV%lat2(:,:)=cshift(SAV%lat2(:,:),shift=2,dim=1) - if(lprint) write(*,*) "Finding matches of the ca planes." - end if - end do - - - return - end subroutine pick_axis -!!!############################################################################# - !!!############################################################################# !!! cycles lattice 1 @@ -161,26 +50,24 @@ end subroutine pick_axis !!! - allows for negative values on the upper off-diagonal elements !!! - stops transformation matrix from checking over previous superlattices !!! - equivalent transformation matrix will have a determinant of zero - subroutine cyc_lat1(SAV,tol,ltmp) + subroutine cyc_lat1(SAV, tol, match_method, verbose) implicit none + type(latmatch_type), intent(inout) :: SAV + integer, intent(in) :: match_method + integer, intent(in) :: verbose integer :: i,j,k integer :: n_num,count1 logical :: l1change - logical :: lprint type(tol_type) :: tol - type(latmatch_type) :: SAV integer, dimension(3,3) :: tf1,tf2 integer, dimension(2,3) :: n real(real32), dimension(3,3) :: tlat1,tlat2 real(real32), allocatable, dimension(:,:,:) :: match_tfs - logical, optional :: ltmp !!!----------------------------------------------------------------------------- !!! Initialised varaibles and allocates arrays !!!----------------------------------------------------------------------------- - lprint=.false. - if(present(ltmp)) lprint=ltmp allocate(match_tfs(tol%maxfit,3,3)) match_tfs=0._real32 SAV%nfit=0 @@ -279,7 +166,7 @@ subroutine cyc_lat1(SAV,tol,ltmp) !!! Generates corresponding superlattice of 2nd lattice that will best ... !!! ... fit with current superlattice of 1st lattice. !!!----------------------------------------------------------------------------- - tlat2=cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) + tlat2=cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs, match_method) count1=count1+1 @@ -303,7 +190,7 @@ subroutine cyc_lat1(SAV,tol,ltmp) !!!----------------------------------------------------------------------------- !!! Checks whether corresponding superlattices are within tolerance factors !!!----------------------------------------------------------------------------- - if(tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint))then + if(tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,verbose))then !!-------------------------------------------------------------------- !! Handles counters accordingly !!-------------------------------------------------------------------- @@ -320,12 +207,12 @@ subroutine cyc_lat1(SAV,tol,ltmp) !!! Checks whether any stop conditions are met !!!----------------------------------------------------------------------------- if(SAV%nfit.eq.tol%maxfit) then - if(lprint) & + if(verbose.gt.0) & write(*,'(/,"Number of fits reached maxfits ",I0)') SAV%nfit return end if if(lstop.and.count1.gt.100) then - if(lprint) & + if(verbose.gt.0) & write(*,'(/,"Stopped as we reached ",I0," failed checks.")')& count1 return @@ -349,7 +236,7 @@ end subroutine cyc_lat1 !!!############################################################################# !!! cycles lattice 2 !!!############################################################################# - function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) + function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs, match_method) result(tlat2) implicit none integer :: i,j type(tol_type) :: tol @@ -358,6 +245,7 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) integer, dimension(3,3) :: it1_mat,it2_mat real(real32), dimension(3,3) :: t_mat,tlat1,tlat2 real(real32), dimension(:,:,:) :: match_tfs + integer, intent(in) :: match_method select case(match_method) @@ -375,7 +263,7 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) !!! This can be used to make the simplest conversion from an identity ... !!! ... transformation of lat1 and the corresponding transformation of lat2. !!!----------------------------------------------------------------------------- - SAV%lreduced=.false. + SAV%reduced=.false. match_tfs(SAV%nfit+1,:,:)=find_tf((real(tf1,real32)),(real(tf2,real32))) if(any(isnan(match_tfs(SAV%nfit+1,:,:)))) goto 201 t_mat(:,:)=match_tfs(SAV%nfit+1,:,:) @@ -389,7 +277,7 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) end if - reduce_if: if(lreduce)then + reduce_if: if(SAV%reduce)then !t_mat=transpose(t_mat) !NOT SURE WHY TRANSPOSED it1_mat(:,:)=0 it2_mat(:,:)=0 @@ -411,7 +299,7 @@ function cyc_lat2(SAV,tol,tlat1,tf1,tf2,match_tfs) result(tlat2) if(abs(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))).lt.& abs(get_area(real(it1_mat(1,:),real32),real(it1_mat(2,:),real32))))& exit reduce_if - SAV%lreduced=.true. + SAV%reduced=.true. tf1=it1_mat tf2=it2_mat !tf2=matmul(tf2,it2_mat) !WHY WAS THIS USED? @@ -633,18 +521,19 @@ end function get_lat2_alt !!!############################################################################# !!! Checks whether the supplied superlattices fit within the tolerances !!!############################################################################# - function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) + function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,verbose) result(lmatch) implicit none + type(latmatch_type), intent(inout) :: SAV + real(real32), dimension(3,3), intent(in) :: tlat1, tlat2 + integer, dimension(3,3), intent(inout) :: tf1, tf2 + integer, intent(in) :: verbose + integer :: i,j real(real32) :: ang1,ang2,t_area1,t_area2,diff logical :: la1a2,la1b2,l12,lmatch type(tol_type) :: tol - type(latmatch_type) :: SAV - integer, dimension(3,3) :: tf1,tf2 real(real32), dimension(2) :: mag_mat1,mag_mat2 real(real32), dimension(3) :: tvec - real(real32), dimension(3,3) :: tlat1,tlat2 - logical, optional :: lprint lmatch=.false. @@ -707,24 +596,22 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,lprint) result(lmatch) !!----------------------------------------------------------------------- !! Prints the mismatches for the current successful match !!----------------------------------------------------------------------- - if(present(lprint))then - if(lprint)then - write(*,'(/,A,I0,2X,A,I0)') & - "Fit number: ",SAV%nfit+1,& - "Area increase: ",& - nint(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))) - write(*,'(" Transmat 1: Transmat 2:")') - write(*,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc - write(*,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & - tf1(1,1:3),tf2(1,1:3),& - tf1(2,1:3),tf2(2,1:3),& - tf1(3,1:3),tf2(3,1:3) - write(*,'(" vector mismatch (%) = ",F0.9)') diff*100._real32 - write(*,'(" angle mismatch (°) = ",F0.9)') abs(ang1-ang2)*180/pi - write(*,'(" area mismatch (%) = ",F0.9)') (& - 1-abs(t_area1/t_area2))*100._real32 - write(*,*) "reduced:",SAV%lreduced - end if + if(verbose.gt.0)then + write(*,'(/,A,I0,2X,A,I0)') & + "Fit number: ",SAV%nfit+1,& + "Area increase: ",& + nint(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))) + write(*,'(" Transmat 1: Transmat 2:")') + write(*,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc + write(*,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & + tf1(1,1:3),tf2(1,1:3),& + tf1(2,1:3),tf2(2,1:3),& + tf1(3,1:3),tf2(3,1:3) + write(*,'(" vector mismatch (%) = ",F0.9)') diff*100._real32 + write(*,'(" angle mismatch (°) = ",F0.9)') abs(ang1-ang2)*180/pi + write(*,'(" area mismatch (%) = ",F0.9)') (& + 1-abs(t_area1/t_area2))*100._real32 + write(*,*) "reduced:",SAV%reduced end if !!----------------------------------------------------------------------- !! Checks if best mismatch and saves accordingly @@ -944,15 +831,24 @@ end function vec_comp !!! Isiah lattice match !!! Program to match lattices of two position cards. !!!############################################################################# - subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) + subroutine lattice_matching( & + SAV, tol, structure_lw, structure_up, & + miller_lw, miller_up, max_num_planes, & + verbose & + ) use artemis__sym use plane_matching implicit none + + type(latmatch_type), intent(inout) :: SAV + type(basis_type), intent(in) :: structure_lw,structure_up + integer, dimension(3), intent(in) :: miller_lw,miller_up + integer, intent(in) :: max_num_planes + integer, intent(in) :: verbose type(sym_type) :: grp1,grp2 type(tol_type) :: tol type(tol_type) :: pm_tol - type(latmatch_type) :: SAV real(real32), dimension(3,3) :: tf real(real32), dimension(3,3) :: lat1,lat2 !original lattices. real(real32), dimension(3,3) :: templat1,templat2 !tmp lattices to feed into plane matching. @@ -983,10 +879,6 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) integer, allocatable, dimension(:,:) :: ivtmp1,miller1,miller2 integer, dimension(3) :: ivtmp2 - type(basis_type), intent(in) :: bas1,bas2 - integer, intent(in) :: nmiller - logical, optional, intent(in) :: lprint - integer, dimension(3), optional, intent(in) :: plane1,plane2 !!-------------------------------------------------------------------------- @@ -1023,13 +915,13 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !!-------------------------------------------------------------------------- s_end=0 call sym_setup(grp1,lat1)!,predefined=.true.,new_start=.true.) - call check_sym(grp1,bas1,lsave=.true.) + call check_sym(grp1,structure_lw,lsave=.true.) allocate(tmpsym1(grp1%nsym,3,3)) s_end=0 call sym_setup(grp2,lat2)!,predefined=.true.,new_start=.true.) - call check_sym(grp2,bas2,lsave=.true.) + call check_sym(grp2,structure_up,lsave=.true.) allocate(tmpsym2(grp2%nsym,3,3)) @@ -1038,7 +930,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !!-------------------------------------------------------------------------- loopsize=10 allocate(ivtmp1((2*loopsize+1)**3,3)) - !allocate(ivtmp1(nmiller,3)) + !allocate(ivtmp1(max_num_planes,3)) !!-------------------------------------------------------------------------- @@ -1046,9 +938,9 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !!-------------------------------------------------------------------------- ivtmp1=0 itmp1=0 - if(present(plane1))then - allocate(miller1(1,size(plane1))) - miller1(1,:3)=plane1(:3) + if(any(miller_lw.gt.0))then + allocate(miller1(1,size(miller_lw))) + miller1(1,:3)=miller_lw(:3) else mloop1: do i1=1,loopsize m1=floor((i1)/2.0)*(-1)**i1 @@ -1060,7 +952,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) cycle mloop3 itmp1 = itmp1 + 1 ivtmp1(itmp1,:) = [ m1, m2, m3 ] - !if(itmp1.eq.nmiller) exit mloop1 + !if(itmp1.eq.max_num_planes) exit mloop1 end do mloop3 end do mloop2 end do mloop1 @@ -1073,7 +965,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) ivtmp1(i,:) = ivtmp1(loc,:) ivtmp1(loc,:) = ivtmp2(:) end do - itmp1 = min(itmp1,nmiller) + itmp1 = min(itmp1,max_num_planes) allocate(miller1(itmp1,3)) miller1(:,:) = ivtmp1(:itmp1,:) end if @@ -1084,9 +976,9 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !!-------------------------------------------------------------------------- itmp1 = 0 ivtmp1 = 0 - if(present(plane2))then - allocate(miller2(1,size(plane2))) - miller2(1,:3)=plane2(:3) + if(any(miller_up.gt.0))then + allocate(miller2(1,size(miller_up))) + miller2(1,:3)=miller_up(:3) else mloop4: do i1=1,loopsize m1=floor((i1)/2.0)*(-1)**i1 @@ -1098,7 +990,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) cycle mloop6 itmp1=itmp1+1 ivtmp1(itmp1,:)=(/m1,m2,m3/) - !if(itmp1.eq.nmiller) exit mloop4 + !if(itmp1.eq.max_num_planes) exit mloop4 end do mloop6 end do mloop5 end do mloop4 @@ -1111,26 +1003,24 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) ivtmp1(i,:) = ivtmp1(loc,:) ivtmp1(loc,:) = ivtmp2(:) end do - itmp1 = min(itmp1,nmiller) + itmp1 = min(itmp1,max_num_planes) allocate(miller2(itmp1,3)) miller2(:,:) = ivtmp1(:itmp1,:) end if - if(present(lprint))then - if(lprint)then - write(*,*) - write(*,'(1X,"Miller planes considered for lower material: ",I0)') & - size(miller1(:,1)) - do i=1,size(miller1(:,1)) - write(*,'(2X,I2,")",3X,3(3X,I0))') i,miller1(i,:) - end do - write(*,*) - write(*,'(1X,"Miller planes considered for upper material: ",I0)') & - size(miller2(:,1)) - do i=1,size(miller2(:,1)) - write(*,'(2X,I2,")",3X,3(3X,I0))') i,miller2(i,:) - end do - write(*,*) - end if + if(verbose.gt.0)then + write(*,*) + write(*,'(1X,"Miller planes considered for lower material: ",I0)') & + size(miller1(:,1)) + do i=1,size(miller1(:,1)) + write(*,'(2X,I2,")",3X,3(3X,I0))') i,miller1(i,:) + end do + write(*,*) + write(*,'(1X,"Miller planes considered for upper material: ",I0)') & + size(miller2(:,1)) + do i=1,size(miller2(:,1)) + write(*,'(2X,I2,")",3X,3(3X,I0))') i,miller2(i,:) + end do + write(*,*) end if @@ -1305,7 +1195,7 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) lvec1=.false. OUTLOOP: do i=1,tol%nstore SAV%tol(i,:) = saved_tolerances(i,:) - if_reduce: if(lreduce)then + if_reduce: if(reduce)then tf = find_tf(comb_trans_1(i,:,:),comb_trans_2(i,:,:)) if(abs(abs(det(comb_trans_1(i,:,:)))-1._real32).lt.1.E-6_real32) exit if_reduce if(ierror.eq.1)then @@ -1348,26 +1238,24 @@ subroutine lattice_matching(SAV,tol,bas1,bas2,plane1,plane2,nmiller,lprint) !!!----------------------------------------------------------------------------- !!! Print the set of best matches !!!----------------------------------------------------------------------------- - if(present(lprint))then - if(lprint)then - do i=1,SAV%nfit - write(*,'(/,A,I0,2X,A,I0)') & - "Fit number: ",i,& - "Area increase: ",& - nint(get_area(real(SAV%tf1(i,1,:),real32),real(SAV%tf1(i,2,:),real32))) - write(*,'(" Transmat 1: Transmat 2:")') - write(*,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc - write(*,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & - SAV%tf1(i,1,1:3),SAV%tf2(i,1,1:3),& - SAV%tf1(i,2,1:3),SAV%tf2(i,2,1:3),& - SAV%tf1(i,3,1:3),SAV%tf2(i,3,1:3) - write(*,'(" vector mismatch (%) = ",F0.9)') SAV%tol(i,1) - write(*,'(" angle mismatch (°) = ",F0.9)') SAV%tol(i,2)*180/pi - write(*,'(" area mismatch (%) = ",F0.9)') SAV%tol(i,3) - write(*,*) "reduced:",lvec1(i) - write(*,*) - end do - end if + if(verbose.gt.0)then + do i=1,SAV%nfit + write(*,'(/,A,I0,2X,A,I0)') & + "Fit number: ",i,& + "Area increase: ",& + nint(get_area(real(SAV%tf1(i,1,:),real32),real(SAV%tf1(i,2,:),real32))) + write(*,'(" Transmat 1: Transmat 2:")') + write(*,'((/,1X,3(3X,A1),3X,3(3X,A1)))') SAV%abc,SAV%abc + write(*,'(3(/,2X,3(I3," "),3X,3(I3," ")))') & + SAV%tf1(i,1,1:3),SAV%tf2(i,1,1:3),& + SAV%tf1(i,2,1:3),SAV%tf2(i,2,1:3),& + SAV%tf1(i,3,1:3),SAV%tf2(i,3,1:3) + write(*,'(" vector mismatch (%) = ",F0.9)') SAV%tol(i,1) + write(*,'(" angle mismatch (°) = ",F0.9)') SAV%tol(i,2)*180/pi + write(*,'(" area mismatch (%) = ",F0.9)') SAV%tol(i,3) + write(*,*) "reduced:",lvec1(i) + write(*,*) + end do end if diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 7ce5a34..0d3d77f 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -3,6 +3,7 @@ module artemis__misc_types use artemis__constants, only: real32, pi use artemis__misc, only: to_lower use artemis__geom_rw, only: basis_type, geom_write + use artemis__geom_utils, only: MATNORM implicit none @@ -15,13 +16,17 @@ module artemis__misc_types type latmatch_type integer :: nfit - logical :: lreduced + logical :: reduce = .false. + logical :: reduced = .false. character(1) :: abc(3)= [ 'a', 'b', 'c' ] integer, dimension(2) :: axes integer, allocatable, dimension(:,:,:) :: tf1,tf2 real(real32), allocatable, dimension(:,:) :: tol real(real32), dimension(3,3) :: lat1,lat2 + contains + procedure, pass(this) :: init => latmatch_init + procedure, pass(this) :: constrain_axes end type latmatch_type type tol_type @@ -47,9 +52,6 @@ module artemis__misc_types real(real32) :: vacuum_gap = 14._real32 !! Vacuum thickness in Å - real(real32) :: tol_cart - real(real32), dimension(3) :: tol_crys - type(basis_type), dimension(:), allocatable :: structures contains procedure, pass(this) :: write_structures @@ -60,6 +62,60 @@ module artemis__misc_types contains +!############################################################################### + subroutine latmatch_init( & + this, tol, lattice_lw, lattice_up, reduce_matches & + ) + implicit none + class(latmatch_type), intent(inout) :: this + type(tol_type), intent(in) :: tol + real(real32), dimension(3,3), intent(in) :: lattice_lw,lattice_up + logical, intent(in) :: reduce_matches + + allocate(this%tf1(tol%nstore,3,3)) + allocate(this%tf2(tol%nstore,3,3)) + allocate(this%tol(tol%nstore,3)) + + this%tol(:,:) = huge(0._real32) + this%lat1 = MATNORM(lattice_lw) + this%lat2 = MATNORM(lattice_up) + + this%reduce = reduce_matches + + end subroutine latmatch_init +!############################################################################### + + +!############################################################################### + subroutine constrain_axes(this, miller_lw, miller_up, verbose) + implicit none + class(latmatch_type), intent(inout) :: this + integer, dimension(3), intent(in) :: miller_lw, miller_up + integer, intent(in) :: verbose + + + if(all(miller_lw.eq.0))then + this%axes(1) = 3 + if(verbose.gt.0) write(*,*) & + "Finding matches for all possible lower planes." + else + this%axes(1) = 2 + if(verbose.gt.0) write(*,*) "Finding matches for the lower ab plane." + end if + + if(all(miller_up.eq.0))then + this%axes(2) = 3 + if(verbose.gt.0) write(*,*) & + "Finding matches for all possible upper planes." + else + this%axes(2) = 2 + if(verbose.gt.0) write(*,*) "Finding matches for the upper ab plane." + end if + + end subroutine constrain_axes +!############################################################################### + + !############################################################################### subroutine write_structures( & this, directory, prefix & diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index 82cb0f9..75bbd76 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -8,7 +8,7 @@ module shifting use misc_maths, only: get_nth_plane use misc_linalg, only: modu use artemis__geom_rw, only: basis_type,geom_write - use edit_geom, only: split_bas,get_centre_atom,set_vacuum,shifter + use artemis__geom_utils, only: split_bas,get_centre_atom,set_vacuum,shifter use artemis__io_utils use artemis__io_utils_extd, only: err_abort_print_struc use interface_identifier @@ -743,7 +743,7 @@ end function get_descriptive_ab_shifts function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& bulk_DON,bulk_map,lprint,max_bondlength) result(res_shifts) use artemis__sym, only: gldfnd,confine_type - use edit_geom, only: get_bulk,wyck_spec_type,get_wyckoff + use artemis__geom_utils, only: get_bulk,wyck_spec_type,get_wyckoff use interface_identifier, only: gen_single_DON,nstep_default,den_of_neigh_type implicit none integer :: i,j,k,l,is,ia,ja,jb,jc,count1,itmp1 diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 23f6cba..d8e17c0 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -22,7 +22,7 @@ module artemis__sym use artemis__misc, only: sort2D use misc_linalg, only: modu,inverse_3x3,det,gcd,gen_group,cross use artemis__geom_rw, only: basis_type - use edit_geom, only: reducer, primitive_lat + use artemis__geom_utils, only: reducer, primitive_lat implicit none integer :: ierror_sym=0 integer :: s_start=1,s_end=0 diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index d4402e8..fef5052 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -7,7 +7,7 @@ module artemis__terminations use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: modu, cross, uvec, det use artemis__sym, only: sym_type, check_sym, sym_setup, clone_grp, s_end - use edit_geom, only: shifter, transformer, ortho_axis, set_vacuum + use artemis__geom_utils, only: shifter, transformer, ortho_axis, set_vacuum implicit none diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 5c86a27..4eb21e7 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -711,7 +711,7 @@ subroutine f90wrap_artemis_gen_type__set__swap_sigma(this, f90wrap_swap_sigma) this_ptr%p%swap_sigma = f90wrap_swap_sigma end subroutine f90wrap_artemis_gen_type__set__swap_sigma -subroutine f90wrap_artemis_gen_type__get__require_mirr41cf( & +subroutine f90wrap_artemis_gen_type__get__require_mirror_swaps( & this, f90wrap_require_mirror_swaps) use artemis__generator, only: artemis_generator_type implicit none @@ -724,9 +724,9 @@ subroutine f90wrap_artemis_gen_type__get__require_mirr41cf( & this_ptr = transfer(this, this_ptr) f90wrap_require_mirror_swaps = this_ptr%p%require_mirror_swaps -end subroutine f90wrap_artemis_gen_type__get__require_mirr41cf +end subroutine f90wrap_artemis_gen_type__get__require_mirror_swaps -subroutine f90wrap_artemis_gen_type__set__require_mirr3bfa( & +subroutine f90wrap_artemis_gen_type__set__require_mirror_swaps( & this, f90wrap_require_mirror_swaps) use artemis__generator, only: artemis_generator_type implicit none @@ -739,7 +739,7 @@ subroutine f90wrap_artemis_gen_type__set__require_mirr3bfa( & this_ptr = transfer(this, this_ptr) this_ptr%p%require_mirror_swaps = f90wrap_require_mirror_swaps -end subroutine f90wrap_artemis_gen_type__set__require_mirr3bfa +end subroutine f90wrap_artemis_gen_type__set__require_mirror_swaps subroutine f90wrap_artemis_gen_type__get__match_method(this, f90wrap_match_method) use artemis__generator, only: artemis_generator_type @@ -853,7 +853,7 @@ subroutine f90wrap_artemis_gen_type__set__max_num_planes(this, f90wrap_max_num_p this_ptr%p%max_num_planes = f90wrap_max_num_planes end subroutine f90wrap_artemis_gen_type__set__max_num_planes -subroutine f90wrap_artemis_gen_type__get__fix_normal(this, f90wrap_fix_normal) +subroutine f90wrap_artemis_gen_type__get__compensate_normal(this, f90wrap_compensate_normal) use artemis__generator, only: artemis_generator_type implicit none type artemis_generator_type_ptr_type @@ -861,13 +861,13 @@ subroutine f90wrap_artemis_gen_type__get__fix_normal(this, f90wrap_fix_normal) end type artemis_generator_type_ptr_type integer, intent(in) :: this(2) type(artemis_generator_type_ptr_type) :: this_ptr - logical, intent(out) :: f90wrap_fix_normal + logical, intent(out) :: f90wrap_compensate_normal this_ptr = transfer(this, this_ptr) - f90wrap_fix_normal = this_ptr%p%fix_normal -end subroutine f90wrap_artemis_gen_type__get__fix_normal + f90wrap_compensate_normal = this_ptr%p%compensate_normal +end subroutine f90wrap_artemis_gen_type__get__compensate_normal -subroutine f90wrap_artemis_gen_type__set__fix_normal(this, f90wrap_fix_normal) +subroutine f90wrap_artemis_gen_type__set__compensate_normal(this, f90wrap_compensate_normal) use artemis__generator, only: artemis_generator_type implicit none type artemis_generator_type_ptr_type @@ -875,13 +875,13 @@ subroutine f90wrap_artemis_gen_type__set__fix_normal(this, f90wrap_fix_normal) end type artemis_generator_type_ptr_type integer, intent(in) :: this(2) type(artemis_generator_type_ptr_type) :: this_ptr - logical, intent(in) :: f90wrap_fix_normal + logical, intent(in) :: f90wrap_compensate_normal this_ptr = transfer(this, this_ptr) - this_ptr%p%fix_normal = f90wrap_fix_normal -end subroutine f90wrap_artemis_gen_type__set__fix_normal + this_ptr%p%compensate_normal = f90wrap_compensate_normal +end subroutine f90wrap_artemis_gen_type__set__compensate_normal -subroutine f90wrap_artemis_gen_type__get__bondlength_c21a8(this, f90wrap_bondlength_cutoff) +subroutine f90wrap_artemis_gen_type__get__bondlength_cutoff(this, f90wrap_bondlength_cutoff) use artemis__generator, only: artemis_generator_type implicit none type artemis_generator_type_ptr_type @@ -893,9 +893,9 @@ subroutine f90wrap_artemis_gen_type__get__bondlength_c21a8(this, f90wrap_bondlen this_ptr = transfer(this, this_ptr) f90wrap_bondlength_cutoff = this_ptr%p%bondlength_cutoff -end subroutine f90wrap_artemis_gen_type__get__bondlength_c21a8 +end subroutine f90wrap_artemis_gen_type__get__bondlength_cutoff -subroutine f90wrap_artemis_gen_type__set__bondlength_cbd11(this, f90wrap_bondlength_cutoff) +subroutine f90wrap_artemis_gen_type__set__bondlength_cutoff(this, f90wrap_bondlength_cutoff) use artemis__generator, only: artemis_generator_type implicit none type artemis_generator_type_ptr_type @@ -907,9 +907,9 @@ subroutine f90wrap_artemis_gen_type__set__bondlength_cbd11(this, f90wrap_bondlen this_ptr = transfer(this, this_ptr) this_ptr%p%bondlength_cutoff = f90wrap_bondlength_cutoff -end subroutine f90wrap_artemis_gen_type__set__bondlength_cbd11 +end subroutine f90wrap_artemis_gen_type__set__bondlength_cutoff -subroutine f90wrap_artemis_gen_type__array__layer_sepa90a5(this, nd, dtype, dshape, dloc) +subroutine f90wrap_artemis_gen_type__array__layer_separation_cutoff(this, nd, dtype, dshape, dloc) use artemis__generator, only: artemis_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none @@ -928,7 +928,7 @@ subroutine f90wrap_artemis_gen_type__array__layer_sepa90a5(this, nd, dtype, dsha this_ptr = transfer(this, this_ptr) dshape(1:1) = shape(this_ptr%p%layer_separation_cutoff) dloc = loc(this_ptr%p%layer_separation_cutoff) -end subroutine f90wrap_artemis_gen_type__array__layer_sepa90a5 +end subroutine f90wrap_artemis_gen_type__array__layer_separation_cutoff subroutine f90wrap_intf_gen__artemis_gen_type_initialise(this) use artemis__generator, only: artemis_generator_type @@ -985,7 +985,7 @@ subroutine f90wrap_intf_gen__set_tolerance__bindind_agt(this, vector_mismatch, a end subroutine f90wrap_intf_gen__set_tolerance__bindind_agt subroutine f90wrap_intf_gen__set_shift_method__binding_agt(this, method, num_shifts, shifts, & - interface_depth, separation_scale, depth_method, n0) + interface_depth, separation_scale, depth_method, bondlength_cutoff, n0) use artemis__generator, only: artemis_generator_type implicit none @@ -1000,15 +1000,55 @@ subroutine f90wrap_intf_gen__set_shift_method__binding_agt(this, method, num_shi real(4), intent(in), optional :: interface_depth real(4), intent(in), optional :: separation_scale integer, intent(in), optional :: depth_method + real(4), intent(in), optional :: bondlength_cutoff integer :: n0 !f2py intent(hide), depend(shifts) :: n0 = shape(shifts,0) this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_shift_method( & - method=method, num_shifts=num_shifts, & - shifts=shifts, interface_depth=interface_depth, & - separation_scale=separation_scale, depth_method=depth_method) + call this_ptr%p%set_shift_method(method=method, num_shifts=num_shifts, shifts=shifts, interface_depth=interface_depth, & + separation_scale=separation_scale, depth_method=depth_method, bondlength_cutoff=bondlength_cutoff) end subroutine f90wrap_intf_gen__set_shift_method__binding_agt +subroutine f90wrap_intf_gen__set_swap_method__binding_agt(this, method, num_swaps, swap_density, & + swap_depth, swap_sigma, require_mirror_swaps) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in), optional :: method + integer, intent(in), optional :: num_swaps + real(4), intent(in), optional :: swap_density + real(4), intent(in), optional :: swap_depth + real(4), intent(in), optional :: swap_sigma + logical, intent(in), optional :: require_mirror_swaps + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_swap_method(method=method, num_swaps=num_swaps, swap_density=swap_density, swap_depth=swap_depth, & + swap_sigma=swap_sigma, require_mirror_swaps=require_mirror_swaps) +end subroutine f90wrap_intf_gen__set_swap_method__binding_agt + +subroutine f90wrap_intf_gen__set_match_method__binding_agt(this, method, max_num_matches, max_num_terms, & + max_num_planes, compensate_normal) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, intent(in), optional :: method + integer, intent(in), optional :: max_num_matches + integer, intent(in), optional :: max_num_terms + integer, intent(in), optional :: max_num_planes + logical, intent(in), optional :: compensate_normal + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_match_method(method=method, max_num_matches=max_num_matches, max_num_terms=max_num_terms, & + max_num_planes=max_num_planes, compensate_normal=compensate_normal) +end subroutine f90wrap_intf_gen__set_match_method__binding_agt + subroutine f90wrap_intf_gen__set_materials__binding_agt(this, structure_lw, structure_up, & elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) use artemis__generator, only: artemis_generator_type @@ -1024,9 +1064,9 @@ subroutine f90wrap_intf_gen__set_materials__binding_agt(this, structure_lw, stru type(artemis_generator_type_ptr_type) :: this_ptr integer, intent(in), dimension(2) :: this type(basis_type_ptr_type) :: structure_lw_ptr - integer, intent(in), dimension(2) :: structure_lw + integer, intent(in), optional, dimension(2) :: structure_lw type(basis_type_ptr_type) :: structure_up_ptr - integer, intent(in), dimension(2) :: structure_up + integer, intent(in), optional, dimension(2) :: structure_up real(4), intent(in), optional, dimension(n0) :: elastic_constants_lw real(4), intent(in), optional, dimension(n1) :: elastic_constants_up logical, intent(in), optional :: use_pricel_lw @@ -1043,8 +1083,12 @@ subroutine f90wrap_intf_gen__set_materials__binding_agt(this, structure_lw, stru use_pricel_up=use_pricel_up) end subroutine f90wrap_intf_gen__set_materials__binding_agt -subroutine f90wrap_intf_gen__set_surface_properties__binding_agt(this, miller_lw, miller_up, is_layered_lw, & - is_layered_up) +subroutine f90wrap_intf_gen__set_surface_properties__binding_agt( & + this, & + miller_lw, miller_up, & + is_layered_lw, is_layered_up, & + layer_separation_cutoff_lw, layer_separation_cutoff_up, layer_separation_cutoff, & + vacuum_gap, n0) use artemis__generator, only: artemis_generator_type implicit none @@ -1057,9 +1101,20 @@ subroutine f90wrap_intf_gen__set_surface_properties__binding_agt(this, miller_lw integer, dimension(3), intent(in), optional :: miller_up logical, intent(in), optional :: is_layered_lw logical, intent(in), optional :: is_layered_up - this_ptr = transfer(this, this_ptr) - call this_ptr%p%set_surface_properties(miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, & - is_layered_up=is_layered_up) + real(4), intent(in), optional :: layer_separation_cutoff_lw + real(4), intent(in), optional :: layer_separation_cutoff_up + real(4), dimension(n0), intent(in), optional :: layer_separation_cutoff + real(4), intent(in), optional :: vacuum_gap + integer :: n0 + !f2py intent(hide), depend(layer_separation_cutoff) :: n0 = shape(layer_separation_cutoff,0) + this_ptr = transfer(this, this_ptr) + call this_ptr%p%set_surface_properties( & + miller_lw=miller_lw, miller_up=miller_up, & + is_layered_lw=is_layered_lw, is_layered_up=is_layered_up, & + layer_separation_cutoff_lw=layer_separation_cutoff_lw, & + layer_separation_cutoff_up=layer_separation_cutoff_up, & + layer_separation_cutoff=layer_separation_cutoff, & + vacuum_gap=vacuum_gap) end subroutine f90wrap_intf_gen__set_surface_properties__binding_agt subroutine f90wrap_intf_gen__reset_is_layered_lw__binding_agt(this) @@ -1149,7 +1204,7 @@ subroutine f90wrap_intf_gen__get_terminations__binding__agt( & call store_last_generated_structures(local_structures) end subroutine f90wrap_intf_gen__get_terminations__binding__agt -subroutine f90wrap_retrieve_last_generated_structures(num_structures, structures) +subroutine f90wrap_retrieve_last_generated_structures(structures) use artemis__geom_rw, only: basis_type use artemis__structure_cache, only: retrieve_last_generated_structures implicit none @@ -1161,7 +1216,6 @@ subroutine f90wrap_retrieve_last_generated_structures(num_structures, structures type basis_type_xnum_array_ptr_type type(basis_type_xnum_array), pointer :: p => NULL() end type basis_type_xnum_array_ptr_type - integer, intent(in) :: num_structures integer, intent(inout), dimension(2) :: structures type(basis_type_xnum_array_ptr_type) :: structures_ptr @@ -1178,6 +1232,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & this, surface_lw, surface_up, & thickness_lw, thickness_up, & num_layers_lw, num_layers_up, & + reduce_matches, & print_lattice_match_info, print_termination_info, print_shift_info, & break_on_fail, icheck_match, interface_idx, & generate_structures, & @@ -1197,6 +1252,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & real(4), intent(in), optional :: thickness_up integer, intent(in), optional :: num_layers_lw integer, intent(in), optional :: num_layers_up + logical, intent(in), optional :: reduce_matches logical, intent(in), optional :: print_lattice_match_info logical, intent(in), optional :: print_termination_info logical, intent(in), optional :: print_shift_info @@ -1214,6 +1270,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & this_ptr = transfer(this, this_ptr) call this_ptr%p%generate(surface_lw=surface_lw, surface_up=surface_up, thickness_lw=thickness_lw, & thickness_up=thickness_up, num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, & + reduce_matches=reduce_matches, & print_lattice_match_info=print_lattice_match_info, print_termination_info=print_termination_info, & print_shift_info=print_shift_info, break_on_fail=break_on_fail, icheck_match=icheck_match, & interface_idx=interface_idx, generate_structures=generate_structures, seed=seed, verbose=verbose, & @@ -1234,7 +1291,7 @@ subroutine f90wrap_intf_gen__restart__binding__agt(this, basis, interface_locati end type artemis_generator_type_ptr_type type(artemis_generator_type_ptr_type) :: this_ptr integer, intent(in), dimension(2) :: this - type(basis_type_ptr_type) :: basis_ptr + type(basis_type_ptr_type) :: structure_ptr integer, intent(in), dimension(2) :: basis real(4), dimension(2), intent(in), optional :: interface_location logical, intent(in), optional :: print_shift_info @@ -1242,8 +1299,8 @@ subroutine f90wrap_intf_gen__restart__binding__agt(this, basis, interface_locati integer, intent(in), optional :: verbose integer, optional, intent(inout) :: exit_code this_ptr = transfer(this, this_ptr) - basis_ptr = transfer(basis, basis_ptr) - call this_ptr%p%restart(basis=basis_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & + structure_ptr = transfer(basis, structure_ptr) + call this_ptr%p%restart(structure=structure_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & seed=seed, verbose=verbose, exit_code=exit_code) end subroutine f90wrap_intf_gen__restart__binding__agt From 49adda2f671107db7acd6f14fae3faec25464d87 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Sun, 20 Apr 2025 16:17:06 +0100 Subject: [PATCH 069/137] Add interface location identifier procedure --- src/artemis/artemis.py | 57 ++++++++++++++--- src/fortran/artemis.f90 | 1 + src/fortran/lib/mod_generator.f90 | 82 +++++++++++++++++++------ src/fortran/lib/mod_geom_utils.f90 | 26 ++++---- src/fortran/lib/mod_intf_identifier.f90 | 43 ++++++++----- src/fortran/lib/mod_shifting.f90 | 8 ++- src/wrapper/f90wrap_mod_generator.f90 | 73 ++++++++++++++++------ 7 files changed, 210 insertions(+), 80 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index fd47a1e..e66e251 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -641,7 +641,19 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ bondlength_cutoff : float """ - _artemis.f90wrap_intf_gen__set_shift_method__binding_agt(this=self._handle, \ + + if shifts is not None: + # if shifts is a scalar, convert it to a 2D array, fortran order + if isinstance(shifts, float) or isinstance(shifts, int): + shifts = numpy.array([[shifts]], order='F') + # if shifts is a 1D array, convert it to a 2D array, fortran order + elif len(shifts.shape) == 1: + shifts = numpy.array([shifts], order='F') + # if shifts is a 2D array, convert it to a 2D array, fortran order + elif len(shifts.shape) == 2: + shifts = numpy.array(shifts, order='F') + + _artemis.f90wrap_intf_gen__set_shift_method__binding__agt(this=self._handle, \ method=method, num_shifts=num_shifts, shifts=shifts, \ interface_depth=interface_depth, separation_scale=separation_scale, \ depth_method=depth_method, bondlength_cutoff=bondlength_cutoff) @@ -668,7 +680,7 @@ def set_swap_method(self, method=None, num_swaps=None, swap_density=None, \ require_mirror_swaps : bool """ - _artemis.f90wrap_intf_gen__set_swap_method__binding_agt(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_swap_method__binding__agt(this=self._handle, \ method=method, num_swaps=num_swaps, swap_density=swap_density, \ swap_depth=swap_depth, swap_sigma=swap_sigma, \ require_mirror_swaps=require_mirror_swaps) @@ -694,7 +706,7 @@ def set_match_method(self, method=None, max_num_matches=None, \ compensate_normal : bool """ - _artemis.f90wrap_intf_gen__set_match_method__binding_agt(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_match_method__binding__agt(this=self._handle, \ method=method, max_num_matches=max_num_matches, max_num_terms=max_num_terms, \ max_num_planes=max_num_planes, compensate_normal=compensate_normal) @@ -732,7 +744,7 @@ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ if isinstance(structure_up, Atoms): structure_up = geom_rw.basis(atoms=structure_up) - _artemis.f90wrap_intf_gen__set_materials__binding_agt(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_materials__binding__agt(this=self._handle, \ structure_lw=structure_lw._handle, structure_up=structure_up._handle, \ elastic_constants_lw=elastic_constants_lw, \ elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, \ @@ -765,7 +777,7 @@ def set_surface_properties(self, miller_lw=None, miller_up=None, \ vacuum_gap : float """ - _artemis.f90wrap_intf_gen__set_surface_properties__binding_agt(this=self._handle, \ + _artemis.f90wrap_intf_gen__set_surface_properties__binding__agt(this=self._handle, \ miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, \ is_layered_up=is_layered_up, \ layer_separation_cutoff_lw=layer_separation_cutoff_lw, \ @@ -786,7 +798,7 @@ def reset_is_layered_lw(self): this : Artemis_generator_Type """ - _artemis.f90wrap_intf_gen__reset_is_layered_lw__binding_agt(this=self._handle) + _artemis.f90wrap_intf_gen__reset_is_layered_lw__binding__agt(this=self._handle) def reset_is_layered_up(self): """ @@ -802,7 +814,7 @@ def reset_is_layered_up(self): this : Artemis_generator_Type """ - _artemis.f90wrap_intf_gen__reset_is_layered_up__binding_agt(this=self._handle) + _artemis.f90wrap_intf_gen__reset_is_layered_up__binding__agt(this=self._handle) def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ thickness=None, orthogonalise=None, normalise=None, break_on_fail=None, @@ -872,6 +884,29 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ return structures, exit_code return structures + def get_interface_location(self, structure=None, axis=None): + + """ + get_interface_location__binding__artemis_gen_type(self, structure, axis) + + + Defined at \ + ../src/fortran/lib/mod_intf_generator.f90 \ + lines 1112-1124 + + Parameters + ---------- + this : Artemis_generator_Type + structure : Basis_Type + axis : int + + """ + if isinstance(structure, Atoms): + structure = geom_rw.basis(atoms=structure) + + return _artemis.f90wrap_intf_gen__get_interface_location__binding__agt(this=self._handle, \ + structure=structure._handle, axis=axis) + def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ thickness_up=None, num_layers_lw=None, num_layers_up=None, \ reduce_matches=None, \ @@ -935,7 +970,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ return structures, exit_code return structures - def restart(self, basis, interface_location=None, print_shift_info=None, \ + def restart(self, structure, interface_location=None, print_shift_info=None, \ seed=None, verbose=None, return_exit_code=False, calc=None): """ restart__binding__artemis_gen_type(self, basis[, \ @@ -961,8 +996,12 @@ def restart(self, basis, interface_location=None, print_shift_info=None, \ exit_code = 0 structures = None + # check if host is ase.Atoms object or a Fortran derived type basis_type + if isinstance(structure, Atoms): + structure = geom_rw.basis(atoms=structure) + exit_code = _artemis.f90wrap_intf_gen__restart__binding__agt(this=self._handle, \ - basis=basis._handle, interface_location=interface_location, \ + structure=structure._handle, interface_location=interface_location, \ print_shift_info=print_shift_info, seed=seed, verbose=verbose) if ( exit_code != 0 and exit_code != None ) and not return_exit_code: diff --git a/src/fortran/artemis.f90 b/src/fortran/artemis.f90 index e3a6fdd..9758949 100644 --- a/src/fortran/artemis.f90 +++ b/src/fortran/artemis.f90 @@ -4,6 +4,7 @@ module artemis use artemis__structure_cache, only: & store_last_generated_structures, & retrieve_last_generated_structures + use artemis__interface_identifier, only: intf_info_type use artemis__generator, only: artemis_generator_type implicit none diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 7de7b6e..f043bdc 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -13,7 +13,7 @@ module artemis__generator use artemis__io_utils, only: err_abort, print_warning, stop_program use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: uvec,modu,get_area,inverse,cross - use interface_identifier, only: intf_info_type,& + use artemis__interface_identifier, only: intf_info_type,& get_interface,get_layered_axis,gen_DON use artemis__geom_utils, only: planecutter,primitive_lat,ortho_axis,& shift_region,set_vacuum,transformer,shifter,reducer,& @@ -129,10 +129,12 @@ module artemis__generator procedure, pass(this) :: get_terminations !! Return the terminations for structure + procedure, pass(this) :: get_interface_location + !! Get the interface location for the given structure procedure, pass(this) :: generate => generate_interfaces !! Generate interfaces from two bulk structures - procedure, pass(this) :: restart => generate_intefaces_from_existing + procedure, pass(this) :: restart => generate_interfaces_from_existing !! Generate interfaces from existing bulk structures procedure, pass(this) :: generate_perturbations => generate_shifts_and_swaps !! Generate perturbations for the given basis @@ -253,26 +255,32 @@ subroutine set_shift_method( & this%shifts = reshape(shifts, [ size(shifts,dim=1)/3,3 ]) else write(err_msg,'(A,I0,A)') & - "ERROR: The shifts vector has ", size(shifts, dim=1), & + "The shifts vector has ", size(shifts, dim=1), & " components. It should have 1 or 3." - call err_abort(trim(err_msg),fmtd=.true.) + call stop_program(trim(err_msg)) + return end if end select rank(2) - if(size(shifts,dim=2).eq.3) then + select case(size(shifts,dim=2)) + case(1) + allocate(this%shifts(size(shifts,1),3)) + this%shifts(:,3) = shifts(:,1) + case(3) allocate(this%shifts(size(shifts,1),3)) this%shifts = shifts - else + case default write(err_msg,'(A,I0,A)') & - "ERROR: The shifts vector has ", size(shifts, dim=1), & - " components. It should have 3." - call err_abort(trim(err_msg),fmtd=.true.) - end if + "The shifts argument was improperly defined." + call stop_program(trim(err_msg)) + return + end select rank default write(err_msg,'(A,I0,A)') & - "ERROR: The shifts vector has ", size(shifts, dim=1), & + "The shifts vector has ", size(shifts, dim=1), & " components. It should have 1, 2, or 3." - call err_abort(trim(err_msg),fmtd=.true.) + call stop_program(trim(err_msg)) + return end select else if(allocated(this%shifts)) deallocate(this%shifts) @@ -810,7 +818,43 @@ end function get_terminations !############################################################################### - subroutine generate_intefaces_from_existing( & + function get_interface_location( & + this, structure, axis, verbose, exit_code & + ) result(output) + !! Get the interface location for the given structure + implicit none + + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type + type(basis_type), intent(in) :: structure + !! Atomic structure data + integer, intent(in), optional :: axis + !! Axis for the interface + integer, intent(in), optional :: verbose + !! Verbosity level + integer, intent(out), optional :: exit_code + !! Exit code for the program + + type(intf_info_type) :: output + !! Output interface location + + ! Local variables + integer :: axis_ + !! Axis for the interface + + + axis_ = 0 + if(present(axis)) axis_ = axis + + output = get_interface(structure, axis_) + + end function get_interface_location +!############################################################################### + + +!############################################################################### + subroutine generate_interfaces_from_existing( & this, structure, interface_location, & print_shift_info, seed, verbose, exit_code & ) @@ -894,7 +938,7 @@ subroutine generate_intefaces_from_existing( & intf%axis = this%axis intf%loc = interface_location else - intf=get_interface(structure%lat,structure,this%axis) + intf=get_interface(structure,this%axis) intf%loc=intf%loc/modu(structure%lat(intf%axis,:)) if(verbose_.gt.0) write(*,*) "interface axis:",intf%axis if(verbose_.gt.0) write(*,*) "interface loc:",intf%loc @@ -943,7 +987,7 @@ subroutine generate_intefaces_from_existing( & if(present(exit_code)) exit_code = exit_code_ - end subroutine generate_intefaces_from_existing + end subroutine generate_interfaces_from_existing !############################################################################### @@ -1967,20 +2011,20 @@ subroutine generate_shifts_and_swaps( & end do end select if(this%shift_method.gt.0)then - output_shifts(:,this%axis) = output_shifts(:,this%axis)*modu(basis%lat(this%axis,:)) + output_shifts(:,this%axis) = output_shifts(:,this%axis) * modu(basis%lat(this%axis,:)) end if !!!----------------------------------------------------------------------------- !!! Prints number of shifts to terminal !!!----------------------------------------------------------------------------- - if(verbose.gt.0) write(*,'(3X,"Number of unique shifts structures: ",I0)') this%num_shifts + if(verbose.gt.0) write(*,'(3X,"Number of unique shifts structures: ",I0)') size(output_shifts,1) !!!----------------------------------------------------------------------------- !!! Determines number of swaps across the interface !!!----------------------------------------------------------------------------- - nswaps_per_cell=nint(this%swap_density*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) + nswaps_per_cell = nint(this%swap_density*get_area([basis%lat(abc(1),:)],[basis%lat(abc(2),:)])) if(this%swap_method.ne.0)then if(verbose.gt.0) write(*,& '(" Generating ",I0," swaps per structure ")') nswaps_per_cell @@ -1990,7 +2034,7 @@ subroutine generate_shifts_and_swaps( & !!!----------------------------------------------------------------------------- !!! Prints each unique shift structure !!!----------------------------------------------------------------------------- - shift_loop: do k=1,this%num_shifts + shift_loop: do k = 1, size(output_shifts,1), 1 call tbas%copy(basis) toffset=output_shifts(k,:3) do iaxis=1,2 diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 40f2a9e..5a9a743 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -677,7 +677,7 @@ subroutine transformer(basis, tfmat, map) vol_inc = abs(det(basis%lat)) if(vol_inc.lt.0.5_real32)then write(0,'(1X,"ERROR: Internal error in transformer function")') - write(0,'(2X,"transformer in mod_edit_geom.f90 been supplied a& + write(0,'(2X,"transformer in mod_geom_utils.f90 been supplied a& & lattice with almost zero determinant")') write(0,'(2X,"determinant = ",F0.9)') vol_inc write(0,'(3(1X,F7.2))') basis%lat @@ -724,7 +724,7 @@ subroutine transformer(basis, tfmat, map) end do if(vol_inc.lt.minval(tolvec))then write(0,'(1X,"ERROR: Internal error in transformer function")') - write(0,'(2X,"transformer in mod_edit_geom.f90 been supplied a& + write(0,'(2X,"transformer in mod_geom_utils.f90 been supplied a& & transformation matrix with almost zero determinant")') write(0,'(2X,"determinant = ",F0.9)') vol_inc write(0,'(3(1X,F7.2))') tfmat @@ -852,7 +852,7 @@ subroutine transformer(basis, tfmat, map) if(all(abs(tfmat-nint(tfmat)).lt.tol))then if(nint(basis%natom*vol_inc).ne.sbas%natom)then write(0,'(1X,"ERROR: Internal error in transformer function")') - write(0,'(2X,"Transformer in mod_edit_geom.f90 has failed to & + write(0,'(2X,"Transformer in mod_geom_utils.f90 has failed to & &generate enough atoms when extending the cell")') write(0,'(2X,"Generated ",I0," atoms, whilst expecting ",I0," atoms")') & sbas%natom,nint(basis%natom*vol_inc) @@ -1438,7 +1438,7 @@ function planecutter(lat, plane) result(tfmat) !!!----------------------------------------------------------------------------- if(dot_product(b(1,:),b(3,:)).gt.tol)then write(0,'("ERROR: Internatl error in planecutter")') - write(0,'(2X,"Error in planecutter subroutine in mod_edit_geom.f90")') + write(0,'(2X,"Error in planecutter subroutine in mod_geom_utils.f90")') write(0,'(2X,"b1 not perpendicular to b3")') write(0,'(2X,"b1 = ",3(1X,F0.3))') b(1,:) write(0,'(2X,"b3 = ",3(1X,F0.3))') b(3,:) @@ -1448,7 +1448,7 @@ function planecutter(lat, plane) result(tfmat) stop elseif(dot_product(b(2,:),b(3,:)).gt.tol)then write(0,'("ERROR: Internatl error in planecutter")') - write(0,'(2X,"Error in planecutter subroutine in mod_edit_geom.f90")') + write(0,'(2X,"Error in planecutter subroutine in mod_geom_utils.f90")') write(0,'(2X,"b2 not perpendicular to b3")') write(0,'(2X,"b2 = ",3(1X,F6.2))') b(2,:) write(0,'(2X,"b3 = ",3(1X,F6.2))') b(3,:) @@ -1458,7 +1458,7 @@ function planecutter(lat, plane) result(tfmat) stop elseif(dot_product(b(1,:),b(1,:)).lt.tol)then write(0,'("ERROR: Internatl error in planecutter")') - write(0,'(2X,"Error in planecutter subroutine in mod_edit_geom.f90")') + write(0,'(2X,"Error in planecutter subroutine in mod_geom_utils.f90")') write(0,'(2X,"b1 has zero size")') write(0,'(2X,"b1 = ",3(1X,F6.2))') b(1,:) write(0,'("Inform developers of this issue")') @@ -1466,7 +1466,7 @@ function planecutter(lat, plane) result(tfmat) stop elseif(dot_product(b(2,:),b(2,:)).lt.tol)then write(0,'("ERROR: Internatl error in planecutter")') - write(0,'(2X,"Error in planecutter subroutine in mod_edit_geom.f90")') + write(0,'(2X,"Error in planecutter subroutine in mod_geom_utils.f90")') write(0,'(2X,"b2 has zero size")') write(0,'(2X,"b2 = ",3(1X,F6.2))') b(2,:) write(0,'("Inform developers of this issue")') @@ -1507,7 +1507,7 @@ function planecutter(lat, plane) result(tfmat) write(0,'("row ",I0," of the following matrix")') i write(0,'(3(2X,F9.3))') (b(j,:),j=1,3) write(0,'(1X,"ERROR: Internal error in planecutter function")') - write(0,'(2X,"Planecutter in mod_edit_geom.f90 is unable to find a& + write(0,'(2X,"Planecutter in mod_geom_utils.f90 is unable to find a& & perpendicular plane")') b=0._real32 exit @@ -1520,7 +1520,7 @@ function planecutter(lat, plane) result(tfmat) end if if(abs(det(b)).lt.tol)then write(0,'(1X,"ERROR: Internal error in planecutter function")') - write(0,'(2X,"Planecutter in mod_edit_geom.f90 has generated a 0& + write(0,'(2X,"Planecutter in mod_geom_utils.f90 has generated a 0& & determinant matrix")') write(0,'(3(2X,F9.3))') (b(j,:),j=1,3) b=0._real32 @@ -1947,7 +1947,7 @@ subroutine get_bulk(lat,bas,axis,bulk_lat,bulk_bas) minspecloc = minloc(bas%spec(:)%num,mask=bas%spec(:)%num.ne.0,dim=1) if(bas%spec(minspecloc)%num.eq.1)then write(0,'("ERROR: Internal error in get_bulk")') - write(0,'(2X,"get_bulk subroutine in mod_edit_geom.f90 unable cannot & + write(0,'(2X,"get_bulk subroutine in mod_geom_utils.f90 unable cannot & &find enough atoms to reproduce a bulk from")') stop end if @@ -2238,7 +2238,7 @@ function get_wyckoff(bas,axis) result(wyckoff) end where if(all(.not.atom_mask))then write(0,'("ERROR: Internal error in get_wyckoff")') - write(0,'(2X,"Error in subroutine get_wyckoff in mod_edit_geom.f90")') + write(0,'(2X,"Error in subroutine get_wyckoff in mod_geom_utils.f90")') write(0,'(2X,"No bulk found")') write(0,'(2X,"Exiting subroutine...")') return @@ -2265,7 +2265,7 @@ function get_wyckoff(bas,axis) result(wyckoff) !if(lw_loc.eq.up_loc) up_loc = up_loc + 1.E-8_real32 !! IS THIS NEEDED? if(lw_loc.gt.up_loc)then write(0,'("ERROR: Internal error in get_wyckoff")') - write(0,'(2X,"Error in subroutine get_wyckoff in mod_edit_geom.f90")') + write(0,'(2X,"Error in subroutine get_wyckoff in mod_geom_utils.f90")') write(0,'(2X,"Region size is negative")') write(0,'(2X,"Stopping...")') stop @@ -2387,7 +2387,7 @@ function get_wyckoff(bas,axis) result(wyckoff) if(any(wyckoff%spec(is)%atom(:).eq.0))then write(0,'("ERROR: Internal error in get_wyckoff")') - write(0,'(2X,"Error in subroutine get_wyckoff in mod_edit_geom.f90")') + write(0,'(2X,"Error in subroutine get_wyckoff in mod_geom_utils.f90")') write(0,'(2X,"Not all wyckoff atoms found")') do ia=1,bas%spec(is)%num write(0,*) is,ia,wyckoff%spec(is)%atom(ia) diff --git a/src/fortran/lib/mod_intf_identifier.f90 b/src/fortran/lib/mod_intf_identifier.f90 index cc9fab2..b073f0b 100644 --- a/src/fortran/lib/mod_intf_identifier.f90 +++ b/src/fortran/lib/mod_intf_identifier.f90 @@ -3,7 +3,7 @@ !!! Code part of the ARTEMIS group (Hepplestone research group). !!! Think Hepplestone, think HRG. !!!############################################################################# -module interface_identifier +module artemis__interface_identifier use artemis__constants, only: real32 use artemis__misc, only: swap,sort1D use misc_linalg, only: modu,simeq,get_area,uvec @@ -44,33 +44,31 @@ module interface_identifier !!!############################################################################# !!! gets the interface location using CAD method !!!############################################################################# - function get_interface(lat,bas,axis) result(intf) + function get_interface(basis, axis) result(intf) implicit none + type(basis_type), intent(in) :: basis integer :: nstep real(real32) :: dist_max - type(basis_type) :: bas type(intf_info_type) :: intf - real(real32), dimension(3,3) :: lat type(den_of_spec_type), allocatable, dimension(:) :: DOS integer, optional, intent(in) :: axis - dist_max=12.0 - DOS=gen_DOS(lat,bas,dist_max) - nstep=size(DOS(1)%atom(1,1,:)) + dist_max = 12._real32 + DOS = gen_DOS(basis%lat,basis,dist_max) + nstep = size(DOS(1)%atom(1,1,:)) - if(present(axis))then - intf%axis=axis - else - intf%axis=get_intf_axis_DOS(DOS,lat,bas,dist_max) + intf%axis = 0 + if(present(axis)) intf%axis = axis + if(intf%axis.eq.0)then + intf%axis = get_intf_axis_DOS(DOS, basis%lat, basis, dist_max) end if - intf%loc=get_intf_CAD(lat,bas,intf%axis,nstep) + intf%loc=get_intf_CAD(basis%lat, basis, intf%axis, nstep) if(intf%loc(1).gt.intf%loc(2)) call swap(intf%loc(1),intf%loc(2)) - end function get_interface !!!############################################################################# @@ -741,6 +739,7 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) real(real32), allocatable, dimension(:,:) :: CAD,deriv real(real32), allocatable, dimension(:,:,:) :: CADD logical, optional :: lprint + real(real32) :: diff !!!----------------------------------------------------------------------------- @@ -853,10 +852,20 @@ function get_intf_CAD(lat,bas,axis,num_step,lprint) result(intf_loc) !!! finds the turning points of the multiCADD and attributes them to ... !!! ... the two interfaces !!!----------------------------------------------------------------------------- - ivec1=get_turn_points([multiCADD(:)],window=8,lperiodic=.true.) - intf_loc(1)=dist(ivec1(size(ivec1))) - intf_loc(2)=dist(ivec1(size(ivec1)-1)) + ivec1 = get_turn_points([multiCADD(:)],window=8,lperiodic=.true.) + intf_loc(1)=dist(ivec1(size(ivec1))) + do i = size(ivec1) - 1, 1, -1 + diff = abs(intf_loc(1)-dist(ivec1(i))) + ! map back into the original space if greater than the size of the cell + if(abs(diff).gt.0.5*modu(lat(axis,:)))then + diff = diff - sign(1._real32,diff) * modu(lat(axis,:)) + end if + if(abs(diff).gt.2._real32)then + intf_loc(2)=dist(ivec1(i)) + exit + end if + end do end function get_intf_CAD @@ -1127,4 +1136,4 @@ end function gen_single_DON !!!############################################################################# -end module interface_identifier +end module artemis__interface_identifier diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index 75bbd76..6d74879 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -11,7 +11,7 @@ module shifting use artemis__geom_utils, only: split_bas,get_centre_atom,set_vacuum,shifter use artemis__io_utils use artemis__io_utils_extd, only: err_abort_print_struc - use interface_identifier + use artemis__interface_identifier implicit none real(real32) :: f_scale = 0.5_real32 @@ -744,7 +744,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& bulk_DON,bulk_map,lprint,max_bondlength) result(res_shifts) use artemis__sym, only: gldfnd,confine_type use artemis__geom_utils, only: get_bulk,wyck_spec_type,get_wyckoff - use interface_identifier, only: gen_single_DON,nstep_default,den_of_neigh_type + use artemis__interface_identifier, only: gen_single_DON,nstep_default,den_of_neigh_type implicit none integer :: i,j,k,l,is,ia,ja,jb,jc,count1,itmp1 integer :: ntrans,iatom,nneigh,ncheck @@ -871,8 +871,10 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& do i=1,2 wyckoff(i)=get_wyckoff(splitbas(i),axis) if(.not.allocated(wyckoff(i)%spec))then - write(*,'(1X,"Using centre atoms as bulk representation")') + write(*,'(1X,"Using centre atoms as bulk representation for parent slab", I0)') i lwyckoff(i)=.false. + else + write(*,'(1X,"Using Wyckoff atoms as bulk representation for parent slab", I0)') i end if end do else diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 4eb21e7..197bc2d 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -984,8 +984,8 @@ subroutine f90wrap_intf_gen__set_tolerance__bindind_agt(this, vector_mismatch, a angle_weight=angle_weight, area_weight=area_weight) end subroutine f90wrap_intf_gen__set_tolerance__bindind_agt -subroutine f90wrap_intf_gen__set_shift_method__binding_agt(this, method, num_shifts, shifts, & - interface_depth, separation_scale, depth_method, bondlength_cutoff, n0) +subroutine f90wrap_intf_gen__set_shift_method__binding__agt(this, method, num_shifts, shifts, & + interface_depth, separation_scale, depth_method, bondlength_cutoff, n0, n1) use artemis__generator, only: artemis_generator_type implicit none @@ -996,19 +996,21 @@ subroutine f90wrap_intf_gen__set_shift_method__binding_agt(this, method, num_shi integer, intent(in), dimension(2) :: this integer, intent(in), optional :: method integer, intent(in), optional :: num_shifts - real(4), dimension(n0), intent(in), optional :: shifts + real(4), dimension(n0,n1), intent(in), optional :: shifts real(4), intent(in), optional :: interface_depth real(4), intent(in), optional :: separation_scale integer, intent(in), optional :: depth_method real(4), intent(in), optional :: bondlength_cutoff integer :: n0 !f2py intent(hide), depend(shifts) :: n0 = shape(shifts,0) + integer :: n1 + !f2py intent(hide), depend(shifts) :: n1 = shape(shifts,1) this_ptr = transfer(this, this_ptr) call this_ptr%p%set_shift_method(method=method, num_shifts=num_shifts, shifts=shifts, interface_depth=interface_depth, & separation_scale=separation_scale, depth_method=depth_method, bondlength_cutoff=bondlength_cutoff) -end subroutine f90wrap_intf_gen__set_shift_method__binding_agt +end subroutine f90wrap_intf_gen__set_shift_method__binding__agt -subroutine f90wrap_intf_gen__set_swap_method__binding_agt(this, method, num_swaps, swap_density, & +subroutine f90wrap_intf_gen__set_swap_method__binding__agt(this, method, num_swaps, swap_density, & swap_depth, swap_sigma, require_mirror_swaps) use artemis__generator, only: artemis_generator_type implicit none @@ -1027,9 +1029,9 @@ subroutine f90wrap_intf_gen__set_swap_method__binding_agt(this, method, num_swap this_ptr = transfer(this, this_ptr) call this_ptr%p%set_swap_method(method=method, num_swaps=num_swaps, swap_density=swap_density, swap_depth=swap_depth, & swap_sigma=swap_sigma, require_mirror_swaps=require_mirror_swaps) -end subroutine f90wrap_intf_gen__set_swap_method__binding_agt +end subroutine f90wrap_intf_gen__set_swap_method__binding__agt -subroutine f90wrap_intf_gen__set_match_method__binding_agt(this, method, max_num_matches, max_num_terms, & +subroutine f90wrap_intf_gen__set_match_method__binding__agt(this, method, max_num_matches, max_num_terms, & max_num_planes, compensate_normal) use artemis__generator, only: artemis_generator_type implicit none @@ -1047,9 +1049,9 @@ subroutine f90wrap_intf_gen__set_match_method__binding_agt(this, method, max_num this_ptr = transfer(this, this_ptr) call this_ptr%p%set_match_method(method=method, max_num_matches=max_num_matches, max_num_terms=max_num_terms, & max_num_planes=max_num_planes, compensate_normal=compensate_normal) -end subroutine f90wrap_intf_gen__set_match_method__binding_agt +end subroutine f90wrap_intf_gen__set_match_method__binding__agt -subroutine f90wrap_intf_gen__set_materials__binding_agt(this, structure_lw, structure_up, & +subroutine f90wrap_intf_gen__set_materials__binding__agt(this, structure_lw, structure_up, & elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) use artemis__generator, only: artemis_generator_type use artemis__geom_rw, only: basis_type @@ -1081,9 +1083,9 @@ subroutine f90wrap_intf_gen__set_materials__binding_agt(this, structure_lw, stru call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & use_pricel_up=use_pricel_up) -end subroutine f90wrap_intf_gen__set_materials__binding_agt +end subroutine f90wrap_intf_gen__set_materials__binding__agt -subroutine f90wrap_intf_gen__set_surface_properties__binding_agt( & +subroutine f90wrap_intf_gen__set_surface_properties__binding__agt( & this, & miller_lw, miller_up, & is_layered_lw, is_layered_up, & @@ -1115,9 +1117,9 @@ subroutine f90wrap_intf_gen__set_surface_properties__binding_agt( & layer_separation_cutoff_up=layer_separation_cutoff_up, & layer_separation_cutoff=layer_separation_cutoff, & vacuum_gap=vacuum_gap) -end subroutine f90wrap_intf_gen__set_surface_properties__binding_agt +end subroutine f90wrap_intf_gen__set_surface_properties__binding__agt -subroutine f90wrap_intf_gen__reset_is_layered_lw__binding_agt(this) +subroutine f90wrap_intf_gen__reset_is_layered_lw__binding__agt(this) use artemis__generator, only: artemis_generator_type implicit none @@ -1128,9 +1130,9 @@ subroutine f90wrap_intf_gen__reset_is_layered_lw__binding_agt(this) integer, intent(in), dimension(2) :: this this_ptr = transfer(this, this_ptr) call this_ptr%p%reset_is_layered_lw() -end subroutine f90wrap_intf_gen__reset_is_layered_lw__binding_agt +end subroutine f90wrap_intf_gen__reset_is_layered_lw__binding__agt -subroutine f90wrap_intf_gen__reset_is_layered_up__binding_agt(this) +subroutine f90wrap_intf_gen__reset_is_layered_up__binding__agt(this) use artemis__generator, only: artemis_generator_type implicit none @@ -1141,7 +1143,7 @@ subroutine f90wrap_intf_gen__reset_is_layered_up__binding_agt(this) integer, intent(in), dimension(2) :: this this_ptr = transfer(this, this_ptr) call this_ptr%p%reset_is_layered_up() -end subroutine f90wrap_intf_gen__reset_is_layered_up__binding_agt +end subroutine f90wrap_intf_gen__reset_is_layered_up__binding__agt @@ -1204,6 +1206,39 @@ subroutine f90wrap_intf_gen__get_terminations__binding__agt( & call store_last_generated_structures(local_structures) end subroutine f90wrap_intf_gen__get_terminations__binding__agt +subroutine f90wrap_intf_gen__get_interface_location__binding__agt( & + this, structure, axis, & + ret_location, ret_axis) + use artemis__geom_rw, only: basis_type + use artemis__generator, only: artemis_generator_type + use artemis__interface_identifier, only: intf_info_type + implicit none + + type basis_type_ptr_type + type(basis_type), pointer :: p => NULL() + end type basis_type_ptr_type + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(basis_type_ptr_type) :: structure_ptr + integer, intent(in), optional, dimension(2) :: structure + integer, intent(in), optional :: axis + integer, intent(out) :: ret_axis + real(4), dimension(2), intent(out) :: ret_location + type(intf_info_type) :: intf_info + + this_ptr = transfer(this, this_ptr) + structure_ptr = transfer(structure, structure_ptr) + intf_info = this_ptr%p%get_interface_location(structure=structure_ptr%p, axis=axis) + + ret_location = intf_info%loc + ret_axis = intf_info%axis +end subroutine f90wrap_intf_gen__get_interface_location__binding__agt + + + subroutine f90wrap_retrieve_last_generated_structures(structures) use artemis__geom_rw, only: basis_type use artemis__structure_cache, only: retrieve_last_generated_structures @@ -1277,7 +1312,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & exit_code=exit_code) end subroutine f90wrap_intf_gen__generate__binding__agt -subroutine f90wrap_intf_gen__restart__binding__agt(this, basis, interface_location, & +subroutine f90wrap_intf_gen__restart__binding__agt(this, structure, interface_location, & print_shift_info, seed, verbose, exit_code) use artemis__generator, only: artemis_generator_type use artemis__geom_rw, only: basis_type @@ -1292,14 +1327,14 @@ subroutine f90wrap_intf_gen__restart__binding__agt(this, basis, interface_locati type(artemis_generator_type_ptr_type) :: this_ptr integer, intent(in), dimension(2) :: this type(basis_type_ptr_type) :: structure_ptr - integer, intent(in), dimension(2) :: basis + integer, intent(in), dimension(2) :: structure real(4), dimension(2), intent(in), optional :: interface_location logical, intent(in), optional :: print_shift_info integer, intent(in), optional :: seed integer, intent(in), optional :: verbose integer, optional, intent(inout) :: exit_code this_ptr = transfer(this, this_ptr) - structure_ptr = transfer(basis, structure_ptr) + structure_ptr = transfer(structure, structure_ptr) call this_ptr%p%restart(structure=structure_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & seed=seed, verbose=verbose, exit_code=exit_code) end subroutine f90wrap_intf_gen__restart__binding__agt From f4530f0c81aa18105d02ba3eff90f460a5b0980f Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Mon, 21 Apr 2025 09:05:42 +0100 Subject: [PATCH 070/137] Improve output --- src/artemis/artemis.py | 28 +++++++++++++++++++++------- src/fortran/lib/mod_geom_utils.f90 | 11 +++-------- 2 files changed, 24 insertions(+), 15 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index e66e251..522b8bc 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -894,18 +894,32 @@ def get_interface_location(self, structure=None, axis=None): ../src/fortran/lib/mod_intf_generator.f90 \ lines 1112-1124 - Parameters - ---------- - this : Artemis_generator_Type - structure : Basis_Type - axis : int - + Parameters: + this : Artemis_generator_Type + structure : Basis_Type + axis : int + + Returns: + location : list of floats + The location of the interface in the structure (in Å). + axis : int + The axis of the interface. """ if isinstance(structure, Atoms): structure = geom_rw.basis(atoms=structure) - return _artemis.f90wrap_intf_gen__get_interface_location__binding__agt(this=self._handle, \ + ret_location, ret_axis = _artemis.f90wrap_intf_gen__get_interface_location__binding__agt(this=self._handle, \ structure=structure._handle, axis=axis) + + if ret_axis != axis and axis is not None: + raise RuntimeError(f"Interface location generation failed (axis {ret_axis} != {axis})") + + # convert the location from numpy array to list + if isinstance(ret_location, numpy.ndarray): + ret_location = ret_location.tolist() + + return ret_location, ret_axis + def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ thickness_up=None, num_layers_lw=None, num_layers_up=None, \ diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 5a9a743..17bac29 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -61,8 +61,6 @@ module artemis__geom_utils end interface get_closest_atom -!!!updated 2023/02/16 - contains @@ -71,8 +69,8 @@ function compare_stoichiometry(basis1, basis2) result(output) !! Check if two basis structures have the same stoichiometry ratio !! !! This function compares the stoichiometry ratios of two basis structures - !! It returns true if the relative proportions of all atomic species are identical - !! and all species names match between both structures + !! It returns true if the relative proportions of all atomic species are + !! identical and all species names match between both structures implicit none type(basis_type), intent(in) :: basis1, basis2 logical :: output @@ -129,10 +127,7 @@ function compare_stoichiometry(basis1, basis2) result(output) end do end function compare_stoichiometry - - - - +!############################################################################### !!!############################################################################# From 99b89586068a9a953bdd819aff2492453d11e0db Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Mon, 21 Apr 2025 09:12:07 +0100 Subject: [PATCH 071/137] Handle output units for interface location --- src/artemis/artemis.py | 7 +++++-- src/fortran/lib/mod_generator.f90 | 13 +++++++++++-- src/wrapper/f90wrap_mod_generator.f90 | 9 +++++++-- 3 files changed, 23 insertions(+), 6 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 522b8bc..ed8f27a 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -884,7 +884,7 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ return structures, exit_code return structures - def get_interface_location(self, structure=None, axis=None): + def get_interface_location(self, structure=None, axis=None, return_fractional=True): """ get_interface_location__binding__artemis_gen_type(self, structure, axis) @@ -898,6 +898,9 @@ def get_interface_location(self, structure=None, axis=None): this : Artemis_generator_Type structure : Basis_Type axis : int + return_fractional : bool + If True, return the location in fractional coordinates. + If False, return the location in angstroms. Returns: location : list of floats @@ -909,7 +912,7 @@ def get_interface_location(self, structure=None, axis=None): structure = geom_rw.basis(atoms=structure) ret_location, ret_axis = _artemis.f90wrap_intf_gen__get_interface_location__binding__agt(this=self._handle, \ - structure=structure._handle, axis=axis) + structure=structure._handle, axis=axis, return_fractional=return_fractional) if ret_axis != axis and axis is not None: raise RuntimeError(f"Interface location generation failed (axis {ret_axis} != {axis})") diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index f043bdc..ce0feec 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -819,7 +819,7 @@ end function get_terminations !############################################################################### function get_interface_location( & - this, structure, axis, verbose, exit_code & + this, structure, axis, return_fractional, verbose, exit_code & ) result(output) !! Get the interface location for the given structure implicit none @@ -831,6 +831,8 @@ function get_interface_location( & !! Atomic structure data integer, intent(in), optional :: axis !! Axis for the interface + logical, intent(in), optional :: return_fractional + !! Return the interface location in fractional coordinates integer, intent(in), optional :: verbose !! Verbosity level integer, intent(out), optional :: exit_code @@ -842,13 +844,20 @@ function get_interface_location( & ! Local variables integer :: axis_ !! Axis for the interface - + logical :: return_fractional_ + !! Return fractional coordinates axis_ = 0 + return_fractional_ = .true. if(present(axis)) axis_ = axis + if(present(return_fractional)) return_fractional_ = return_fractional output = get_interface(structure, axis_) + if(return_fractional_)then + output%loc = output%loc/modu(structure%lat(axis_,:)) + end if + end function get_interface_location !############################################################################### diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 197bc2d..8b994c0 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1207,7 +1207,7 @@ subroutine f90wrap_intf_gen__get_terminations__binding__agt( & end subroutine f90wrap_intf_gen__get_terminations__binding__agt subroutine f90wrap_intf_gen__get_interface_location__binding__agt( & - this, structure, axis, & + this, structure, axis, return_fractional, & ret_location, ret_axis) use artemis__geom_rw, only: basis_type use artemis__generator, only: artemis_generator_type @@ -1225,13 +1225,18 @@ subroutine f90wrap_intf_gen__get_interface_location__binding__agt( & type(basis_type_ptr_type) :: structure_ptr integer, intent(in), optional, dimension(2) :: structure integer, intent(in), optional :: axis + logical, intent(in), optional :: return_fractional integer, intent(out) :: ret_axis real(4), dimension(2), intent(out) :: ret_location type(intf_info_type) :: intf_info this_ptr = transfer(this, this_ptr) structure_ptr = transfer(structure, structure_ptr) - intf_info = this_ptr%p%get_interface_location(structure=structure_ptr%p, axis=axis) + intf_info = this_ptr%p%get_interface_location( & + structure=structure_ptr%p, & + axis=axis & + return_fractional=return_fractional & + ) ret_location = intf_info%loc ret_axis = intf_info%axis From f869a4e4ac13e387baabbf55ddbed81f4eda257e Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 07:21:22 +0100 Subject: [PATCH 072/137] Fix get_interface_location --- src/artemis/artemis.py | 2 +- src/fortran/lib/mod_generator.f90 | 4 ++-- src/wrapper/f90wrap_mod_generator.f90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index ed8f27a..9fb868d 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -884,7 +884,7 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ return structures, exit_code return structures - def get_interface_location(self, structure=None, axis=None, return_fractional=True): + def get_interface_location(self, structure=None, axis=None, return_fractional=False): """ get_interface_location__binding__artemis_gen_type(self, structure, axis) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index ce0feec..a64e175 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -848,14 +848,14 @@ function get_interface_location( & !! Return fractional coordinates axis_ = 0 - return_fractional_ = .true. + return_fractional_ = .false. if(present(axis)) axis_ = axis if(present(return_fractional)) return_fractional_ = return_fractional output = get_interface(structure, axis_) if(return_fractional_)then - output%loc = output%loc/modu(structure%lat(axis_,:)) + output%loc = output%loc/modu(structure%lat(output%axis,:)) end if end function get_interface_location diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 8b994c0..46640fd 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1234,7 +1234,7 @@ subroutine f90wrap_intf_gen__get_interface_location__binding__agt( & structure_ptr = transfer(structure, structure_ptr) intf_info = this_ptr%p%get_interface_location( & structure=structure_ptr%p, & - axis=axis & + axis=axis, & return_fractional=return_fractional & ) From c3b9ee65acf73b8aaadfded6a04b7a51f1d29458 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 07:23:45 +0100 Subject: [PATCH 073/137] Update filepath --- .../DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR | 0 .../generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR | 0 .../generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR | 0 .../generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR | 0 .../DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR | 0 .../generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR | 0 .../generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR | 0 .../{ => fortran_exe}/generate_interface/DINTERFACES/settings.txt | 0 example/{ => fortran_exe}/generate_interface/POSCAR_Ge | 0 example/{ => fortran_exe}/generate_interface/POSCAR_Si | 0 example/{ => fortran_exe}/generate_interface/param.in | 0 .../identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 | 0 example/{ => fortran_exe}/identify_terminations/POSCAR | 0 example/{ => fortran_exe}/identify_terminations/param.in | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR | 0 .../pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR | 0 .../pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR | 0 .../pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR | 0 .../pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR | 0 .../DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR | 0 .../pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR | 0 .../pregenerated_interface/DINTERFACES/interface_location.dat | 0 example/{ => fortran_exe}/pregenerated_interface/POSCAR | 0 example/{ => fortran_exe}/pregenerated_interface/param.in | 0 65 files changed, 0 insertions(+), 0 deletions(-) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR (100%) rename example/{ => fortran_exe}/generate_interface/DINTERFACES/settings.txt (100%) rename example/{ => fortran_exe}/generate_interface/POSCAR_Ge (100%) rename example/{ => fortran_exe}/generate_interface/POSCAR_Si (100%) rename example/{ => fortran_exe}/generate_interface/param.in (100%) rename example/{ => fortran_exe}/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 (100%) rename example/{ => fortran_exe}/identify_terminations/POSCAR (100%) rename example/{ => fortran_exe}/identify_terminations/param.in (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/DINTERFACES/interface_location.dat (100%) rename example/{ => fortran_exe}/pregenerated_interface/POSCAR (100%) rename example/{ => fortran_exe}/pregenerated_interface/param.in (100%) diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D01/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D02/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D03/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D04/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/DSWAP/D05/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D01/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D01/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D02/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D03/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D04/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/DSWAP/D05/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D02/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D01/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D02/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D03/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D04/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/DSWAP/D05/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D03/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D01/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D02/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D03/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D04/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/DSWAP/D05/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D04/POSCAR diff --git a/example/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR b/example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR similarity index 100% rename from example/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR rename to example/fortran_exe/generate_interface/DINTERFACES/D01/DSHIFT/D05/POSCAR diff --git a/example/generate_interface/DINTERFACES/settings.txt b/example/fortran_exe/generate_interface/DINTERFACES/settings.txt similarity index 100% rename from example/generate_interface/DINTERFACES/settings.txt rename to example/fortran_exe/generate_interface/DINTERFACES/settings.txt diff --git a/example/generate_interface/POSCAR_Ge b/example/fortran_exe/generate_interface/POSCAR_Ge similarity index 100% rename from example/generate_interface/POSCAR_Ge rename to example/fortran_exe/generate_interface/POSCAR_Ge diff --git a/example/generate_interface/POSCAR_Si b/example/fortran_exe/generate_interface/POSCAR_Si similarity index 100% rename from example/generate_interface/POSCAR_Si rename to example/fortran_exe/generate_interface/POSCAR_Si diff --git a/example/generate_interface/param.in b/example/fortran_exe/generate_interface/param.in similarity index 100% rename from example/generate_interface/param.in rename to example/fortran_exe/generate_interface/param.in diff --git a/example/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 b/example/fortran_exe/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 similarity index 100% rename from example/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 rename to example/fortran_exe/identify_terminations/DTERMINATIONS/DLW_TERMS/POSCAR_term1 diff --git a/example/identify_terminations/POSCAR b/example/fortran_exe/identify_terminations/POSCAR similarity index 100% rename from example/identify_terminations/POSCAR rename to example/fortran_exe/identify_terminations/POSCAR diff --git a/example/identify_terminations/param.in b/example/fortran_exe/identify_terminations/param.in similarity index 100% rename from example/identify_terminations/param.in rename to example/fortran_exe/identify_terminations/param.in diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D01/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D02/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D03/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D04/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/DSWAP/D05/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D01/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D01/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D02/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D03/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D04/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/DSWAP/D05/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D02/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D01/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D02/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D03/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D04/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/DSWAP/D05/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D03/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D01/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D02/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D03/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D04/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/DSWAP/D05/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D04/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D01/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D02/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D03/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D04/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/DSWAP/D05/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR b/example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR similarity index 100% rename from example/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR rename to example/fortran_exe/pregenerated_interface/DINTERFACES/DSHIFT/D05/POSCAR diff --git a/example/pregenerated_interface/DINTERFACES/interface_location.dat b/example/fortran_exe/pregenerated_interface/DINTERFACES/interface_location.dat similarity index 100% rename from example/pregenerated_interface/DINTERFACES/interface_location.dat rename to example/fortran_exe/pregenerated_interface/DINTERFACES/interface_location.dat diff --git a/example/pregenerated_interface/POSCAR b/example/fortran_exe/pregenerated_interface/POSCAR similarity index 100% rename from example/pregenerated_interface/POSCAR rename to example/fortran_exe/pregenerated_interface/POSCAR diff --git a/example/pregenerated_interface/param.in b/example/fortran_exe/pregenerated_interface/param.in similarity index 100% rename from example/pregenerated_interface/param.in rename to example/fortran_exe/pregenerated_interface/param.in From 20bd59f9138a4b5f3ce7974b966acf22201497e4 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 08:44:13 +0100 Subject: [PATCH 074/137] Improve fortran executable handling --- app/inputs.f90 | 203 +++++++++++++++----------- app/main.f90 | 34 ++++- src/artemis/artemis.py | 8 +- src/fortran/lib/mod_generator.f90 | 25 ++-- src/fortran/lib/mod_lat_compare.f90 | 53 ++++--- src/fortran/lib/mod_misc_types.f90 | 12 +- src/wrapper/f90wrap_mod_generator.f90 | 6 +- 7 files changed, 199 insertions(+), 142 deletions(-) diff --git a/app/inputs.f90 b/app/inputs.f90 index 3c6a345..c5ad55c 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -8,7 +8,7 @@ !!!############################################################################# !!! MAYBE HAVE FINDSYM IN HERE IN ORDER TO EDIT TOLSYM? module inputs - use artemis__constants, only: real32, ierror, pi + use artemis__constants, only: real32, pi use artemis__misc, only: flagmaker,file_check use artemis__geom_rw, only: basis_type,geom_read use artemis__io_utils, only: & @@ -17,20 +17,48 @@ module inputs err_abort use artemis__io_utils_extd, only: setup_input_fmt, setup_output_fmt use aspect, only: aspect_type, edit_structure - use lat_compare, only: reduce,tol_type + use lat_compare, only: tol_type use infile_tools use infile_print use artemis__sym, only: set_symmetry_tolerance implicit none - integer :: nout,clock,task,task_defect,axis,icheck_intf,iintf - integer :: irestart,idepth,imatch,ishift,iswap + integer :: max_num_matches, max_num_terms, max_num_planes + !! Maximum number of matches, terminations and Miller planes for matching + logical :: compensate_normal + !! Boolean whether to compensate for mismatch strain by adjusting the + !! interface normal axis + integer :: match_method, shift_method, swap_method, depth_method + !! Integer to determine which method to use for matching, shifting and swapping + integer :: num_shifts + !! Number of shifts to be generated per termination pair + real(real32) :: interface_depth, separation_scale, bondlength_cutoff + !! Interface depth, separation scale, and maximum bondlength considered for + !! the shifting method + real(real32), allocatable, dimension(:,:) :: shifts + !! Array of shifts to be applied to the upper structure in the interface + + integer :: num_swaps + !! Number of swaps to be generated per shift + real(real32) :: swap_density, swap_sigma, swap_depth + !! Swap density, swap sigma and swap depth for the swapping method + logical :: require_mirror_swaps + !! Boolean whether to require swaps to be mirrors on each interface + + logical :: reduce_matches + !! Reduce lattice matches to their smallest cell (UNSTABLE) + + logical :: break_on_fail + integer :: icheck_term_pair, interface_idx + integer :: clock, verbose + + integer :: nout,task,task_defect,axis + integer :: irestart integer :: lw_num_layers,up_num_layers - integer :: nshift,nterm,nintf,nswap,nmiller - real(real32) :: max_bondlength,swap_sigma,swap_depth + integer :: nintf real(real32) :: lw_thickness, up_thickness real(real32) :: lw_bulk_modulus, up_bulk_modulus - real(real32) :: c_scale,intf_depth,vacuum - real(real32) :: layer_sep,lw_layer_sep,up_layer_sep,swap_den,tol_sym + real(real32) :: vacuum + real(real32) :: layer_sep,lw_layer_sep,up_layer_sep,tol_sym character(len=20) :: input_fmt,output_fmt character(200) :: struc1_file,struc2_file,out_filename character(100) :: dirname,shiftdir,swapdir,subdir_prefix @@ -40,9 +68,6 @@ module inputs logical :: lortho,lnorm_lat logical :: ludef_lw_layered,ludef_up_layered,ludef_axis logical :: lpresent_struc2 - logical :: lswap_mirror - logical :: lc_fix - logical :: lbreak_on_no_term type(basis_type) :: struc1_bas,struc2_bas type(tol_type) :: tolerance type(aspect_type) :: edits @@ -50,7 +75,6 @@ module inputs integer, dimension(3) :: lw_mplane,up_mplane integer, allocatable, dimension(:) :: seed real(real32), dimension(2) :: udef_intf_loc - real(real32), allocatable, dimension(:,:) :: offset real(real32), dimension(3,3) :: struc1_lat,struc2_lat @@ -87,12 +111,13 @@ subroutine set_global_vars() swapdir="DSWAPS" subdir_prefix="D" n=1 - clock=0 + clock = 0 + verbose = 0 allocate(seed(n)) - imatch=0 - ishift=4 - idepth=0 !!! SWAP DEFAULT DEPTH METHOD !!! - intf_depth=1.5_real32 + match_method = 0 + shift_method = 4 + depth_method = 0 !!! SWAP DEFAULT DEPTH METHOD !!! + interface_depth = 1.5_real32 layer_sep=1._real32 lw_layer_sep=0._real32 up_layer_sep=0._real32 @@ -108,13 +133,13 @@ subroutine set_global_vars() vacuum=14._real32 lw_surf=0 up_surf=0 - c_scale=1.5_real32 - max_bondlength=4.0 - nmiller=10 - nshift=5 - nterm=5 + separation_scale = 1._real32 + bondlength_cutoff = 4._real32 + max_num_planes = 10 + num_shifts = 5 + max_num_terms = 5 nintf=100 - tolerance%nstore=5 + max_num_matches=5 tolerance%maxlen=20._real32 tolerance%maxarea=400._real32 tolerance%maxfit=100 @@ -126,14 +151,14 @@ subroutine set_global_vars() lprint_shifts=.false. lprint_matches=.false. lgen_interfaces=.true. - reduce=.false. - iswap = 0 - nswap = 5 - swap_den = 5.E-2_real32 + reduce_matches=.false. + swap_method = 0 + num_swaps = 5 + swap_density = 5.E-2_real32 swap_sigma = -1.0 swap_depth = 3.0 - lswap_mirror = .true. - icheck_intf=-1 + require_mirror_swaps = .true. + icheck_term_pair=-1 lw_layered=.false. up_layered=.false. ludef_lw_layered=.false. @@ -142,7 +167,7 @@ subroutine set_global_vars() lnorm_lat=.true. lw_surf=0 up_surf=0 - iintf=-1 + interface_idx=-1 tol_sym = 1.E-6_real32 udef_intf_loc = [ -1._real32, -1._real32 ] lw_use_pricel=.true. @@ -150,8 +175,8 @@ subroutine set_global_vars() lw_bulk_modulus=0.E0 up_bulk_modulus=0.E0 - lc_fix=.true. - lbreak_on_no_term = .true. + compensate_normal=.true. + break_on_fail = .true. !!!----------------------------------------------------------------------------- @@ -231,7 +256,7 @@ subroutine set_global_vars() elseif(index(buffer,'-v').eq.1)then flag="-v" call flagmaker(buffer,flag,i,skip,empty) - if(.not.empty) read(buffer,*) ierror + if(.not.empty) read(buffer,*) verbose elseif(index(buffer,'--version').eq.1)then flag="--version" write(*,'(1X,"ARTEMIS version: ",A)') trim(artemis__version__) @@ -369,7 +394,7 @@ subroutine set_global_vars() !!!----------------------------------------------------------------------------- !!! changes interface depth depending on IDEPTH method !!!----------------------------------------------------------------------------- - if(idepth.eq.0) intf_depth=0._real32 + if(depth_method.eq.0) interface_depth=0._real32 @@ -519,7 +544,7 @@ subroutine read_card_settings(unit,count,skip) case("SUBDIR_PREFIX") call assign(buffer,subdir_prefix,readvar(6)) case("IPRINT") - call assign(buffer,ierror, readvar(7)) + call assign(buffer,verbose, readvar(7)) case("CLOCK") call assign(buffer,clock, readvar(8)) case("INPUT_FMT") @@ -680,14 +705,14 @@ subroutine read_card_interfaces(unit,count,skip) integer :: Reason,j,iudef_nshift character(1024) :: store character(1024) :: buffer,tagname - logical :: ludef_offset, ludef_lw_layer_sep, ludef_up_layer_sep + logical :: ludef_shifts, ludef_lw_layer_sep, ludef_up_layer_sep integer, intent(in) :: unit integer, intent(inout) :: count integer, dimension(57) :: readvar logical, optional, intent(in) :: skip - ludef_offset=.false. + ludef_shifts=.false. ludef_lw_layer_sep=.false. ludef_up_layer_sep=.false. readvar=0 @@ -743,7 +768,7 @@ subroutine read_card_interfaces(unit,count,skip) read(store,*) up_surf end select case("SHIFT") - ludef_offset=.true. + ludef_shifts=.true. iudef_nshift=0 store='' store=buffer(index(buffer,"SHIFT")+len("SHIFT"):) @@ -753,30 +778,30 @@ subroutine read_card_interfaces(unit,count,skip) line=iudef_nshift,string=store,rm_cmt=.true.) count=count+iudef_nshift iudef_nshift=iudef_nshift-1 !removes counting of ENDSHIFT line - allocate(offset(iudef_nshift,3)) - read(store,*) (offset(j,:3),j=1,iudef_nshift) + allocate(shifts(iudef_nshift,3)) + read(store,*) (shifts(j,:3),j=1,iudef_nshift) else call assign(buffer,store, readvar(9)) - allocate(offset(1,3)) + allocate(shifts(1,3)) select case(icount(store)) case(1) - offset(1,:)=0._real32 - read(store,*) offset(1,3) + shifts(1,:)=0._real32 + read(store,*) shifts(1,3) iudef_nshift = 1 case(3) - read(store,*) offset(1,:) - if(all(offset.ge.0._real32)) iudef_nshift=1 + read(store,*) shifts(1,:) + if(all(shifts.ge.0._real32)) iudef_nshift=1 case default call err_abort('ERROR: Invalid number of arguments provided to SHIFT& &\nValid number of arguments is 1 or 3.&') end select end if case("NSHIFT") - call assign(buffer,nshift, readvar(10)) + call assign(buffer,num_shifts, readvar(10)) case("NTERM") - call assign(buffer,nterm, readvar(11)) + call assign(buffer,max_num_terms, readvar(11)) case("NMATCH") - call assign(buffer,tolerance%nstore, readvar(12)) + call assign(buffer,max_num_matches, readvar(12)) case("TOL_VEC") call assign(buffer,tolerance%vec, readvar(13)) case("TOL_ANG") @@ -794,36 +819,36 @@ subroutine read_card_interfaces(unit,count,skip) case("LGEN_INTERFACES") call assign(buffer,lgen_interfaces, readvar(20)) case("IMATCH") - call assign(buffer,imatch, readvar(21)) + call assign(buffer,match_method, readvar(21)) case("ISHIFT") - call assign(buffer,ishift, readvar(22)) + call assign(buffer,shift_method, readvar(22)) case("LREDUCE") - call assign(buffer,reduce, readvar(23)) + call assign(buffer,reduce_matches, readvar(23)) case("LPRINT_SHIFTS") call assign(buffer,lprint_shifts, readvar(24)) case("C_SCALE") - call assign(buffer,c_scale, readvar(25)) + call assign(buffer,separation_scale, readvar(25)) case("INTF_DEPTH") - call assign(buffer,intf_depth, readvar(26)) - idepth=0 + call assign(buffer,interface_depth, readvar(26)) + depth_method=0 case("IDEPTH") - call assign(buffer,idepth, readvar(27)) + call assign(buffer,depth_method, readvar(27)) case("NINTF") call assign(buffer,nintf, readvar(28)) case("ISWAP") - call assign(buffer,iswap, readvar(29)) + call assign(buffer,swap_method, readvar(29)) case("NSWAP") - call assign(buffer,nswap, readvar(30)) + call assign(buffer,num_swaps, readvar(30)) case("SWAP_DENSITY") - call assign(buffer,swap_den, readvar(31)) + call assign(buffer,swap_density, readvar(31)) case("SHIFTDIR") call assign(buffer,shiftdir, readvar(32)) case("SWAPDIR") call assign(buffer,swapdir, readvar(33)) case("ICHECK") - call assign(buffer,icheck_intf, readvar(34)) + call assign(buffer,icheck_term_pair, readvar(34)) case("NMILLER") - call assign(buffer,nmiller, readvar(35)) + call assign(buffer,max_num_planes, readvar(35)) case("MAXLEN") call assign(buffer,tolerance%maxlen, readvar(36)) case("MAXAREA") @@ -835,7 +860,7 @@ subroutine read_card_interfaces(unit,count,skip) call assign(buffer,up_layered, readvar(39)) ludef_up_layered=.true. case("IINTF") - call assign(buffer,iintf, readvar(40)) + call assign(buffer,interface_idx, readvar(40)) case("LAYER_SEP") call assign(buffer,layer_sep, readvar(41)) case("LW_LAYER_SEP") @@ -845,7 +870,7 @@ subroutine read_card_interfaces(unit,count,skip) call assign(buffer,up_layer_sep, readvar(43)) ludef_up_layer_sep=.true. case("MBOND_MAXLEN") - call assign(buffer,max_bondlength, readvar(44)) + call assign(buffer,bondlength_cutoff, readvar(44)) case("SWAP_SIGMA") call assign(buffer,swap_sigma, readvar(45)) case("SWAP_DEPTH") @@ -853,7 +878,7 @@ subroutine read_card_interfaces(unit,count,skip) case("INTF_LOC") call assign_vec(buffer,udef_intf_loc, readvar(47)) case("LMIRROR") - call assign(buffer,lswap_mirror, readvar(48)) + call assign(buffer,require_mirror_swaps, readvar(48)) case("LORTHO") call assign(buffer,lortho, readvar(49)) case("LW_USE_PRICEL") @@ -865,13 +890,13 @@ subroutine read_card_interfaces(unit,count,skip) case("UP_BULK_MODULUS") call assign(buffer,up_bulk_modulus, readvar(53)) case("LC_FIX") - call assign(buffer,lc_fix, readvar(54)) + call assign(buffer,compensate_normal, readvar(54)) case("LBREAK_ON_NO_TERM") - call assign(buffer,lbreak_on_no_term, readvar(55)) + call assign(buffer,break_on_fail, readvar(55)) case("LW_MIN_THICKNESS") - call assign(buffer,lw_thickness, readvar(56)) + call assign(buffer,lw_thickness, readvar(56)) case("UP_MIN_THICKNESS") - call assign(buffer,up_thickness, readvar(57)) + call assign(buffer,up_thickness, readvar(57)) case default write(0,'("NOTE: unable to assign variable on line ",I0)') count end select @@ -879,30 +904,30 @@ subroutine read_card_interfaces(unit,count,skip) if(readvar(25).eq.0)then - select case(ishift) + select case(shift_method) case(0,4) - c_scale = 1._real32 + separation_scale = 1._real32 end select end if - if(ludef_offset)then - if(readvar(22).eq.1.and.ishift.ne.0.and.all(offset.ge.0._real32))then - write(0,*) "ISHIFT = ",ishift - write(0,*) "SHIFT = ",offset + if(ludef_shifts)then + if(readvar(22).eq.1.and.shift_method.ne.0.and.all(shifts.ge.0._real32))then + write(0,*) "ISHIFT = ",shift_method + write(0,*) "SHIFT = ",shifts call err_abort('ERROR: Contradictory tags used (ISHIFT and SHIFT) & &\nNo free shifting directions available& &\nExiting...',.true.) - elseif(readvar(22).eq.1.and.ishift.ne.0.and.size(offset(:,1),dim=1).gt.1)then + elseif(readvar(22).eq.1.and.shift_method.ne.0.and.size(shifts(:,1),dim=1).gt.1)then call err_abort('ERROR: Contradictory tags used (ISHIFT and SHIFT) & &\nExiting...',.true.) - elseif(all(offset.ge.0._real32))then - ishift=0 - nshift=iudef_nshift + elseif(all(shifts.ge.0._real32))then + shift_method=0 + num_shifts=iudef_nshift end if else - allocate(offset(1,3)) - offset(1,:)=(/-1._real32,-1._real32,-1._real32/) + allocate(shifts(1,3)) + shifts(1,:)=(/-1._real32,-1._real32,-1._real32/) end if ! set lw_ and up_layer_sep if not defined @@ -1014,28 +1039,28 @@ subroutine write_settings(dirname) write(UNIT,'("INTERFACES")') write(UNIT,'(2X,"LGEN_INTERFACES = ",L)') lgen_interfaces write(UNIT,'(2X,"NINTF = ",I0)') nintf - write(UNIT,'(2X,"IMATCH = ",I0)') imatch - write(UNIT,'(2X,"NMATCH = ",I0)') tolerance%nstore + write(UNIT,'(2X,"IMATCH = ",I0)') match_method + write(UNIT,'(2X,"NMATCH = ",I0)') max_num_matches write(UNIT,'(2X,"TOL_VEC = ",F0.7)') tolerance%vec*100 write(UNIT,'(2X,"TOL_ANG = ",F0.7)') tolerance%ang*360/(2*pi) write(UNIT,'(2X,"TOL_AREA = ",F0.7)') tolerance%area*100 write(UNIT,*) - write(UNIT,'(2X,"NMILLER = ",3(I0,1X))') nmiller + write(UNIT,'(2X,"NMILLER = ",3(I0,1X))') max_num_planes write(UNIT,'(2X,"LW_MILLER_PLANE = ",3(I0,1X))') lw_mplane write(UNIT,'(2X,"UP_MILLER_PLANE = ",3(I0,1X))') up_mplane write(UNIT,'(2X,"LW_SLAB_THICKNESS = ",I0)') lw_num_layers write(UNIT,'(2X,"UP_SLAB_THICKNESS = ",I0)') up_num_layers if(ludef_lw_layered) write(UNIT,'(2X,"LW_LAYERED = ",L)') lw_layered if(ludef_up_layered) write(UNIT,'(2X,"UP_LAYERED = ",L)') lw_layered - write(UNIT,'(2X,"NTERM = ",I0)') nterm + write(UNIT,'(2X,"NTERM = ",I0)') max_num_terms write(UNIT,*) - write(UNIT,'(2X,"ISHIFT = ",I0)') ishift - write(UNIT,'(2X,"NSHIFT = ",I0)') nshift - write(UNIT,'(2X,"C_SCALE = ",F0.7)') c_scale + write(UNIT,'(2X,"ISHIFT = ",I0)') shift_method + write(UNIT,'(2X,"NSHIFT = ",I0)') num_shifts + write(UNIT,'(2X,"C_SCALE = ",F0.7)') separation_scale write(UNIT,*) - write(UNIT,'(2X,"ISWAP = ",I0)') iswap - write(UNIT,'(2X,"NSWAP = ",I0)') nswap - write(UNIT,'(2X,"SWAP_DENSITY = ",F0.5)') swap_den + write(UNIT,'(2X,"ISWAP = ",I0)') swap_method + write(UNIT,'(2X,"NSWAP = ",I0)') num_swaps + write(UNIT,'(2X,"SWAP_DENSITY = ",F0.5)') swap_density write(UNIT,*) write(UNIT,'(2X,"LSURF_GEN = ",L1)') lsurf_gen write(UNIT,'("END INTERFACES")') diff --git a/app/main.f90 b/app/main.f90 index 10b5e64..9ff6f07 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -71,6 +71,30 @@ program artemis_executable call generator%set_tolerance( & tolerance = tolerance & ) + call generator%set_match_method( & + method = match_method, & + max_num_matches = max_num_matches, & ! this is maxfit/nstore + max_num_terms = max_num_terms, & + max_num_planes = max_num_planes, & + compensate_normal = compensate_normal & + ) + call generator%set_shift_method( & + method = shift_method, & + num_shifts = num_shifts, & + shifts = shifts, & + interface_depth = interface_depth, & + separation_scale = separation_scale, & + depth_method = depth_method, & + bondlength_cutoff = bondlength_cutoff & + ) + call generator%set_swap_method( & + method = swap_method, & + num_swaps = num_swaps, & + swap_density = swap_density, & + swap_depth = swap_depth, & + swap_sigma = swap_sigma, & + require_mirror_swaps = require_mirror_swaps & + ) call generator%set_materials( & structure_lw = struc1_bas, structure_up = struc2_bas, & use_pricel_lw = lw_use_pricel, use_pricel_up = up_use_pricel, & @@ -132,9 +156,17 @@ program artemis_executable if(irestart.eq.0)then call generator%generate( & surface_lw = lw_surf, surface_up = up_surf, & + thickness_lw = lw_thickness, thickness_up = up_thickness, & + num_layers_lw = lw_num_layers, num_layers_up = up_num_layers, & + reduce_matches = reduce_matches, & print_lattice_match_info = lprint_matches, & print_termination_info = lprint_terms, & - print_shift_info = lprint_shifts & + print_shift_info = lprint_shifts, & + break_on_fail = break_on_fail, & + icheck_term_pair = icheck_term_pair, & + interface_idx = interface_idx, & + seed = clock, & + verbose = verbose & ) call generator%write_structures(directory = "DINTERFACES", prefix= "") else diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 9fb868d..7875845 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -928,14 +928,14 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ thickness_up=None, num_layers_lw=None, num_layers_up=None, \ reduce_matches=None, \ print_lattice_match_info=None, print_termination_info=None, \ - print_shift_info=None, break_on_fail=None, icheck_match=None, \ + print_shift_info=None, break_on_fail=None, icheck_term_pair=None, \ interface_idx=None, generate_structures=None, seed=None, verbose=None, \ return_exit_code=False, calc=None): """ generate__binding__artemis_gen_type(self[, surface_lw, \ surface_up, thickness_lw, thickness_up, num_layers_lw, num_layers_up, \ print_lattice_match_info, print_termination_info, print_shift_info, \ - break_on_fail, icheck_match, interface_idx, generate_structures, seed, \ + break_on_fail, icheck_term_pair, interface_idx, generate_structures, seed, \ verbose, exit_code]) @@ -956,7 +956,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ print_termination_info : bool print_shift_info : bool break_on_fail : bool - icheck_match : int + icheck_term_pair : int interface_idx : int generate_structures : bool seed : int @@ -976,7 +976,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ print_lattice_match_info=print_lattice_match_info, \ print_termination_info=print_termination_info, \ print_shift_info=print_shift_info, break_on_fail=break_on_fail, \ - icheck_match=icheck_match, interface_idx=interface_idx, \ + icheck_term_pair=icheck_term_pair, interface_idx=interface_idx, \ generate_structures=generate_structures, seed=seed, verbose=verbose ) if ( exit_code != 0 and exit_code != None ) and not return_exit_code: diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index a64e175..ea05d0f 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -186,7 +186,6 @@ subroutine set_tolerance( & if(present(max_length)) this%tolerance%maxlen = max_length if(present(max_area)) this%tolerance%maxarea = max_area if(present(max_fit)) this%tolerance%maxfit = max_fit - ! if(present(nstore)) this%tolerance%nstore = nstore if(present(max_extension)) this%tolerance%maxsize = max_extension if(present(angle_weight)) this%tolerance%ang_weight = angle_weight if(present(area_weight)) this%tolerance%area_weight = area_weight @@ -1009,7 +1008,7 @@ subroutine generate_interfaces( & reduce_matches, & print_lattice_match_info, print_termination_info, print_shift_info, & break_on_fail, & - icheck_match, interface_idx, & + icheck_term_pair, interface_idx, & generate_structures, & seed, verbose, exit_code & ) @@ -1042,7 +1041,7 @@ subroutine generate_interfaces( & !! Print termination information logical, intent(in), optional :: print_shift_info !! Print shift information - integer, intent(in), optional :: icheck_match + integer, intent(in), optional :: icheck_term_pair !! Index of the lattice match to check integer, intent(in), optional :: interface_idx !! Index of the interface to output @@ -1105,7 +1104,7 @@ subroutine generate_interfaces( & !! Number of seeds for the random number generator. integer, dimension(:), allocatable :: seed_arr !! Array of seeds for the random number generator. - integer :: icheck_match_ + integer :: icheck_term_pair_ !! Index of the lattice match to check integer :: interface_idx_ !! Index of the interface to output @@ -1147,8 +1146,8 @@ subroutine generate_interfaces( & if(present(verbose)) verbose_ = verbose if(present(reduce_matches)) reduce_matches_ = reduce_matches - icheck_match_ = -1; interface_idx_ = -1 - if(present(icheck_match)) icheck_match_ = icheck_match + icheck_term_pair_ = -1; interface_idx_ = -1 + if(present(icheck_term_pair)) icheck_term_pair_ = icheck_term_pair if(present(interface_idx)) interface_idx_ = interface_idx break_on_fail_ = .false. @@ -1454,7 +1453,7 @@ subroutine generate_interfaces( & end if call SAV%init( & this%tolerance, structure_lw%lat, structure_up%lat, & - reduce_matches_ & + this%max_num_matches, reduce_matches_ & ) select case(this%match_method) case(0) @@ -1469,16 +1468,16 @@ subroutine generate_interfaces( & call SAV%constrain_axes(miller_lw, miller_up, verbose = verbose_) call cyc_lat1(SAV, this%tolerance, this%match_method, verbose = verbose_) end select - if(min(this%tolerance%nstore,SAV%nfit).eq.0)then + if(min(this%max_num_matches,SAV%nfit).eq.0)then write(err_msg,'("No matches found between the two structures")') call print_warning(trim(err_msg)) return else if(verbose_.gt.0) write(*,'(1X,"Number of matches found: ",I0)')& - min(this%tolerance%nstore,SAV%nfit) + min(this%max_num_matches,SAV%nfit) end if if(verbose_.gt.0) write(*,'(1X,"Maximum number of generated interfaces will be: ",I0)')& - this%max_num_terms*this%num_shifts*this%tolerance%nstore + this%max_num_terms * this%num_shifts * this%max_num_matches if(.not.generate_structures_)then if(verbose_.gt.0) write(*,'(1X,"Told not to generate structures, just find matches.")') return @@ -1494,7 +1493,7 @@ subroutine generate_interfaces( & if(verbose_.gt.0) write(*,'(1X,"Generating only interfaces for match ",I0)') interface_idx_ else intf_start=1 - intf_end=min(this%tolerance%nstore,SAV%nfit) + intf_end=min(this%max_num_matches,SAV%nfit) end if iunique=0 !!!----------------------------------------------------------------------------- @@ -1839,14 +1838,14 @@ subroutine generate_interfaces( & 1.5_real32*init_offset(this%axis) - 2._real32*this%vacuum_gap )/modu(intf_basis%lat(this%axis,:)) if(ierror.ge.1)then write(0,*) "interface:",intf_loc - if(ierror.eq.1.and.iunique.eq.icheck_match_-1)then + if(ierror.eq.1.and.iunique.eq.icheck_term_pair_-1)then ! call chdir(intf_dir) call err_abort_print_struc(slab_lw,"lw_term.vasp",& "",.false.) call err_abort_print_struc(slab_up,"up_term.vasp",& "As IPRINT = 1 and ICHECK has been set, & &code is now exiting...") - elseif(ierror.eq.2.and.iunique.eq.icheck_match_-1)then + elseif(ierror.eq.2.and.iunique.eq.icheck_term_pair_-1)then ! call chdir(intf_dir) call err_abort_print_struc(intf_basis,"test_intf.vasp",& "As IPRINT = 2 and ICHECK has been set, & diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index b55b39f..29f048c 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -616,7 +616,7 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,verbose) result(lmatch) !!----------------------------------------------------------------------- !! Checks if best mismatch and saves accordingly !!----------------------------------------------------------------------- - best_check: do i=1,tol%nstore + best_check: do i=1,SAV%max_num_matches if(i.gt.SAV%nfit)then SAV%tol(i,1)=diff*100._real32 SAV%tol(i,2)=abs(ang1-ang2) @@ -631,7 +631,7 @@ function tol_check(SAV,tol,tlat1,tlat2,tf1,tf2,verbose) result(lmatch) if(nint(get_area(real(tf1(1,:),real32),real(tf1(2,:),real32))).ge.& nint(get_area(real(SAV%tf1(i,1,:),real32),real(SAV%tf1(i,2,:),real32))))& cycle best_check - do j=tol%nstore,i+1,-1 + do j=SAV%max_num_matches,i+1,-1 SAV%tol(j,:)=SAV%tol(j-1,:) SAV%tf1(j,:,:)=SAV%tf1(j-1,:,:) SAV%tf2(j,:,:)=SAV%tf2(j-1,:,:) @@ -668,7 +668,7 @@ function lat_check(SAV,tol,lat) result(lcheck) tiny=1.E-6_real32 lcheck=.false. - lat_loop: do i=1,min(tol%nstore,SAV%nfit) + lat_loop: do i=1,min(SAV%max_num_matches,SAV%nfit) tlat=matmul(SAV%tf1(i,:,:),SAV%lat1) ang1=acos(dot_product(lat(1,:),lat(2,:))/(& sqrt(dot_product(lat(1,:),lat(1,:)))*& @@ -885,22 +885,21 @@ subroutine lattice_matching( & !! sets initial variables !!-------------------------------------------------------------------------- SAV%nfit = 0 - allocate(transform1_saved(tol%nstore,3,3)) - allocate(transform2_saved(tol%nstore,3,3)) - allocate(Tsaved_1(tol%nstore,2,2)) - allocate(Tsaved_2(tol%nstore,2,2)) + allocate(transform1_saved(SAV%max_num_matches,3,3)) + allocate(transform2_saved(SAV%max_num_matches,3,3)) + allocate(Tsaved_1(SAV%max_num_matches,2,2)) + allocate(Tsaved_2(SAV%max_num_matches,2,2)) transform1_saved = 0._real32 transform2_saved = 0._real32 Tsaved_1 = 0._real32 Tsaved_2 = 0._real32 - allocate(tolerances(tol%nstore,3)) - allocate(saved_tolerances(tol%nstore,3)) + allocate(tolerances(SAV%max_num_matches,3)) + allocate(saved_tolerances(SAV%max_num_matches,3)) saved_tolerances = INF lat1 = SAV%lat1 lat2 = SAV%lat2 pm_tol%maxsize=tol%maxsize pm_tol%maxfit=tol%maxfit - pm_tol%nstore=tol%nstore pm_tol%vec=tol%vec pm_tol%ang=tol%ang pm_tol%area=tol%area @@ -1124,25 +1123,25 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------- - !! Find the (tol%nstore) best matches overall + !! Find the (SAV%max_num_matches) best matches overall !!-------------------------------------------------------------------- loop110: do i=1,num_of_transforms IF101: if ( dot_product(tolerances(i,:),vaa_weighting).le.& - dot_product(saved_tolerances(tol%nstore,:),vaa_weighting) )then + dot_product(saved_tolerances(SAV%max_num_matches,:),vaa_weighting) )then temp_mat1(:,:) = real(Tcellmatch_1(i,:,:),real32) temp_mat2(:,:) = real(Tcellmatch_2(i,:,:),real32) IF102: if (.not.is_duplicate(& (Tsaved_1),(Tsaved_2),& (temp_mat1),(temp_mat2),& tmpsym1,tmpsym2) ) then - saved_tolerances(tol%nstore,:) = tolerances(i,:) - Tsaved_1(tol%nstore,:,:) = temp_mat1(:,:) - Tsaved_2(tol%nstore,:,:) = temp_mat2(:,:) - transform1_saved(tol%nstore,:,:) = real(transform1(:,:),real32) - transform2_saved(tol%nstore,:,:) = real(transform2(:,:),real32) + saved_tolerances(SAV%max_num_matches,:) = tolerances(i,:) + Tsaved_1(SAV%max_num_matches,:,:) = temp_mat1(:,:) + Tsaved_2(SAV%max_num_matches,:,:) = temp_mat2(:,:) + transform1_saved(SAV%max_num_matches,:,:) = real(transform1(:,:),real32) + transform2_saved(SAV%max_num_matches,:,:) = real(transform2(:,:),real32) - if(SAV%nfit.lt.tol%nstore) SAV%nfit = SAV%nfit + 1 + if(SAV%nfit.lt.SAV%max_num_matches) SAV%nfit = SAV%nfit + 1 call datasortmain_tols(saved_tolerances,& Tsaved_1,Tsaved_2,transform1_saved,transform2_saved) end if IF102 @@ -1157,15 +1156,15 @@ subroutine lattice_matching( & !!!----------------------------------------------------------------------------- !!! Convert the 2x2 transformations to 3x3 matrices !!!----------------------------------------------------------------------------- - allocate(big_T_1(tol%nstore,3,3)) - allocate(big_T_2(tol%nstore,3,3)) + allocate(big_T_1(SAV%max_num_matches,3,3)) + allocate(big_T_2(SAV%max_num_matches,3,3)) big_T_1(:,:,:) = 0 big_T_2(:,:,:) = 0 - loop101: do i=1,tol%nstore + loop101: do i=1,SAV%max_num_matches big_T_1(i,3,3) = 1 big_T_2(i,3,3) = 1 end do loop101 - loop103: do i=1,tol%nstore + loop103: do i=1,SAV%max_num_matches big_T_1(i,:2,:2) = (Tsaved_1(i,:,:)) big_T_2(i,:2,:2) = (Tsaved_2(i,:,:)) end do loop103 @@ -1174,9 +1173,9 @@ subroutine lattice_matching( & !!!----------------------------------------------------------------------------- !!! Combine 3x3 planecutter matrix with 3x3 plane matching matrix !!!----------------------------------------------------------------------------- - allocate(comb_trans_1(tol%nstore,3,3)) - allocate(comb_trans_2(tol%nstore,3,3)) - loop104: do i=1,tol%nstore + allocate(comb_trans_1(SAV%max_num_matches,3,3)) + allocate(comb_trans_2(SAV%max_num_matches,3,3)) + loop104: do i=1,SAV%max_num_matches dummy_mat1(:,:) = big_T_1(i,:,:) dummy_mat2(:,:) = transform1_saved(i,:,:) comb_trans_1(i,:,:) = matmul((dummy_mat1),(dummy_mat2)) @@ -1191,9 +1190,9 @@ subroutine lattice_matching( & !!! Reduce transformation matrices if necessary !!!----------------------------------------------------------------------------- write(*,*) "Performing lattice match reduction" - allocate(lvec1(tol%nstore)) + allocate(lvec1(SAV%max_num_matches)) lvec1=.false. - OUTLOOP: do i=1,tol%nstore + OUTLOOP: do i=1,SAV%max_num_matches SAV%tol(i,:) = saved_tolerances(i,:) if_reduce: if(reduce)then tf = find_tf(comb_trans_1(i,:,:),comb_trans_2(i,:,:)) diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 0d3d77f..68372dc 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -16,6 +16,7 @@ module artemis__misc_types type latmatch_type integer :: nfit + integer :: max_num_matches = 5 logical :: reduce = .false. logical :: reduced = .false. character(1) :: abc(3)= [ 'a', 'b', 'c' ] @@ -30,7 +31,6 @@ module artemis__misc_types end type latmatch_type type tol_type - integer :: nstore = 5 integer :: maxfit = 100 integer :: maxsize = 10 real(real32) :: maxlen=20._real32 @@ -64,17 +64,19 @@ module artemis__misc_types !############################################################################### subroutine latmatch_init( & - this, tol, lattice_lw, lattice_up, reduce_matches & + this, tol, lattice_lw, lattice_up, max_num_matches, reduce_matches & ) implicit none class(latmatch_type), intent(inout) :: this type(tol_type), intent(in) :: tol + integer, intent(in) :: max_num_matches real(real32), dimension(3,3), intent(in) :: lattice_lw,lattice_up logical, intent(in) :: reduce_matches - allocate(this%tf1(tol%nstore,3,3)) - allocate(this%tf2(tol%nstore,3,3)) - allocate(this%tol(tol%nstore,3)) + this%max_num_matches = max_num_matches + allocate(this%tf1(this%max_num_matches,3,3)) + allocate(this%tf2(this%max_num_matches,3,3)) + allocate(this%tol(this%max_num_matches,3)) this%tol(:,:) = huge(0._real32) this%lat1 = MATNORM(lattice_lw) diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 46640fd..e0807d8 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1274,7 +1274,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & num_layers_lw, num_layers_up, & reduce_matches, & print_lattice_match_info, print_termination_info, print_shift_info, & - break_on_fail, icheck_match, interface_idx, & + break_on_fail, icheck_term_pair, interface_idx, & generate_structures, & seed, verbose, exit_code, & n0, n1) @@ -1297,7 +1297,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & logical, intent(in), optional :: print_termination_info logical, intent(in), optional :: print_shift_info logical, intent(in), optional :: break_on_fail - integer, intent(in), optional :: icheck_match + integer, intent(in), optional :: icheck_term_pair integer, intent(in), optional :: interface_idx logical, intent(in), optional :: generate_structures integer, intent(in), optional :: seed @@ -1312,7 +1312,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & thickness_up=thickness_up, num_layers_lw=num_layers_lw, num_layers_up=num_layers_up, & reduce_matches=reduce_matches, & print_lattice_match_info=print_lattice_match_info, print_termination_info=print_termination_info, & - print_shift_info=print_shift_info, break_on_fail=break_on_fail, icheck_match=icheck_match, & + print_shift_info=print_shift_info, break_on_fail=break_on_fail, icheck_term_pair=icheck_term_pair, & interface_idx=interface_idx, generate_structures=generate_structures, seed=seed, verbose=verbose, & exit_code=exit_code) end subroutine f90wrap_intf_gen__generate__binding__agt From 77c6125ff37d9334d1d349bc4d9de90747336ef0 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 11:15:01 +0100 Subject: [PATCH 075/137] Reduce use of global variables --- app/inputs.f90 | 37 ++-- app/main.f90 | 30 +++- src/fortran/lib/mod_generator.f90 | 41 +++-- src/fortran/lib/mod_lat_compare.f90 | 7 +- src/fortran/lib/mod_shifting.f90 | 39 ++-- src/fortran/lib/mod_swapping.f90 | 13 +- src/fortran/lib/mod_sym.f90 | 260 ++++++++++++++------------- src/fortran/lib/mod_terminations.f90 | 15 +- 8 files changed, 251 insertions(+), 191 deletions(-) diff --git a/app/inputs.f90 b/app/inputs.f90 index c5ad55c..260ab2a 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -20,7 +20,6 @@ module inputs use lat_compare, only: tol_type use infile_tools use infile_print - use artemis__sym, only: set_symmetry_tolerance implicit none integer :: max_num_matches, max_num_terms, max_num_planes !! Maximum number of matches, terminations and Miller planes for matching @@ -51,13 +50,24 @@ module inputs integer :: icheck_term_pair, interface_idx integer :: clock, verbose - integer :: nout,task,task_defect,axis + real(real32) :: vacuum_gap + !! Vacuum gap (FOR SURFACE GENERATION ONLY) + logical :: lortho + !! Boolean whether to orthogonalise the lattice (FOR SURFACE GENERATION ONLY) + integer :: max_num_structures + !!! Maximum number of structures to be generated + + integer :: axis + !! Integer to determine which axis to use for the interface + + type(tol_type) :: tolerance + !! Tolerance settings for lattice matchings + + integer :: nout,task,task_defect integer :: irestart integer :: lw_num_layers,up_num_layers - integer :: nintf real(real32) :: lw_thickness, up_thickness real(real32) :: lw_bulk_modulus, up_bulk_modulus - real(real32) :: vacuum real(real32) :: layer_sep,lw_layer_sep,up_layer_sep,tol_sym character(len=20) :: input_fmt,output_fmt character(200) :: struc1_file,struc2_file,out_filename @@ -65,11 +75,10 @@ module inputs logical :: lsurf_gen,lprint_matches,lprint_terms,lgen_interfaces,lprint_shifts logical :: lw_use_pricel, up_use_pricel logical :: lw_layered,up_layered - logical :: lortho,lnorm_lat + logical :: lnorm_lat logical :: ludef_lw_layered,ludef_up_layered,ludef_axis logical :: lpresent_struc2 type(basis_type) :: struc1_bas,struc2_bas - type(tol_type) :: tolerance type(aspect_type) :: edits integer, dimension(2) :: lw_surf,up_surf integer, dimension(3) :: lw_mplane,up_mplane @@ -130,7 +139,7 @@ subroutine set_global_vars() up_num_layers=0 lw_thickness=-1._real32 up_thickness=-1._real32 - vacuum=14._real32 + vacuum_gap=14._real32 lw_surf=0 up_surf=0 separation_scale = 1._real32 @@ -138,7 +147,7 @@ subroutine set_global_vars() max_num_planes = 10 num_shifts = 5 max_num_terms = 5 - nintf=100 + max_num_structures=100 max_num_matches=5 tolerance%maxlen=20._real32 tolerance%maxarea=400._real32 @@ -398,12 +407,6 @@ subroutine set_global_vars() -!!!----------------------------------------------------------------------------- -!!! sets the symmetry tolerance for the artemis__sym module -!!!----------------------------------------------------------------------------- - call set_symmetry_tolerance(tol_sym) - - !!!----------------------------------------------------------------------------- !!! make the output directory !!!----------------------------------------------------------------------------- @@ -648,7 +651,7 @@ subroutine read_card_cell_edits(unit,count,skip) edits%bounds(edits%nedits,1)=assign_list(store,tag_list,2) edits%val(edits%nedits)=assign_list(store,tag_list,3) else - call assign(buffer, vacuum, readvar(7)) + call assign(buffer, vacuum_gap, readvar(7)) end if case("TFMAT") readvar(8) = readvar(8) + 1 @@ -834,7 +837,7 @@ subroutine read_card_interfaces(unit,count,skip) case("IDEPTH") call assign(buffer,depth_method, readvar(27)) case("NINTF") - call assign(buffer,nintf, readvar(28)) + call assign(buffer,max_num_structures, readvar(28)) case("ISWAP") call assign(buffer,swap_method, readvar(29)) case("NSWAP") @@ -1038,7 +1041,7 @@ subroutine write_settings(dirname) elseif(task.eq.1)then write(UNIT,'("INTERFACES")') write(UNIT,'(2X,"LGEN_INTERFACES = ",L)') lgen_interfaces - write(UNIT,'(2X,"NINTF = ",I0)') nintf + write(UNIT,'(2X,"NINTF = ",I0)') max_num_structures write(UNIT,'(2X,"IMATCH = ",I0)') match_method write(UNIT,'(2X,"NMATCH = ",I0)') max_num_matches write(UNIT,'(2X,"TOL_VEC = ",F0.7)') tolerance%vec*100 diff --git a/app/main.f90 b/app/main.f90 index 9ff6f07..7ffe2c9 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -21,6 +21,7 @@ program artemis_executable !!! set up global variables !!!----------------------------------------------------------------------------- call set_global_vars() + generator%tol_sym = tol_sym !!!----------------------------------------------------------------------------- @@ -37,20 +38,23 @@ program artemis_executable write(0,'(1X,"Finding terminations for lower material.")') call generator%set_tolerance( & - tolerance = tolerance & + tolerance = tolerance & ) call generator%set_materials( & - structure_lw = struc1_bas, & - use_pricel_lw = lw_use_pricel & + structure_lw = struc1_bas, & + use_pricel_lw = lw_use_pricel & ) call generator%set_surface_properties( & - miller_lw = lw_mplane, & - is_layered_lw = lw_layered & + miller_lw = lw_mplane, & + is_layered_lw = lw_layered, & + vacuum_gap = vacuum_gap, & + layer_separation_cutoff = layer_sep & ) structures = generator%get_terminations(1, & num_layers = lw_num_layers, & - thickness = lw_thickness & + thickness = lw_thickness, & + orthogonalise = lortho & ) do i = 1, size(structures) write(filename, '(A,I0,A)') "term_", i, ".vasp" @@ -68,6 +72,8 @@ program artemis_executable case(1) ! interfaces/ARTEMIS/SEARCH write(*,'(1X,"task ",I0," set",/,1X,"Performing Interface Generation")') task + generator%max_num_structures = max_num_structures + generator%axis = axis call generator%set_tolerance( & tolerance = tolerance & ) @@ -104,7 +110,8 @@ program artemis_executable call generator%set_surface_properties( & miller_lw = lw_mplane, miller_up = up_mplane, & is_layered_lw = lw_layered, is_layered_up = up_layered, & - layer_separation_cutoff = [ lw_layer_sep, up_layer_sep ] & + layer_separation_cutoff = [ lw_layer_sep, up_layer_sep ], & + vacuum_gap = vacuum_gap & ) if(.not.ludef_lw_layered) call generator%reset_is_layered_lw() if(.not.ludef_up_layered) call generator%reset_is_layered_up() @@ -120,7 +127,8 @@ program artemis_executable write(*,'(1X,"Finding terminations for lower material.")') structures = generator%get_terminations(1, & num_layers = lw_num_layers, & - thickness = lw_thickness & + thickness = lw_thickness, & + orthogonalise = lortho & ) do i = 1, size(structures) write(filename, '(A,I0,A)') "lw_term_", i, ".vasp" @@ -136,7 +144,8 @@ program artemis_executable write(*,'(1X,"Finding terminations for upper material.")') structures = generator%get_terminations(2, & num_layers = up_num_layers, & - thickness = up_thickness & + thickness = up_thickness, & + orthogonalise = lortho & ) do i = 1, size(structures) write(filename, '(A,I0,A)') "up_term_", i, ".vasp" @@ -154,6 +163,9 @@ program artemis_executable !! interface generator !!------------------------------------------------------------------------- if(irestart.eq.0)then + !!! NEED TO BE ABLE TO SET MAX_NUM_STRUCTURES + !!! lortho, printing directories and directory space + !!! sort out match, term, shift, and swap data call generator%generate( & surface_lw = lw_surf, surface_up = up_surf, & thickness_lw = lw_thickness, thickness_up = up_thickness, & diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index ea05d0f..ec40bc4 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -107,6 +107,7 @@ module artemis__generator type(tol_type) :: tolerance !! Tolerance structure + real(real32) :: tol_sym = 1.E-6_real32 contains procedure, pass(this) :: set_tolerance @@ -637,7 +638,7 @@ function get_terminations( & call structure_compare%copy(this%structure_lw, length=4) if(this%use_pricel_lw)then if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for material")') - call get_primitive_cell(structure) + call get_primitive_cell(structure, tol_sym=this%tol_sym) end if miller_ = this%miller_lw prefix = "lw" @@ -647,7 +648,7 @@ function get_terminations( & call structure_compare%copy(this%structure_up, length=4) if(this%use_pricel_up)then if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for material")') - call get_primitive_cell(structure) + call get_primitive_cell(structure, tol_sym=this%tol_sym) end if miller_ = this%miller_up prefix = "up" @@ -740,7 +741,7 @@ function get_terminations( & confine%laxis(this%axis) = .true. if(allocated(trans)) deallocate(trans) allocate(trans(minval(structure%spec(:)%num+2),3)) - call gldfnd(confine, structure, structure, trans, ntrans) + call gldfnd(confine, structure, structure, trans, ntrans, this%tol_sym) tfmat(:,:) = 0._real32 tfmat(1,1) = 1._real32 tfmat(2,2) = 1._real32 @@ -766,7 +767,8 @@ function get_terminations( & ! get the terminations term = get_termination_info( & structure, this%axis, & - verbose = verbose_, layer_sep = layer_sep, & + verbose = verbose_, tol_sym = this%tol_sym, & + layer_sep = layer_sep, & break_on_fail = break_on_fail_ & ) if(term%nterm .eq. 0)then @@ -1210,9 +1212,10 @@ subroutine generate_interfaces( & !--------------------------------------------------------------------------- ! Retrieve the primitive cells if necessary !--------------------------------------------------------------------------- + write(*,*) "tar0" if(this%use_pricel_lw)then if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for lower material")') - call get_primitive_cell(structure_lw) + call get_primitive_cell(structure_lw, tol_sym=this%tol_sym) else if(verbose_.gt.0) write(*,'(1X,"Using supplied cell for lower material")') call reducer(structure_lw) @@ -1220,12 +1223,13 @@ subroutine generate_interfaces( & end if if(this%use_pricel_up)then if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for upper material")') - call get_primitive_cell(structure_up) + call get_primitive_cell(structure_up, tol_sym=this%tol_sym) else if(verbose_.gt.0) write(*,'(1X,"Using supplied cell for upper material")') call reducer(structure_up) structure_up%lat = primitive_lat(structure_up%lat) end if + write(*,*) "tar1" !--------------------------------------------------------------------------- @@ -1262,6 +1266,7 @@ subroutine generate_interfaces( & call stop_program(trim(err_msg)) end select end if + write(*,*) "tar2" ludef_surface_lw = .false. ludef_surface_up = .false. @@ -1290,6 +1295,7 @@ subroutine generate_interfaces( & " One of these must be greater than 0." call stop_program(trim(err_msg)) end if + write(*,*) "tar3" !--------------------------------------------------------------------------- @@ -1303,6 +1309,7 @@ subroutine generate_interfaces( & if(verbose_.gt.0) write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond if(verbose_.gt.0) write(*,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale if(this%shift_method.eq.-1) this%num_shifts = 1 + write(*,*) "tar4" !--------------------------------------------------------------------------- @@ -1378,6 +1385,7 @@ subroutine generate_interfaces( & lw_map=-1 up_map=-1 end if + write(*,*) "tar1" !--------------------------------------------------------------------------- @@ -1426,6 +1434,7 @@ subroutine generate_interfaces( & elseif(this%is_layered_up.and.layered_axis_up.gt.0.and.all(miller_up.eq.0))then miller_up(layered_axis_up)=1 end if + write(*,*) "tar2" !--------------------------------------------------------------------------- @@ -1462,7 +1471,8 @@ subroutine generate_interfaces( & structure_lw, structure_up, & miller_lw = miller_lw, miller_up = miller_up, & max_num_planes = this%max_num_planes, & - verbose = merge(1,verbose_,print_lattice_match_info_) & + verbose = merge(1,verbose_,print_lattice_match_info_), & + tol_sym = this%tol_sym & ) case default call SAV%constrain_axes(miller_lw, miller_up, verbose = verbose_) @@ -1482,6 +1492,7 @@ subroutine generate_interfaces( & if(verbose_.gt.0) write(*,'(1X,"Told not to generate structures, just find matches.")') return end if + write(*,*) "tar3" !!!----------------------------------------------------------------------------- @@ -1561,7 +1572,7 @@ subroutine generate_interfaces( & confine%laxis(this%axis)=.true. if(allocated(trans)) deallocate(trans) allocate(trans(minval(supercell_lw%spec(:)%num+2),3)) - call gldfnd(confine,supercell_lw,supercell_lw,trans,ntrans) + call gldfnd(confine, supercell_lw, supercell_lw, trans, ntrans, this%tol_sym) tfmat(:,:)=0._real32 tfmat(1,1)=1._real32 tfmat(2,2)=1._real32 @@ -1593,6 +1604,7 @@ subroutine generate_interfaces( & lw_term = get_termination_info( & supercell_lw, this%axis, & verbose = merge(1,verbose_,print_termination_info_), & + tol_sym = this%tol_sym, & layer_sep = this%layer_separation_cutoff(1), & break_on_fail = break_on_fail_ & ) @@ -1644,7 +1656,7 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------------- deallocate(trans) allocate(trans(minval(supercell_up%spec(:)%num+2),3)) - call gldfnd(confine,supercell_up,supercell_up,trans,ntrans) + call gldfnd(confine, supercell_up, supercell_up, trans,ntrans, this%tol_sym) tfmat(:,:)=0._real32 tfmat(1,1)=1._real32 tfmat(2,2)=1._real32 @@ -1677,6 +1689,7 @@ subroutine generate_interfaces( & up_term = get_termination_info( & supercell_up, this%axis, & verbose = merge(1,verbose_,print_termination_info_), & + tol_sym = this%tol_sym, & layer_sep = this%layer_separation_cutoff(2), & break_on_fail = break_on_fail_ & ) @@ -1993,7 +2006,8 @@ subroutine generate_shifts_and_swaps( & offset=this%shifts(1,:3),& lprint=print_shift_info, & bulk_DON=bulk_DON,bulk_map=map,& - max_bondlength=this%bondlength_cutoff) + max_bondlength=this%bondlength_cutoff,& + tol_sym=this%tol_sym) else output_shifts = get_shifts_DON(& bas=basis,& @@ -2003,7 +2017,8 @@ subroutine generate_shifts_and_swaps( & c_scale=this%separation_scale, & offset=this%shifts(1,:3),& lprint=print_shift_info,& - max_bondlength=this%bondlength_cutoff) + max_bondlength=this%bondlength_cutoff,& + tol_sym=this%tol_sym) end if if(size(output_shifts(:,1)).eq.0)then write(0,'(2X,"No shifts were identified with ISHIFT = 4 for this lattice match")') @@ -2103,7 +2118,9 @@ subroutine generate_shifts_and_swaps( & !!----------------------------------------------------------------------- if_swap: if(this%swap_method.ne.0)then bas_arr = rand_swapper(tbas%lat,tbas,this%axis,this%swap_depth,& - nswaps_per_cell,this%num_swaps,intf_loc,this%swap_method,seed_arr,sigma=this%swap_sigma,& + nswaps_per_cell,this%num_swaps,intf_loc,this%swap_method,& + seed_arr,tol_sym=this%tol_sym,& + sigma=this%swap_sigma,& require_mirror=this%require_mirror_swaps) ngen_swaps = this%num_swaps LOOPswaps: do l=1,this%num_swaps diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index 29f048c..4410ddc 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -834,7 +834,7 @@ end function vec_comp subroutine lattice_matching( & SAV, tol, structure_lw, structure_up, & miller_lw, miller_up, max_num_planes, & - verbose & + verbose, tol_sym & ) use artemis__sym use plane_matching @@ -845,6 +845,7 @@ subroutine lattice_matching( & integer, dimension(3), intent(in) :: miller_lw,miller_up integer, intent(in) :: max_num_planes integer, intent(in) :: verbose + real(real32), intent(in) :: tol_sym type(sym_type) :: grp1,grp2 type(tol_type) :: tol @@ -914,13 +915,13 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- s_end=0 call sym_setup(grp1,lat1)!,predefined=.true.,new_start=.true.) - call check_sym(grp1,structure_lw,lsave=.true.) + call check_sym(grp1,structure_lw,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym1(grp1%nsym,3,3)) s_end=0 call sym_setup(grp2,lat2)!,predefined=.true.,new_start=.true.) - call check_sym(grp2,structure_up,lsave=.true.) + call check_sym(grp2,structure_up,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym2(grp2%nsym,3,3)) diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index 6d74879..9ce3c7b 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -740,12 +740,36 @@ end function get_descriptive_ab_shifts !!!############################################################################# !!! generate shifts by filling missing neighours for surface atoms !!!############################################################################# - function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& + function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& bulk_DON,bulk_map,lprint,max_bondlength) result(res_shifts) use artemis__sym, only: gldfnd,confine_type use artemis__geom_utils, only: get_bulk,wyck_spec_type,get_wyckoff use artemis__interface_identifier, only: gen_single_DON,nstep_default,den_of_neigh_type implicit none + type(basis_type), intent(in) :: bas + !! Interface structure + integer, intent(in) :: axis + !! Axis of the interface + real(real32), dimension(:), intent(in) :: intf_loc + !! Location of the interfaces + integer, intent(in) :: nstore + !! Number of shifts to be generated + real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry + real(real32), optional :: c_scale + !! Scaling factor for the interface separation + real(real32), dimension(3), optional, intent(in) :: offset + !! Input offset of the two interface substructures + logical, optional :: lprint + !! Boolean whether to print the shifts + type(bulk_DON_type), dimension(:), optional, intent(in) :: bulk_DON + !! Bulk DONs to be used for the interface + integer, dimension(:,:,:), optional, intent(in) :: bulk_map + !! Mapping of bulk atoms to the interface atoms + real(real32), intent(in), optional :: max_bondlength + !! Cutoff bondlength to consider first neighbours + + integer :: i,j,k,l,is,ia,ja,jb,jc,count1,itmp1 integer :: ntrans,iatom,nneigh,ncheck real(real32) :: stepsize,max_sep,dist_max @@ -766,17 +790,6 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& integer, allocatable, dimension(:,:) :: shift_store real(real32), allocatable, dimension(:,:) :: res_shifts,trans,regions - integer, intent(in) :: axis,nstore - real(real32), intent(in), optional :: max_bondlength - type(basis_type), intent(in) :: bas - real(real32), dimension(:), intent(in) :: intf_loc - real(real32), optional :: c_scale - logical, optional :: lprint - real(real32), dimension(3), optional, intent(in) :: offset - - - integer, dimension(:,:,:), optional, intent(in) :: bulk_map - type(bulk_DON_type), dimension(:), optional, intent(in) :: bulk_DON !integer :: OMP_GET_NUM_THREADS,OMP_GET_MAX_THREADS,OMP_GET_THREAD_NUM,CHUNK @@ -847,7 +860,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,c_scale,offset,& !!!----------------------------------------------------------------------------- min_trans=1._real32 do i=1,2 - call gldfnd(confine,splitbas(i),splitbas(i),trans,ntrans) + call gldfnd(confine, splitbas(i), splitbas(i), trans, ntrans, tol_sym) if(ntrans.eq.0) cycle do j=1,ntrans do k=1,2 diff --git a/src/fortran/lib/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 index 2fc03c0..31a325b 100644 --- a/src/fortran/lib/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -29,7 +29,7 @@ module swapping !!! Main function to be called from ARTEMIS !!!############################################################################# function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& - iswap,seed_arr,sigma,require_mirror) result(bas_arr) + iswap,seed_arr,tol_sym,sigma,require_mirror) result(bas_arr) implicit none integer :: i,j,is,iout,itmp,count1 integer :: axis,nswap @@ -57,6 +57,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& real(real32), dimension(2), intent(in) :: intf_loc !USE 1 type(basis_type), allocatable, dimension(:) :: bas_arr real(real32), dimension(3,3), intent(in) :: lat + real(real32), intent(in) :: tol_sym !!!----------------------------------------------------------------------------- @@ -144,13 +145,13 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& !!! NOT NEEDED? !!! To Replace with lmirror = .false. - call check_sym(grp,tmpbas,lsave=.true.) + call check_sym(grp,tmpbas,lsave=.true., tol_sym=tol_sym) intf_sym_loop: do i=1,grp%nsymop !if(symops(i).eq.1) cycle intf_sym_loop if(abs(grp%sym(i,4,axis)).lt.tiny) cycle intf_sym_loop if(abs(grp%sym(i,axis,axis)+1._real32).gt.tiny) cycle intf_sym_loop intf_sym(1:4,1:4) = grp%sym(i,1:4,1:4) - bas_map = basis_map(intf_sym,tmpbas) + bas_map = basis_map(intf_sym,tmpbas, tol_sym=tol_sym) lmirror = .true. exit intf_sym_loop end do intf_sym_loop @@ -185,7 +186,7 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& 10 deallocate(grp%sym) call sym_setup(grp,lat,new_start=.true.) - call check_sym(grp,tmpbas)!,lsave=.true.) + call check_sym(grp,tmpbas, tol_sym=tol_sym)!,lsave=.true.) dintf=intf_loc(1) @@ -250,11 +251,11 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& lw_close_list,up_close_list,& lw_weight_list,up_weight_list) end select - !call check_sym(tmpbas,itmp) + !call check_sym(tmpbas,itmp,tol_sym=tol_sym) !call loadbar(iout,10) do j=1,iout - call check_sym(grp,bas1=tmpbas,tmpbas2=bas_arr(j))!,itmp,bas_arr(j)) + call check_sym(grp,basis=tmpbas,tmpbas2=bas_arr(j),tol_sym=tol_sym)!,itmp,bas_arr(j)) if(grp%nsymop.ne.0) cycle symloop end do diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index d8e17c0..2bab89c 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -24,9 +24,8 @@ module artemis__sym use artemis__geom_rw, only: basis_type use artemis__geom_utils, only: reducer, primitive_lat implicit none - integer :: ierror_sym=0 integer :: s_start=1,s_end=0 - real(real32) :: tol_sym = 1.E-6_real32 + real(real32) :: tol_sym_default = 1.E-6_real32 character(1) :: verb_sym = "n" integer, allocatable, dimension(:) :: symops_compare @@ -82,8 +81,7 @@ module artemis__sym end type sym_type - public :: set_symmetry_tolerance - public :: ierror_sym,s_start,s_end + public :: s_start,s_end public :: sym_type public :: clone_grp public :: sym_setup,check_sym,gldfnd @@ -104,39 +102,26 @@ module artemis__sym contains -!!!############################################################################# -!!! redefines the symmetry tolerance/precision -!!!############################################################################# - subroutine set_symmetry_tolerance(tolerance) - implicit none - real(real32), optional, intent(in) :: tolerance - - if(present(tolerance))then - tol_sym = tolerance - else - tol_sym = 1.E-6_real32 - end if - - end subroutine set_symmetry_tolerance -!!!############################################################################# - !!!############################################################################# !!! calls mksym and allocates symops and wyckoff arrays !!!############################################################################# - subroutine sym_setup(grp,lat,predefined,new_start,tolerance) + subroutine sym_setup(grp,lat,predefined,new_start,tol_sym) implicit none - + type(sym_type), intent(inout) :: grp real(real32), dimension(3,3), intent(in) :: lat - real(real32), optional, intent(in) :: tolerance - logical, optional, intent(in) :: predefined,new_start + logical, optional, intent(in) :: predefined + logical, optional, intent(in) :: new_start + real(real32), optional, intent(in) :: tol_sym - type(sym_type) :: grp + + real(real32) :: tol_sym_ logical :: predefined_, new_start_ - if(present(tolerance)) call set_symmetry_tolerance(tolerance) + tol_sym_ = tol_sym_default + if(present(tol_sym)) tol_sym_ = tol_sym if(present(new_start))then if(new_start)then if(allocated(grp%op)) deallocate(grp%op) @@ -147,9 +132,9 @@ subroutine sym_setup(grp,lat,predefined,new_start,tolerance) predefined_ = .false. if(present(predefined)) predefined_ = predefined if(predefined_)then - call gen_fundam_sym_matrices(grp,lat) + call gen_fundam_sym_matrices(grp, lat, tol_sym_) else - call mksym(grp,lat) + call mksym(grp, lat, tol_sym_) end if if(allocated(symops_compare)) deallocate(symops_compare) @@ -170,12 +155,29 @@ end subroutine sym_setup !!!############################################################################# !!! tfbas : transformed basis !!!############################################################################# - subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) + subroutine check_sym( & + grp, basis, iperm, tmpbas2, wyckoff, lsave, lat, loc, lcheck_all, & + verbose, tol_sym & + ) implicit none + type(basis_type), intent(in) :: basis + type(sym_type), intent(inout) :: grp + + integer, optional, intent(in) :: iperm + logical, optional, intent(in) :: lsave,lcheck_all + type(basis_type), optional, intent(in) :: tmpbas2 + type(wyck_type), optional, intent(inout) :: wyckoff + real(real32), dimension(3), optional, intent(in) :: loc + real(real32), dimension(3,3), optional, intent(in) :: lat + integer, optional, intent(in) :: verbose + real(real32), optional, intent(in) :: tol_sym + integer :: i,j,k,iatom,jatom,ispec,itmp1 integer :: is,isym,jsym,count,ntrans integer :: samecount,oldnpntop logical :: lpresent,lsaving,lwyckoff,ltransformed + integer :: verbose_ + real(real32) :: tol_sym_ type(basis_type) :: bas2,tfbas real(real32), dimension(3) :: diff real(real32), dimension(3,3) :: ident @@ -183,22 +185,16 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) real(real32), allocatable, dimension(:,:) :: trans real(real32), allocatable, dimension(:,:,:) :: tmpsav - type(basis_type), intent(in) :: bas1 - type(sym_type), intent(inout) :: grp - - integer, optional, intent(in) :: iperm - logical, optional, intent(in) :: lsave,lcheck_all - type(basis_type), optional, intent(in) :: tmpbas2 - type(wyck_type), optional, intent(inout) :: wyckoff - real(real32), dimension(3), optional, intent(in) :: loc - real(real32), dimension(3,3), optional, intent(in) :: lat - + verbose_ = 0 + tol_sym_ = tol_sym_default + if(present(verbose)) verbose_ = verbose + if(present(tol_sym)) tol_sym_ = tol_sym 204 format(4(F11.6),/,4(F11.6),/,4(F11.6),/,4(F11.6)) ! check length of basis - do is = 1, bas1%nspec - if(size(bas1%spec(is)%atom,2).ne.4)then + do is = 1, basis%nspec + if(size(basis%spec(is)%atom,2).ne.4)then write(0,'("ERROR: error encountered in check_sym")') write(0,'(2X,"Internal error in subroutine check_sym in artemis__sym.f90")') write(0,'(2X,"size of basis is not 4")') @@ -211,7 +207,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) !!! allocated grp%op !!!----------------------------------------------------------------------------- if(allocated(grp%op)) deallocate(grp%op) - allocate(grp%op(grp%nsym*minval(bas1%spec(:)%num))) + allocate(grp%op(grp%nsym*minval(basis%spec(:)%num))) grp%op = 0 if(present(lsave))then lsaving = lsave @@ -231,21 +227,21 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) lpresent = .true. end if else - bas2 = bas1 + bas2 = basis lpresent = .false. end if - allocate(tmpsav(grp%nsym*minval(bas1%spec(:)%num),4,4)) - itmp1 = maxval(bas1%spec(:)%num) + allocate(tmpsav(grp%nsym*minval(basis%spec(:)%num),4,4)) + itmp1 = maxval(basis%spec(:)%num) !!!----------------------------------------------------------------------------- !!! initialises variables !!!----------------------------------------------------------------------------- - allocate(trans(minval(bas1%spec(:)%num+2),3)); trans = 0._real32 - allocate(tfbas%spec(bas1%nspec)) - itmp1 = size(bas1%spec(1)%atom(1,:),dim=1) - do is=1,bas1%nspec - allocate(tfbas%spec(is)%atom(bas1%spec(is)%num,itmp1)) + allocate(trans(minval(basis%spec(:)%num+2),3)); trans = 0._real32 + allocate(tfbas%spec(basis%nspec)) + itmp1 = size(basis%spec(1)%atom(1,:),dim=1) + do is=1,basis%nspec + allocate(tfbas%spec(is)%atom(basis%spec(is)%num,itmp1)) end do grp%nsymop = 0 grp%npntop = 0 @@ -254,11 +250,11 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) !!!----------------------------------------------------------------------------- !!! if present, initialises wyckoff arrays !!!----------------------------------------------------------------------------- - allocate(wyck_check(grp%nsym*minval(bas1%spec(:)%num))) - do isym=1,grp%nsym*minval(bas1%spec(:)%num) - allocate(wyck_check(isym)%spec(bas1%nspec)) - do ispec=1,bas1%nspec - allocate(wyck_check(isym)%spec(ispec)%atom(bas1%spec(ispec)%num)) + allocate(wyck_check(grp%nsym*minval(basis%spec(:)%num))) + do isym=1,grp%nsym*minval(basis%spec(:)%num) + allocate(wyck_check(isym)%spec(basis%nspec)) + do ispec=1,basis%nspec + allocate(wyck_check(isym)%spec(ispec)%atom(basis%spec(ispec)%num)) wyck_check(isym)%spec(ispec)%atom = 0 end do end do @@ -266,12 +262,12 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) lwyckoff = .true. if(allocated(wyckoff%spec)) deallocate(wyckoff%spec) wyckoff%nwyck = 0 - allocate(wyckoff%spec(bas1%nspec)) - do ispec=1,bas1%nspec + allocate(wyckoff%spec(basis%nspec)) + do ispec=1,basis%nspec wyckoff%spec(ispec)%num = 0 wyckoff%spec(ispec)%name = "" - allocate(wyckoff%spec(ispec)%atom(bas1%spec(ispec)%num)) - do iatom=1,bas1%spec(ispec)%num + allocate(wyckoff%spec(ispec)%atom(basis%spec(ispec)%num)) + do iatom=1,basis%spec(ispec)%num wyckoff%spec(ispec)%atom(iatom) = iatom end do end do @@ -297,15 +293,15 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) symloop: do isym=s_start,s_end if(verb_sym.eq.'d') write(77,*) isym !,a,b,c if(verb_sym.eq.'d') write(77,204) grp%sym(isym,1:4,1:4) - if(ierror_sym.eq.2.or.ierror_sym.eq.3) write(77,204) & + if(verbose_.eq.2.or.verbose_.eq.3) write(77,204) & grp%sym(isym,1:4,1:4) !------------------------------------------------------------------------ ! apply symmetry operator to basis !------------------------------------------------------------------------ - do ispec=1,bas1%nspec - do iatom=1,bas1%spec(ispec)%num + do ispec=1,basis%nspec + do iatom=1,basis%spec(ispec)%num tfbas%spec(ispec)%atom(iatom,1:3) = & - matmul(bas1%spec(ispec)%atom(iatom,1:4),grp%sym(isym,1:4,1:3)) + matmul(basis%spec(ispec)%atom(iatom,1:4),grp%sym(isym,1:4,1:3)) do j=1,3 tfbas%spec(ispec)%atom(iatom,j) = & tfbas%spec(ispec)%atom(iatom,j) - & @@ -317,31 +313,31 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) ! check whether transformed basis matches original basis !------------------------------------------------------------------------ count=0 - spcheck: do ispec=1,bas1%nspec + spcheck: do ispec=1,basis%nspec diff = 0._real32 samecount = 0 wyck_check(itmp1)%spec(ispec)%atom = 0 - atmcheck: do iatom=1,bas1%spec(ispec)%num - atmcyc: do jatom=1,bas1%spec(ispec)%num + atmcheck: do iatom=1,basis%spec(ispec)%num + atmcyc: do jatom=1,basis%spec(ispec)%num !if(wyck_check(itmp1)%spec(ispec)%atom(jatom).ne.0) cycle atmcyc diff = tfbas%spec(ispec)%atom(iatom,1:3) - & bas2%spec(ispec)%atom(jatom,1:3) diff(:) = diff(:) - floor(diff(:)) - where((abs(diff(:)-1._real32)).lt.(tol_sym)) + where(abs(diff(:)-1._real32).lt.tol_sym_) diff(:)=0._real32 end where - if(sqrt(dot_product(diff,diff)).lt.tol_sym)then + if(sqrt(dot_product(diff,diff)).lt.tol_sym_)then samecount = samecount + 1 wyck_check(itmp1)%spec(ispec)%atom(iatom) = jatom end if - if((iatom.eq.bas1%spec(ispec)%num).and.& - (jatom.eq.bas1%spec(ispec)%num))then - if (samecount.ne.bas1%spec(ispec)%num) goto 10 + if((iatom.eq.basis%spec(ispec)%num).and.& + (jatom.eq.basis%spec(ispec)%num))then + if (samecount.ne.basis%spec(ispec)%num) goto 10 end if end do atmcyc count = count + samecount end do atmcheck - if(samecount.ne.bas1%spec(ispec)%num) goto 10 + if(samecount.ne.basis%spec(ispec)%num) goto 10 end do spcheck grp%npntop = grp%npntop + 1 grp%nsymop = grp%nsymop + 1 @@ -355,7 +351,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) ! checks if translations are valid with the current symmetry operation !------------------------------------------------------------------------ if(grp%lspace) then - if(all(abs(grp%sym(isym,1:3,1:3)-ident).lt.tol_sym))then + if(all(abs(grp%sym(isym,1:3,1:3)-ident).lt.tol_sym_))then ltransformed=.false. else ltransformed=.true. @@ -363,6 +359,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) call gldfnd(grp%confine,& bas2,tfbas,& trans,ntrans,& + tol_sym_,& transformed=ltransformed,& wyck_check=wyck_check(itmp1:)) if(ntrans.gt.0) then @@ -371,21 +368,18 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) exit symloop end if transloop: do i=1,ntrans - if(dot_product(trans(i,:),trans(i,:)).lt.tol_sym) & + if(dot_product(trans(i,:),trans(i,:)).lt.tol_sym_) & cycle transloop - if(ierror_sym.eq.3) write(77,*) trans(i,:) + if(verbose_.eq.3) write(77,*) trans(i,:) if(isym.ne.1)then do jsym=2,grp%nsymop if(grp%op(jsym).eq.1) then if(all(abs(trans(i,1:3)-tmpsav(jsym,4,1:3)).lt.& - tol_sym)) cycle transloop + tol_sym_)) cycle transloop diff = trans(i,1:3) - tmpsav(jsym,4,1:3) - do j=1,3 - diff(j) = diff(j) - floor(diff(j)) - if(diff(j).gt.0.5) diff(j) = diff(j) - 1._real32 - end do + diff = diff - ceiling( diff - 0.5_real32 ) do k=1,i - if(all(abs(diff-trans(k,1:3)).lt.tol_sym)) & + if(all(abs(diff-trans(k,1:3)).lt.tol_sym_)) & cycle transloop end do end if @@ -447,7 +441,7 @@ subroutine check_sym(grp,bas1,iperm,tmpbas2,wyckoff,lsave,lat,loc,lcheck_all) !!!----------------------------------------------------------------------------- if(lwyckoff)then if(present(lat).and.present(loc))then - wyckoff=get_wyckoff_atoms(wyck_check(:grp%nsymop),lat,bas1,loc) + wyckoff=get_wyckoff_atoms(wyck_check(:grp%nsymop),lat,basis,loc) else wyckoff=get_wyckoff_atoms(wyck_check(:grp%nsymop)) end if @@ -462,25 +456,32 @@ end subroutine check_sym !!!############################################################################# !!! supplies the glides (if any) that are required to match the two bases ... -!!! ... "bas" and "tfbas" onto one another +!!! ... "basis1" and "basis2" onto one another !!!############################################################################# - subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) + subroutine gldfnd( & + confine, basis1, basis2, & + trans, ntrans, & + tol_sym, & + transformed, wyck_check & + ) implicit none - integer :: i,j,ispec,iatom,jatom,katom,itmp1 - integer :: minspecloc,samecount - logical :: lwyckoff - real(real32), dimension(3) :: ttrans,tmpbas,diff - real(real32), allocatable, dimension(:,:) :: sav_trans - - integer, intent(out) :: ntrans - type(basis_type), intent(in) :: bas,tfbas type(confine_type), intent(in) :: confine + type(basis_type), intent(in) :: basis1,basis2 real(real32), dimension(:,:), intent(out) :: trans + integer, intent(out) :: ntrans + real(real32), intent(in) :: tol_sym logical, optional, intent(in) :: transformed type(wyck_type), dimension(:), optional, intent(inout) :: wyck_check + integer :: i,j,ispec,iatom,jatom,katom,itmp1 + integer :: minspecloc,samecount + logical :: lwyckoff + real(real32), dimension(3) :: ttrans,tmpbas,diff + real(real32), allocatable, dimension(:,:) :: sav_trans + + !!!----------------------------------------------------------------------------- !!! Allocate arrays and initialise variables @@ -489,16 +490,16 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) trans=0._real32 samecount=0 ntrans=0 - minspecloc=minloc(bas%spec(:)%num,mask=bas%spec(:)%num.ne.0,dim=1) + minspecloc=minloc(basis1%spec(:)%num,mask=basis1%spec(:)%num.ne.0,dim=1) if(present(transformed))then if(.not.transformed)then - if(bas%spec(minspecloc)%num.eq.1) return + if(basis1%spec(minspecloc)%num.eq.1) return end if else - if(bas%spec(minspecloc)%num.eq.1) return + if(basis1%spec(minspecloc)%num.eq.1) return end if - allocate(sav_trans(bas%natom,3)) + allocate(sav_trans(basis1%natom,3)) !!!----------------------------------------------------------------------------- @@ -518,10 +519,10 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) !!! Then tests this translation vector on all other atoms to see if it works ... !!! ... as a translation vector for the symmetry. !!!----------------------------------------------------------------------------- - trloop: do iatom=1,bas%spec(minspecloc)%num - ttrans(:)=0._real32 - ttrans(1:3)=bas%spec(minspecloc)%atom(1,1:3)-& - tfbas%spec(minspecloc)%atom(iatom,1:3) + trloop: do iatom = 1, basis1%spec(minspecloc)%num + ttrans(:) = 0._real32 + ttrans(1:3) = basis1%spec(minspecloc)%atom(1,1:3)-& + basis2%spec(minspecloc)%atom(iatom,1:3) if(all(abs(ttrans(1:3)-anint(ttrans(1:3))).lt.tol_sym)) cycle trloop if(confine%l)then if(confine%laxis(confine%axis).and.& @@ -537,28 +538,26 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) write(0,'(2X,"EXITING SUBROUTINE")') return end if - trcyc: do ispec=1,bas%nspec + trcyc: do ispec = 1, basis1%nspec samecount=0 if(lwyckoff) wyck_check(ntrans+1)%spec(ispec)%atom(:) = 0 - atmcyc2: do jatom=1,bas%spec(ispec)%num + atmcyc2: do jatom=1,basis1%spec(ispec)%num itmp1 = itmp1 + 1 - tmpbas(1:3) = tfbas%spec(ispec)%atom(jatom,1:3) + ttrans(1:3) + tmpbas(1:3) = basis2%spec(ispec)%atom(jatom,1:3) + ttrans(1:3) tmpbas(:) = tmpbas(:) - ceiling(tmpbas(:)-0.5_real32) - atmcyc3: do katom=1,bas%spec(ispec)%num + atmcyc3: do katom=1,basis1%spec(ispec)%num !if(lwyckoff.and.& ! wyck_check(ntrans+1)%spec(ispec)%atom(katom).ne.0) & ! cycle atmcyc3 - diff = tmpbas(1:3) - bas%spec(ispec)%atom(katom,1:3) + diff = tmpbas(1:3) - basis1%spec(ispec)%atom(katom,1:3) do j=1,3 diff(j) = mod((diff(j)+100._real32),1.0) if((abs(diff(j)-1._real32)).lt.(tol_sym)) diff(j) = 0._real32 end do if(sqrt(dot_product(diff,diff)).lt.tol_sym)then samecount = samecount + 1 - !sav_trans(itmp1,:)=bas%spec(ispec)%atom(jatom,1:3)-& - ! bas%spec(ispec)%atom(katom,1:3) - sav_trans(itmp1,:) = bas%spec(ispec)%atom(katom,1:3) - & - tfbas%spec(ispec)%atom(jatom,1:3) + sav_trans(itmp1,:) = basis1%spec(ispec)%atom(katom,1:3) - & + basis2%spec(ispec)%atom(jatom,1:3) sav_trans(itmp1,:) = sav_trans(itmp1,:) - & ceiling(sav_trans(itmp1,:)-0.5_real32) if(lwyckoff) & @@ -568,12 +567,12 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) end do atmcyc3 !cycle trloop end do atmcyc2 - if (samecount.ne.bas%spec(ispec)%num) cycle trloop + if (samecount.ne.basis1%spec(ispec)%num) cycle trloop end do trcyc !!!----------------------------------------------------------------------------- !!! Cleans up succeeded translation vector !!!----------------------------------------------------------------------------- - do j=1,3 + do j = 1, 3 itmp1 = maxloc(abs(sav_trans(:,j)),dim=1) ttrans(j) = sav_trans(itmp1,j) ttrans(j) = ttrans(j) - ceiling(ttrans(j)-0.5_real32) @@ -586,7 +585,7 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) abs(ttrans(confine%axis)-nint(ttrans(confine%axis)))& .gt.tol_sym) cycle trloop else - do i=1,3 + do i = 1, 3 if(confine%laxis(i))then if(abs(ttrans(confine%axis)-floor(ttrans(confine%axis)))& .lt.tol_sym) cycle trloop @@ -596,7 +595,7 @@ subroutine gldfnd(confine,bas,tfbas,trans,ntrans,transformed,wyck_check) !!!----------------------------------------------------------------------------- !!! Checks whether this translation has already been saved !!!----------------------------------------------------------------------------- - do i=1,ntrans + do i = 1, ntrans if(all(ttrans(:).eq.trans(i,:))) cycle trloop !if(all(abs(ttrans(:)-trans(i,:)).lt.tol_sym)) cycle trloop end do @@ -614,14 +613,16 @@ end subroutine gldfnd !!!############################################################################# !!! builds an array of the symmetries that apply to the supplied lattice !!!############################################################################# - subroutine gen_fundam_sym_matrices(grp,lat) + subroutine gen_fundam_sym_matrices(grp, lat, tol_sym) implicit none + type(sym_type), intent(inout) :: grp + real(real32), dimension(3,3), intent(in) :: lat + real(real32), intent(in) :: tol_sym + integer :: i - type(sym_type) :: grp real(real32) :: cosPi3,sinPi3,mcosPi3,msinPi3 real(real32), dimension(3,3) :: inversion,invlat,tmat1 real(real32), dimension(64,3,3) :: fundam_mat - real(real32), dimension(3,3), intent(in) :: lat cosPi3 = 0.5_real32 @@ -802,13 +803,16 @@ end subroutine gen_fundam_sym_matrices !!!############################################################################# !!! builds an array of the symmetries that apply to the supplied lattice !!!############################################################################# - subroutine mksym(grp,inlat) + subroutine mksym(grp, inlat, tol_sym) implicit none + type(sym_type), intent(inout) :: grp + real(real32), dimension(3,3), intent(in) :: inlat + real(real32), intent(in) :: tol_sym + integer :: amin,bmin,cmin integer :: i,j,ia,ib,ic,n,count,irot,nrot,isym,jsym real(real32) :: tht,a,b,c - type(sym_type) :: grp - real(real32), dimension(3,3) :: rotmat,refmat,inlat,lat,invlat,tmat1 + real(real32), dimension(3,3) :: rotmat,refmat,lat,invlat,tmat1 real(real32), allocatable, dimension(:,:,:) :: tsym1,tsym2 logical, dimension(3) :: laxis @@ -1020,13 +1024,15 @@ end subroutine clone_grp !!!############################################################################# !!! returns the primitive cell from a supercell !!!############################################################################# - subroutine get_primitive_cell(basis) + subroutine get_primitive_cell(basis, tol_sym) implicit none type(basis_type), intent(inout) :: basis + real(real32), intent(in), optional :: tol_sym integer :: is,ia,ja,i,j,k,itmp1 integer :: ntrans,len real(real32) :: scale,proj,dtmp1 + real(real32) :: tol_sym_ type(confine_type) :: confine real(real32), dimension(3,3) :: dmat1,invlat real(real32), allocatable, dimension(:,:) :: trans,atom_store @@ -1036,6 +1042,8 @@ subroutine get_primitive_cell(basis) !!----------------------------------------------------------------------- !! Allocate and initialise !!----------------------------------------------------------------------- + tol_sym_ = tol_sym_default + if(present(tol_sym)) tol_sym_ = tol_sym ntrans = 0 dmat1=0._real32 allocate(trans(minval(basis%spec(:)%num+2),3)); trans=0._real32 @@ -1044,7 +1052,7 @@ subroutine get_primitive_cell(basis) !!----------------------------------------------------------------------- !! Find the translation vectors in the cell !!----------------------------------------------------------------------- - call gldfnd(confine,basis,basis,trans,ntrans,.false.) + call gldfnd(confine,basis,basis,trans,ntrans,tol_sym,.false.) len=size(basis%spec(1)%atom,dim=2) @@ -1370,15 +1378,17 @@ end function get_wyckoff_atoms_loc !!! ... maps basis1 atoms onto. !!! Basis2 is optional. If missing, it uses basis1 for the comparison !!!############################################################################# - function basis_map(sym,bas1,tmpbas2) result(bas_map) + function basis_map(sym,bas1,tmpbas2, tol_sym) result(bas_map) implicit none + real(real32), dimension(4,4), intent(in) :: sym + type(basis_type), intent(in) :: bas1 + type(basis_type), optional, intent(in) :: tmpbas2 + real(real32), intent(in), optional :: tol_sym + integer :: j,ispec,iatom,jatom,dim type(basmap_type) :: bas_map type(basis_type) :: bas2,tfbas real(real32), dimension(3) :: diff - type(basis_type), intent(in) :: bas1 - real(real32), dimension(4,4), intent(in) :: sym - type(basis_type), optional, intent(in) :: tmpbas2 !!!----------------------------------------------------------------------------- diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index fef5052..bd690b8 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -49,7 +49,7 @@ module artemis__terminations !############################################################################### function get_termination_info( & - basis, axis, verbose, layer_sep, break_on_fail & + basis, axis, verbose, tol_sym, layer_sep, break_on_fail & ) result(term) !! Function to find the terminations of a material along a given axis implicit none @@ -62,6 +62,8 @@ function get_termination_info( & !! 1=a, 2=b, 3=c integer, intent(in) :: verbose !! Verbosity level + real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry operations real(real32), intent(in), optional :: layer_sep !! Minimum separation between layers logical, intent(in), optional :: break_on_fail @@ -266,7 +268,7 @@ function get_termination_info( & ! this is done to constrain the matching of two basises in certain directions grp_store%confine%l = .false. grp_store%confine%laxis(axis) = .false. - call check_sym(grp_store,bas1=basis,iperm=-1,lsave=.true.) + call check_sym(grp_store,basis=basis,iperm=-1,lsave=.true.,tol_sym=tol_sym) inv_mat = 0._real32 do i=1,3 inv_mat(i,i) = -1._real32 @@ -308,8 +310,8 @@ function get_termination_info( & abs(term_arr_uniq(j)%hmax-term_arr_uniq(j)%hmin)).gt.tolerance) & cycle sym_loop1 call clone_grp(grp_store,grp1) - call check_sym(grp1,bas1=basis_arr(mterm),& - iperm=-1,tmpbas2=basis_arr(j),lsave=.true.) + call check_sym(grp1,basis=basis_arr(mterm),& + iperm=-1,tmpbas2=basis_arr(j),lsave=.true.,tol_sym=tol_sym) if(grp1%nsymop.ne.0)then if(grp1%sym_save(1,axis,axis).eq.-1._real32)then ireject = ireject + 1 @@ -376,7 +378,7 @@ function get_termination_info( & else call clone_grp(grp_store,grp1) call check_sym(grp1,basis_arr(itmp2),& - iperm=-1,lsave=.true.,lcheck_all=.true.) + iperm=-1,lsave=.true.,lcheck_all=.true.,tol_sym=tol_sym) ltmp1=.false. ! Check if pure translations are present in comparison termination? @@ -394,7 +396,8 @@ function get_termination_info( & call clone_grp(grp_store,grp1) call check_sym(grp1,basis_arr(itmp2),& - tmpbas2=basis_arr_reject(i),iperm=-1,lsave=.true.,lcheck_all=.true.) + tmpbas2=basis_arr_reject(i),iperm=-1,lsave=.true.,& + lcheck_all=.true., tol_sym=tol_sym) ! Check det of all symmetry operations. If any are 1, move on ! This is because they are just rotations as can be captured ... From 500185b5a10146ee416ca5c8c19c33f740080845 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 11:28:12 +0100 Subject: [PATCH 076/137] Remove dev printing --- src/fortran/lib/mod_generator.f90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index ec40bc4..47d5513 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1212,7 +1212,6 @@ subroutine generate_interfaces( & !--------------------------------------------------------------------------- ! Retrieve the primitive cells if necessary !--------------------------------------------------------------------------- - write(*,*) "tar0" if(this%use_pricel_lw)then if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for lower material")') call get_primitive_cell(structure_lw, tol_sym=this%tol_sym) @@ -1229,7 +1228,6 @@ subroutine generate_interfaces( & call reducer(structure_up) structure_up%lat = primitive_lat(structure_up%lat) end if - write(*,*) "tar1" !--------------------------------------------------------------------------- @@ -1266,7 +1264,6 @@ subroutine generate_interfaces( & call stop_program(trim(err_msg)) end select end if - write(*,*) "tar2" ludef_surface_lw = .false. ludef_surface_up = .false. @@ -1295,7 +1292,6 @@ subroutine generate_interfaces( & " One of these must be greater than 0." call stop_program(trim(err_msg)) end if - write(*,*) "tar3" !--------------------------------------------------------------------------- @@ -1309,7 +1305,6 @@ subroutine generate_interfaces( & if(verbose_.gt.0) write(*,'(1X,"Avg min bulk bond: ",F0.3," Å")') avg_min_bond if(verbose_.gt.0) write(*,'(1X,"Trans-interfacial scaling factor: ",F0.3)') this%separation_scale if(this%shift_method.eq.-1) this%num_shifts = 1 - write(*,*) "tar4" !--------------------------------------------------------------------------- @@ -1385,7 +1380,6 @@ subroutine generate_interfaces( & lw_map=-1 up_map=-1 end if - write(*,*) "tar1" !--------------------------------------------------------------------------- @@ -1434,7 +1428,6 @@ subroutine generate_interfaces( & elseif(this%is_layered_up.and.layered_axis_up.gt.0.and.all(miller_up.eq.0))then miller_up(layered_axis_up)=1 end if - write(*,*) "tar2" !--------------------------------------------------------------------------- @@ -1492,7 +1485,6 @@ subroutine generate_interfaces( & if(verbose_.gt.0) write(*,'(1X,"Told not to generate structures, just find matches.")') return end if - write(*,*) "tar3" !!!----------------------------------------------------------------------------- From 0ffa02e228d9409c3288f85f3161ff1a2e0e3712 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 14:39:29 +0100 Subject: [PATCH 077/137] Reduce use of global variables --- app/inputs.f90 | 4 +- src/fortran/lib/mod_generator.f90 | 30 +++++- src/fortran/lib/mod_geom_utils.f90 | 28 +++--- src/fortran/lib/mod_lat_compare.f90 | 6 +- src/fortran/lib/mod_swapping.f90 | 8 +- src/fortran/lib/mod_sym.f90 | 151 +++++++++++++--------------- 6 files changed, 121 insertions(+), 106 deletions(-) diff --git a/app/inputs.f90 b/app/inputs.f90 index 260ab2a..8585435 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -744,8 +744,8 @@ subroutine read_card_interfaces(unit,count,skip) end if call assign(buffer,lw_num_layers, readvar(3)) case("UP_NUM_LAYERS", "UP_SLAB_THICKNESS") - if(index(buffer,"LW_SLAB_THICKNESS").ne.0)then - write(0,'(1X,A)') "WARNING: UP_SLAB_THICKNESS is deprecated, use LW_NUM_LAYERS instead" + if(index(buffer,"UP_SLAB_THICKNESS").ne.0)then + write(0,'(1X,A)') "WARNING: UP_SLAB_THICKNESS is deprecated, use UP_NUM_LAYERS instead" end if call assign(buffer,up_num_layers, readvar(4)) case("LW_MILLER") diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 47d5513..5ed6d67 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -769,8 +769,16 @@ function get_terminations( & structure, this%axis, & verbose = verbose_, tol_sym = this%tol_sym, & layer_sep = layer_sep, & - break_on_fail = break_on_fail_ & + exit_code = exit_code_ & ) + if(exit_code_.ne.0)then + write(err_msg,'(A,I0,A)') & + "The termination generator failed with exit code ", exit_code_ + if(break_on_fail_)then + call stop_program(trim(err_msg)) + return + end if + end if if(term%nterm .eq. 0)then write(warn_msg, '(A,I0,1X,I0,1X,I0,A)') & "No terminations found for Miller plane (",miller_,")" @@ -1598,8 +1606,16 @@ subroutine generate_interfaces( & verbose = merge(1,verbose_,print_termination_info_), & tol_sym = this%tol_sym, & layer_sep = this%layer_separation_cutoff(1), & - break_on_fail = break_on_fail_ & + exit_code = exit_code_ & ) + if(exit_code_.ne.0)then + write(err_msg,'(A,I0,A)') & + "The termination generator failed with exit code ", exit_code_ + if(break_on_fail_)then + call stop_program(trim(err_msg)) + return + end if + end if if(lw_term%nterm .eq. 0)then write(0,'("WARNING: & &No terminations found for lower material Miller plane & @@ -1683,8 +1699,16 @@ subroutine generate_interfaces( & verbose = merge(1,verbose_,print_termination_info_), & tol_sym = this%tol_sym, & layer_sep = this%layer_separation_cutoff(2), & - break_on_fail = break_on_fail_ & + exit_code = exit_code_ & ) + if(exit_code_.ne.0)then + write(err_msg,'(A,I0,A)') & + "The termination generator failed with exit code ", exit_code_ + if(break_on_fail_)then + call stop_program(trim(err_msg)) + return + end if + end if if(up_term%nterm .eq. 0)then write(0,'("WARNING: & &No terminations found for upper material Miller plane & diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 17bac29..f62f5fd 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -430,23 +430,23 @@ end function get_min_dist !!!############################################################################# !!! Shifts the basis along a, b or c by amount 'shift' !!!############################################################################# - subroutine shifter(bas,axis,shift,ltmp) + subroutine shifter(basis,axis,shift,renormalise) implicit none - integer :: i,j,k,axis - real(real32) :: shift - type(basis_type) :: bas - logical, optional ::ltmp - logical :: lrenorm + type(basis_type), intent(inout) :: basis + integer, intent(in) :: axis + real(real32), intent(in) :: shift + logical, optional, intent(in) ::renormalise + integer :: i,j + logical :: renormalise_ - k=axis - lrenorm=.false. - if(present(ltmp)) lrenorm=ltmp + renormalise_=.false. + if(present(renormalise)) renormalise_ = renormalise - do i=1,bas%nspec - do j=1,bas%spec(i)%num - bas%spec(i)%atom(j,k)=bas%spec(i)%atom(j,k) + shift - if(lrenorm) bas%spec(i)%atom(j,k)=bas%spec(i)%atom(j,k) - & - floor(bas%spec(i)%atom(j,k)) + do i=1,basis%nspec + do j=1,basis%spec(i)%num + basis%spec(i)%atom(j,axis) = basis%spec(i)%atom(j,axis) + shift + if(renormalise_) basis%spec(i)%atom(j,axis) = basis%spec(i)%atom(j,axis) - & + floor(basis%spec(i)%atom(j,axis)) end do end do diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index 4410ddc..edf960d 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -913,14 +913,12 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- !! finds and stores symmetry operations for each lattice !!-------------------------------------------------------------------------- - s_end=0 - call sym_setup(grp1,lat1)!,predefined=.true.,new_start=.true.) + call sym_setup(grp1,lat1, tol_sym=tol_sym,new_start=.true.)!,predefined=.true.) call check_sym(grp1,structure_lw,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym1(grp1%nsym,3,3)) - s_end=0 - call sym_setup(grp2,lat2)!,predefined=.true.,new_start=.true.) + call sym_setup(grp2,lat2, tol_sym=tol_sym,new_start=.true.)!,predefined=.true.) call check_sym(grp2,structure_up,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym2(grp2%nsym,3,3)) diff --git a/src/fortran/lib/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 index 31a325b..1c84a07 100644 --- a/src/fortran/lib/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -9,12 +9,12 @@ module swapping use misc_maths, only: gauss use misc_linalg, only: modu use artemis__geom_rw, only: basis_type - use artemis__sym, only: sym_setup,check_sym,sym_type,basmap_type,basis_map + use artemis__sym, only: sym_setup,check_sym,sym_type,basis_map_type,basis_map use artemis__io_utils, only: err_abort implicit none real(real32) :: tiny=5.E-5_real32 logical :: lmirror - type(basmap_type) :: bas_map + type(basis_map_type) :: bas_map private @@ -121,7 +121,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& !!!----------------------------------------------------------------------------- !!! set up symmetries !!!----------------------------------------------------------------------------- - call sym_setup(grp,lat) + call sym_setup(grp,lat, tol_sym = tol_sym) call tmpbas%copy(bas) call store_bas%copy(tmpbas) @@ -185,7 +185,7 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& end if 10 deallocate(grp%sym) - call sym_setup(grp,lat,new_start=.true.) + call sym_setup(grp,lat,new_start=.true., tol_sym = tol_sym) call check_sym(grp,tmpbas, tol_sym=tol_sym)!,lsave=.true.) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 2bab89c..240eaa3 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -24,9 +24,7 @@ module artemis__sym use artemis__geom_rw, only: basis_type use artemis__geom_utils, only: reducer, primitive_lat implicit none - integer :: s_start=1,s_end=0 real(real32) :: tol_sym_default = 1.E-6_real32 - character(1) :: verb_sym = "n" integer, allocatable, dimension(:) :: symops_compare interface get_wyckoff_atoms @@ -51,9 +49,9 @@ module artemis__sym type spcmap_type integer, allocatable ,dimension(:) :: atom end type spcmap_type - type basmap_type + type basis_map_type type(spcmap_type), allocatable, dimension(:) :: spec - end type basmap_type + end type basis_map_type type confine_type !! apply any confinement/constraints on symmetries @@ -74,6 +72,7 @@ module artemis__sym integer :: npntop = 0 logical :: lspace = .true. logical :: lmolec = .false. + integer :: start_idx = 1, end_idx =0 integer, allocatable, dimension(:) :: op real(real32), allocatable, dimension(:,:,:) :: sym type(confine_type) :: confine @@ -81,7 +80,6 @@ module artemis__sym end type sym_type - public :: s_start,s_end public :: sym_type public :: clone_grp public :: sym_setup,check_sym,gldfnd @@ -90,12 +88,7 @@ module artemis__sym public :: confine_type - public :: basmap_type,basis_map - - public :: wyck_type - public :: get_wyckoff_atoms - - public :: symops_compare + public :: basis_map_type, basis_map !!!updated 2023/02/14 @@ -142,8 +135,8 @@ subroutine sym_setup(grp,lat,predefined,new_start,tol_sym) new_start_ = .true. if(present(new_start)) new_start_ = new_start - if(new_start_.or.s_end.eq.0)then - s_end=grp%nsym + if(new_start_.or.grp%end_idx.eq.0)then + grp%end_idx = grp%nsym end if end subroutine sym_setup @@ -156,7 +149,7 @@ end subroutine sym_setup !!! tfbas : transformed basis !!!############################################################################# subroutine check_sym( & - grp, basis, iperm, tmpbas2, wyckoff, lsave, lat, loc, lcheck_all, & + grp, basis, iperm, tmpbas2, wyckoff, lsave, lat, loc, check_all_sym, & verbose, tol_sym & ) implicit none @@ -164,7 +157,7 @@ subroutine check_sym( & type(sym_type), intent(inout) :: grp integer, optional, intent(in) :: iperm - logical, optional, intent(in) :: lsave,lcheck_all + logical, optional, intent(in) :: lsave,check_all_sym type(basis_type), optional, intent(in) :: tmpbas2 type(wyck_type), optional, intent(inout) :: wyckoff real(real32), dimension(3), optional, intent(in) :: loc @@ -175,10 +168,11 @@ subroutine check_sym( & integer :: i,j,k,iatom,jatom,ispec,itmp1 integer :: is,isym,jsym,count,ntrans integer :: samecount,oldnpntop - logical :: lpresent,lsaving,lwyckoff,ltransformed + logical :: lsave_,lwyckoff,ltransformed, is_a_symmetry integer :: verbose_ + logical :: check_all_sym_ real(real32) :: tol_sym_ - type(basis_type) :: bas2,tfbas + type(basis_type) :: basis2, tfbas real(real32), dimension(3) :: diff real(real32), dimension(3,3) :: ident type(wyck_type), allocatable, dimension(:) :: wyck_check @@ -210,25 +204,21 @@ subroutine check_sym( & allocate(grp%op(grp%nsym*minval(basis%spec(:)%num))) grp%op = 0 if(present(lsave))then - lsaving = lsave + lsave_ = lsave else - lsaving = .false. + lsave_ = .false. end if !!!----------------------------------------------------------------------------- !!! checks for optional arguments and assigns values if not present !!!----------------------------------------------------------------------------- + check_all_sym_ = .true. if(present(tmpbas2)) then - bas2 = tmpbas2 - if(present(lcheck_all))then - lpresent = .not.lcheck_all - else - lpresent = .true. - end if + call basis2%copy(tmpbas2) + if(present(check_all_sym)) check_all_sym_ = check_all_sym else - bas2 = basis - lpresent = .false. + call basis2%copy(basis) end if allocate(tmpsav(grp%nsym*minval(basis%spec(:)%num),4,4)) itmp1 = maxval(basis%spec(:)%num) @@ -290,16 +280,14 @@ subroutine check_sym( & !!! applying symmetries to basis to see if the basis conforms to any of them !!!----------------------------------------------------------------------------- itmp1 = 1 - symloop: do isym=s_start,s_end - if(verb_sym.eq.'d') write(77,*) isym !,a,b,c - if(verb_sym.eq.'d') write(77,204) grp%sym(isym,1:4,1:4) - if(verbose_.eq.2.or.verbose_.eq.3) write(77,204) & + symloop: do isym = grp%start_idx, grp%end_idx, 1 + if(verbose_.eq.2.or.verbose_.eq.3) write(*,204) & grp%sym(isym,1:4,1:4) !------------------------------------------------------------------------ ! apply symmetry operator to basis !------------------------------------------------------------------------ - do ispec=1,basis%nspec - do iatom=1,basis%spec(ispec)%num + do ispec = 1, basis%nspec, 1 + do iatom = 1, basis%spec(ispec)%num, 1 tfbas%spec(ispec)%atom(iatom,1:3) = & matmul(basis%spec(ispec)%atom(iatom,1:4),grp%sym(isym,1:4,1:3)) do j=1,3 @@ -313,15 +301,16 @@ subroutine check_sym( & ! check whether transformed basis matches original basis !------------------------------------------------------------------------ count=0 - spcheck: do ispec=1,basis%nspec + is_a_symmetry = .true. + spcheck: do ispec = 1, basis%nspec, 1 diff = 0._real32 samecount = 0 wyck_check(itmp1)%spec(ispec)%atom = 0 - atmcheck: do iatom=1,basis%spec(ispec)%num - atmcyc: do jatom=1,basis%spec(ispec)%num + atmcheck: do iatom = 1, basis%spec(ispec)%num, 1 + atmcyc: do jatom = 1, basis%spec(ispec)%num, 1 !if(wyck_check(itmp1)%spec(ispec)%atom(jatom).ne.0) cycle atmcyc diff = tfbas%spec(ispec)%atom(iatom,1:3) - & - bas2%spec(ispec)%atom(jatom,1:3) + basis2%spec(ispec)%atom(jatom,1:3) diff(:) = diff(:) - floor(diff(:)) where(abs(diff(:)-1._real32).lt.tol_sym_) diff(:)=0._real32 @@ -332,20 +321,28 @@ subroutine check_sym( & end if if((iatom.eq.basis%spec(ispec)%num).and.& (jatom.eq.basis%spec(ispec)%num))then - if (samecount.ne.basis%spec(ispec)%num) goto 10 + if (samecount.ne.basis%spec(ispec)%num)then + is_a_symmetry = .false. + exit spcheck + end if end if end do atmcyc count = count + samecount end do atmcheck - if(samecount.ne.basis%spec(ispec)%num) goto 10 + if(samecount.ne.basis%spec(ispec)%num)then + is_a_symmetry = .false. + exit spcheck + end if end do spcheck - grp%npntop = grp%npntop + 1 - grp%nsymop = grp%nsymop + 1 - itmp1 = grp%nsymop + 1 - tmpsav(grp%nsymop,:,:) = grp%sym(isym,:,:) - grp%op(grp%nsymop) = isym - if(grp%nsymop.ne.0.and.lpresent) exit symloop -10 trans = 0._real32 + if(is_a_symmetry)then + grp%npntop = grp%npntop + 1 + grp%nsymop = grp%nsymop + 1 + itmp1 = grp%nsymop + 1 + tmpsav(grp%nsymop,:,:) = grp%sym(isym,:,:) + grp%op(grp%nsymop) = isym + if(grp%nsymop.ne.0.and..not.check_all_sym_) exit symloop + end if + trans = 0._real32 ntrans = 0 !------------------------------------------------------------------------ ! checks if translations are valid with the current symmetry operation @@ -357,20 +354,20 @@ subroutine check_sym( & ltransformed=.true. end if call gldfnd(grp%confine,& - bas2,tfbas,& + basis2,tfbas,& trans,ntrans,& tol_sym_,& transformed=ltransformed,& wyck_check=wyck_check(itmp1:)) if(ntrans.gt.0) then - if(lpresent.and..not.lsaving)then + if(.not.check_all_sym_.and..not.lsave_)then grp%nsymop = grp%nsymop + 1 exit symloop end if - transloop: do i=1,ntrans + transloop: do i = 1, ntrans, 1 if(dot_product(trans(i,:),trans(i,:)).lt.tol_sym_) & cycle transloop - if(verbose_.eq.3) write(77,*) trans(i,:) + if(verbose_.eq.3) write(*,*) trans(i,:) if(isym.ne.1)then do jsym=2,grp%nsymop if(grp%op(jsym).eq.1) then @@ -391,7 +388,7 @@ subroutine check_sym( & tmpsav(grp%nsymop,4,1:3) = trans(i,:) grp%op(grp%nsymop) = isym end do transloop - if(lpresent) exit symloop + if(.not.check_all_sym_) exit symloop end if end if oldnpntop = grp%npntop @@ -401,7 +398,7 @@ subroutine check_sym( & !!!----------------------------------------------------------------------------- !!! allocates and saves the array sym_save if the first time submitted !!!----------------------------------------------------------------------------- - if(lsaving)then + if(lsave_)then if(allocated(grp%sym_save)) deallocate(grp%sym_save) allocate(grp%sym_save(grp%nsymop,4,4)) grp%sym_save=0._real32 @@ -429,7 +426,7 @@ subroutine check_sym( & end if iperm_if - if(lsaving)then + if(lsave_)then deallocate(grp%sym) call move_alloc(grp%sym_save, grp%sym) grp%nsym = grp%nsymop @@ -447,9 +444,6 @@ subroutine check_sym( & end if end if - - - return end subroutine check_sym !!!############################################################################# @@ -596,8 +590,7 @@ subroutine gldfnd( & !!! Checks whether this translation has already been saved !!!----------------------------------------------------------------------------- do i = 1, ntrans - if(all(ttrans(:).eq.trans(i,:))) cycle trloop - !if(all(abs(ttrans(:)-trans(i,:)).lt.tol_sym)) cycle trloop + if(all(abs(ttrans(:)-trans(i,:)).lt.tol_sym)) cycle trloop end do ntrans = ntrans + 1 trans(ntrans,1:3) = ttrans(1:3) @@ -818,21 +811,21 @@ subroutine mksym(grp, inlat, tol_sym) if(grp%confine%l)then - laxis=grp%confine%laxis + laxis = grp%confine%laxis else - laxis=.not.grp%confine%laxis + laxis = .not.grp%confine%laxis end if !!!----------------------------------------------------------------------------- !!! set up inverse lattice !!!----------------------------------------------------------------------------- - lat=inlat + lat = inlat if(grp%lmolec)then - invlat=0._real32 - lat=0._real32 + invlat = 0._real32 + lat = 0._real32 else - invlat=inverse_3x3(lat) + invlat = inverse_3x3(lat) end if @@ -840,9 +833,9 @@ subroutine mksym(grp, inlat, tol_sym) !!! initialise values and symmetry matrix !!!----------------------------------------------------------------------------- allocate(tsym1(50000,4,4)) - tsym1=0._real32 + tsym1 = 0._real32 tsym1(:,4,4)=1._real32 - count=0 + count = 0 !!!----------------------------------------------------------------------------- @@ -968,8 +961,8 @@ subroutine mksym(grp, inlat, tol_sym) tsym2(:,4,4)=1._real32 count=0 samecheck: do isym=1,grp%nsym - tmat1=matmul((invlat),tsym1(isym,:3,:3)) - tmat1=matmul(tmat1,(lat)) + tmat1 = matmul((invlat),tsym1(isym,:3,:3)) + tmat1 = matmul(tmat1,(lat)) do i=1,3 do j=1,3 if(abs(tmat1(i,j)).lt.tol_sym) tmat1(i,j)=0._real32 @@ -983,12 +976,11 @@ subroutine mksym(grp, inlat, tol_sym) if(abs(abs(det(tmat1))-1._real32).gt.tol_sym) cycle samecheck !!----------------------------------------------------------------------- if(.not.all(abs(tmat1-nint(tmat1)).lt.tol_sym)) cycle samecheck - do jsym=1,count + do jsym = 1, count, 1 if(all(abs(tmat1-tsym2(jsym,:3,:3)).lt.tol_sym)) cycle samecheck - !if(all(tsym1(isym,:3,:3).eq.tsym2(jsym,:3,:3))) cycle samecheck end do - count=count+1 - tsym2(count,:3,:3)=tmat1 + count = count + 1 + tsym2(count,:3,:3) = tmat1 end do samecheck grp%nsym=count deallocate(tsym1) @@ -1007,15 +999,16 @@ end subroutine mksym !!!############################################################################# !!! clone ingrp to outgrp !!!############################################################################# - subroutine clone_grp(ingrp,outgrp) + subroutine clone_grp(from, to) implicit none - type(sym_type), intent(in) :: ingrp - type(sym_type), intent(out) :: outgrp + type(sym_type), intent(in) :: from + type(sym_type), intent(out) :: to - allocate(outgrp%op(size(ingrp%op))) - allocate(outgrp%sym(size(ingrp%sym(:,1,1)),4,4)) - outgrp = ingrp + if(allocated(from%op)) allocate(to%op(size(from%op))) + if(allocated(from%sym)) allocate(to%sym(size(from%sym,dim=1),4,4)) + if(allocated(from%sym_save)) allocate(to%sym_save(size(from%sym_save,dim=1),4,4)) + to = from end subroutine clone_grp !!!############################################################################# @@ -1386,7 +1379,7 @@ function basis_map(sym,bas1,tmpbas2, tol_sym) result(bas_map) real(real32), intent(in), optional :: tol_sym integer :: j,ispec,iatom,jatom,dim - type(basmap_type) :: bas_map + type(basis_map_type) :: bas_map type(basis_type) :: bas2,tfbas real(real32), dimension(3) :: diff From 4af62ffaddc0937147af7a915a986f3e72620289 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 15:10:38 +0100 Subject: [PATCH 078/137] Reorder symmetry matrices --- src/fortran/lib/mod_lat_compare.f90 | 64 ++++----- src/fortran/lib/mod_plane_matching.f90 | 32 ++--- src/fortran/lib/mod_sym.f90 | 192 ++++++++++++------------- src/fortran/lib/mod_terminations.f90 | 106 ++++++-------- 4 files changed, 189 insertions(+), 205 deletions(-) diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index edf960d..3d500b0 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -915,12 +915,12 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- call sym_setup(grp1,lat1, tol_sym=tol_sym,new_start=.true.)!,predefined=.true.) call check_sym(grp1,structure_lw,lsave=.true.,tol_sym=tol_sym) - allocate(tmpsym1(grp1%nsym,3,3)) + allocate(tmpsym1(3,3,grp1%nsym)) call sym_setup(grp2,lat2, tol_sym=tol_sym,new_start=.true.)!,predefined=.true.) call check_sym(grp2,structure_up,lsave=.true.,tol_sym=tol_sym) - allocate(tmpsym2(grp2%nsym,3,3)) + allocate(tmpsym2(3,3,grp2%nsym)) !!-------------------------------------------------------------------------- @@ -946,7 +946,7 @@ subroutine lattice_matching( & m2=floor((i2)/2.0)*(-1)**i2 mloop3: do i3=1,loopsize m3=floor((i3)/2.0)*(-1)**i3 - if ( .not.is_unique( [ m1, m2, m3 ], grp1%sym(:,:3,:3) ) ) & + if ( .not.is_unique( [ m1, m2, m3 ], grp1%sym(:3,:3,:) ) ) & cycle mloop3 itmp1 = itmp1 + 1 ivtmp1(itmp1,:) = [ m1, m2, m3 ] @@ -984,7 +984,7 @@ subroutine lattice_matching( & m2=floor((i2)/2.0)*(-1)**i2 mloop6: do i3=1,loopsize m3=floor((i3)/2.0)*(-1)**i3 - if ( .not.is_unique( (/m1,m2,m3/), grp2%sym(:,:3,:3) ) ) & + if ( .not.is_unique( (/m1,m2,m3/), grp2%sym(:3,:3,:) ) ) & cycle mloop6 itmp1=itmp1+1 ivtmp1(itmp1,:)=(/m1,m2,m3/) @@ -1025,18 +1025,18 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- !! cycles through the unique miller planes to find matches !!-------------------------------------------------------------------------- - allocate(tmpsym(max(grp1%nsym,grp2%nsym),3,3)) + allocate(tmpsym(3,3,max(grp1%nsym,grp2%nsym))) MAINLOOP1: do m1 = 1, size( miller1, dim = 1 ) transform1 = nint(planecutter(lat1,real(miller1(m1,:),real32))) if (all(transform1 .eq. 0)) cycle MAINLOOP1 templat1 = matmul(transform1,lat1) tmpsym = 0._real32 do i=1,grp1%nsym - tmpsym(i,:3,:3) = & - matmul(grp1%sym(i,:3,:3),inverse_3x3(real(transform1,real32))) + tmpsym(:3,:3,i) = & + matmul(grp1%sym(:3,:3,i),inverse_3x3(real(transform1,real32))) ! next step required to transform properly into the space? - tmpsym(i,:3,:3) = & - matmul(real(transform1,real32),tmpsym(i,:3,:3)) + tmpsym(:3,:3,i) = & + matmul(real(transform1,real32),tmpsym(:3,:3,i)) end do nsym1=0 @@ -1044,33 +1044,33 @@ subroutine lattice_matching( & !!! IS THIS REASONABLE TO DO IT THIS WAY? OR DO WE NEED TO CHANGE sym TO BE IN THE NEW LAT? !!! Wait, should it be instead that the cross product of the a-b plane is always consistent? rvec1=cross([templat1(1,:)],[templat1(2,:)]) - do i=1,grp1%nsym - rmat1=matmul(tmpsym(i,:3,:3),templat1(:,:)) + do i = 1, grp1%nsym, 1 + rmat1=matmul(tmpsym(:3,:3,i),templat1(:,:)) rvec2=cross([rmat1(1,:)],[rmat1(2,:)]) if(all(abs( rvec1(:) - rvec2(:) ).lt.1.E-8_real32).or.& all(abs( rvec1(:) + rvec2(:) ).lt.1.E-8_real32))then nsym1 = nsym1 + 1 - tmpsym1(nsym1,:3,:3) = tmpsym(i,:3,:3) + tmpsym1(:3,:3,nsym1) = tmpsym(:3,:3,i) else cycle end if ! redundant if a-b plane works instead. !if(all(& - ! abs( templat1(3,:) - matmul(templat1(3,:),tmpsym(i,:3,:3)) )& + ! abs( templat1(3,:) - matmul(templat1(3,:),tmpsym(:3,:3,i)) )& ! .lt.1.E-8_real32).or.& ! all(& - ! abs( templat1(3,:) + matmul(templat1(3,:),tmpsym(i,:3,:3)) )& + ! abs( templat1(3,:) + matmul(templat1(3,:),tmpsym(:3,:3,i)) )& ! .lt.1.E-8_real32))then ! nsym1=nsym1+1 - ! tmpsym1(nsym1,:3,:3) = tmpsym(i,:3,:3) + ! tmpsym1(:3,:3,nsym1) = tmpsym(:3,:3,i) !end if !write(0,*) "################################" !write(0,*) i - !write(0,'(3(2X,F7.2))') tmpsym(i,:3,:3) + !write(0,'(3(2X,F7.2))') tmpsym(:3,:3,i) !write(0,*) - !write(0,'(3(2X,F7.2))') rvec1!(templat1(j,:),j=1,3)!(grp1%sym(i,j,:3),j=1,3) !tmpsym(i,:3,:3) + !write(0,'(3(2X,F7.2))') rvec1!(templat1(j,:),j=1,3)!(grp1%sym(j,:3,i),j=1,3) !tmpsym(:3,:3,i) !write(0,*) - !write(0,'(3(2X,F7.2))') rvec2!matmul(templat1(3,:),tmpsym(i,:3,:3))!(tmpsym(i,j,:3),j=1,3) + !write(0,'(3(2X,F7.2))') rvec2!matmul(templat1(3,:),tmpsym(:3,:3,i))!(tmpsym(j,:3,i),j=1,3) end do !stop @@ -1081,29 +1081,29 @@ subroutine lattice_matching( & templat2 = matmul(transform2,lat2) tmpsym=0._real32 - do i=1,grp2%nsym - tmpsym(i,:3,:3) = & - matmul(grp2%sym(i,:3,:3),inverse_3x3(real(transform2,real32))) + do i = 1, grp2%nsym, 1 + tmpsym(:3,:3,i) = & + matmul(grp2%sym(:3,:3,i),inverse_3x3(real(transform2,real32))) ! next step required to transform properly into the space? - tmpsym(i,:3,:3) = & - matmul(real(transform2,real32),tmpsym(i,:3,:3)) + tmpsym(:3,:3,i) = & + matmul(real(transform2,real32),tmpsym(:3,:3,i)) end do nsym2=0 - tmpsym2=0._real32 - do i=1,grp2%nsym + tmpsym2 = 0._real32 + do i = 1, grp2%nsym, 1 !write(0,*) "################################" !write(0,*) i - !write(0,'(3(2X,F7.2))') (grp2%sym(i,j,:3),j=1,3) !tmpsym(i,:3,:3) + !write(0,'(3(2X,F7.2))') (grp2%sym(j,:3,i),j=1,3) !tmpsym(:3,:3,i) !write(0,*) - !write(0,'(3(2X,F7.2))') (tmpsym(i,j,:3),j=1,3) + !write(0,'(3(2X,F7.2))') (tmpsym(j,:3,i),j=1,3) if(all(& - abs( templat2(3,:) - matmul(templat2(3,:),tmpsym(i,:3,:3)) )& + abs( templat2(3,:) - matmul(templat2(3,:),tmpsym(:3,:3,i)) )& .lt.1.E-8_real32).or.& all(& - abs( templat2(3,:) + matmul(templat2(3,:),tmpsym(i,:3,:3)) )& + abs( templat2(3,:) + matmul(templat2(3,:),tmpsym(:3,:3,i)) )& .lt.1.E-8_real32))then - nsym2=nsym2+1 - tmpsym2(nsym2,:3,:3) = tmpsym(i,:3,:3) + nsym2 = nsym2 + 1 + tmpsym2(:3,:3,nsym2) = tmpsym(:3,:3,i) end if end do @@ -1118,7 +1118,7 @@ subroutine lattice_matching( & transforms2=Tcellmatch_2,& ntransforms=num_of_transforms,& matched_tols=tolerances,& - sym1=tmpsym1(:nsym1,:,:),sym2=tmpsym2(:nsym2,:,:)) + sym1=tmpsym1(:,:,:nsym1),sym2=tmpsym2(:,:,:nsym2)) !!-------------------------------------------------------------------- diff --git a/src/fortran/lib/mod_plane_matching.f90 b/src/fortran/lib/mod_plane_matching.f90 index 0dc61c3..8870bbe 100644 --- a/src/fortran/lib/mod_plane_matching.f90 +++ b/src/fortran/lib/mod_plane_matching.f90 @@ -272,8 +272,8 @@ function is_unique(miller,sym) result(outval) exit signloop1 end do signloop1 - symloop1: do i=1,size(sym(:,1,1),dim=1) - vec_out=matmul(vec_in,sym(i,:3,:3)) + symloop1: do i=1,size(sym,dim=3) + vec_out=matmul(vec_in,sym(:3,:3,i)) if(all(abs(vec_out-vec_in).lt.tol)) cycle symloop1 vec_tmp1(:)=abs(vec_in(:))-abs(vec_out(:)) vec_tmp2(:)=vec_in(:)-vec_out(:) @@ -321,10 +321,10 @@ function is_unique_set(vec1,vec2,sym) result(outval) !vec_in1=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) !vec_in2=(/ real(vec2(1),real32), real(vec2(2),real32), 0._real32/) - symloop1: do i=1,size(sym(:,1,1),dim=1) + symloop1: do i=1,size(sym,dim=3) ! matmul inmat with sym ! then compare to mat_checklist - vec_out=matmul(vec_in,sym(i,:3,:3)) + vec_out=matmul(vec_in,sym(:3,:3,i)) if(all(abs(vec_out-vec_in).lt.tol)) cycle symloop1 vec_tmp1(:)=abs(vec_in(:))-abs(vec_out(:)) vec_tmp2(:)=vec_in(:)-vec_out(:) @@ -343,8 +343,8 @@ function is_unique_set(vec1,vec2,sym) result(outval) !outval=.true. !vec_in=(/ real(vec1(1),real32), real(vec1(2),real32), 0._real32/) ! - !symloop1: do i=1,size(sym(:,1,1),dim=1) - ! vec_out=matmul(vec_in,sym(i,:3,:3)) + !symloop1: do i=1,size(sym,dim=3) + ! vec_out=matmul(vec_in,sym(:3,:3,i)) ! if(all(abs(vec_out-vec_in).lt.tol)) cycle symloop1 ! vec_tmp1(:)=abs(vec_in(:))-abs(vec_out(:)) ! vec_tmp2(:)=vec_in(:)-vec_out(:) @@ -455,12 +455,12 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list !!! ... when compared against the list !!!------------------------------------------------------------------------ matched_loc = 0 - sym_loop1: do isym=1,size(sym1(:,1,1)) - !mat1 = matmul(inmat(:2,:2),transpose(sym1(isym,:2,:2))) - mat1 = matmul(inmat(:2,:2),(sym1(isym,:2,:2))) - do jsym=1,size(sym2(:,1,1)) - !mat2 = matmul(inmat(:2,3:4),transpose(sym2(jsym,:2,:2))) - mat2 = transpose(matmul(inmat(:2,3:4),(sym2(jsym,:2,:2)))) + sym_loop1: do isym = 1, size(sym1,dim=3), 1 + !mat1 = matmul(inmat(:2,:2),transpose(sym1(:2,:2,isym))) + mat1 = matmul(inmat(:2,:2),(sym1(:2,:2,isym))) + do jsym = 1, size(sym2,dim=3), 1 + !mat2 = matmul(inmat(:2,3:4),transpose(sym2(:2,:2,jsym))) + mat2 = transpose(matmul(inmat(:2,3:4),(sym2(:2,:2,jsym)))) tf = find_tf_2x2(mat1,mat2) !if(ltest_print)then !!if(any(ISNAN(tf)))then @@ -469,9 +469,9 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list ! ! all(abs(inmat(:2,3:4)-test2).lt.tol))then ! write(0,*) isym,jsym ! - ! write(0,'(2(2X,F7.3))') sym1(isym,:2,:2) + ! write(0,'(2(2X,F7.3))') sym1(:2,:2,isym) ! write(0,*) - ! write(0,'(2(2X,F7.3))') sym2(jsym,:2,:2) + ! write(0,'(2(2X,F7.3))') sym2(:2,:2,jsym) ! write(0,*) "mat1" ! write(0,'(2(2X,F7.3))') mat1 ! write(0,*) "mat2" @@ -481,8 +481,8 @@ function is_unique_match(sym1,sym2,check_set,test_list,lw_check,up_check,up_list ! write(0,*) ! !! !if(isym.eq.1) stop - !! !if(jsym.eq.size(sym2(:,1,1))) stop - !! !if(isym.eq.size(sym1(:,1,1))) stop + !! !if(jsym.eq.size(sym2,dim=3)) stop + !! !if(isym.eq.size(sym1,dim=3)) stop !! !stop !end if diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 240eaa3..3b0b7c8 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -220,7 +220,7 @@ subroutine check_sym( & else call basis2%copy(basis) end if - allocate(tmpsav(grp%nsym*minval(basis%spec(:)%num),4,4)) + allocate(tmpsav(4,4,grp%nsym*minval(basis%spec(:)%num))) itmp1 = maxval(basis%spec(:)%num) @@ -282,14 +282,14 @@ subroutine check_sym( & itmp1 = 1 symloop: do isym = grp%start_idx, grp%end_idx, 1 if(verbose_.eq.2.or.verbose_.eq.3) write(*,204) & - grp%sym(isym,1:4,1:4) + grp%sym(1:4,1:4,isym) !------------------------------------------------------------------------ ! apply symmetry operator to basis !------------------------------------------------------------------------ do ispec = 1, basis%nspec, 1 do iatom = 1, basis%spec(ispec)%num, 1 tfbas%spec(ispec)%atom(iatom,1:3) = & - matmul(basis%spec(ispec)%atom(iatom,1:4),grp%sym(isym,1:4,1:3)) + matmul(basis%spec(ispec)%atom(iatom,1:4),grp%sym(1:4,1:3,isym)) do j=1,3 tfbas%spec(ispec)%atom(iatom,j) = & tfbas%spec(ispec)%atom(iatom,j) - & @@ -338,7 +338,7 @@ subroutine check_sym( & grp%npntop = grp%npntop + 1 grp%nsymop = grp%nsymop + 1 itmp1 = grp%nsymop + 1 - tmpsav(grp%nsymop,:,:) = grp%sym(isym,:,:) + tmpsav(:,:,grp%nsymop) = grp%sym(:,:,isym) grp%op(grp%nsymop) = isym if(grp%nsymop.ne.0.and..not.check_all_sym_) exit symloop end if @@ -348,7 +348,7 @@ subroutine check_sym( & ! checks if translations are valid with the current symmetry operation !------------------------------------------------------------------------ if(grp%lspace) then - if(all(abs(grp%sym(isym,1:3,1:3)-ident).lt.tol_sym_))then + if(all(abs(grp%sym(1:3,1:3,isym)-ident).lt.tol_sym_))then ltransformed=.false. else ltransformed=.true. @@ -371,9 +371,9 @@ subroutine check_sym( & if(isym.ne.1)then do jsym=2,grp%nsymop if(grp%op(jsym).eq.1) then - if(all(abs(trans(i,1:3)-tmpsav(jsym,4,1:3)).lt.& + if(all(abs(trans(i,1:3)-tmpsav(4,1:3,jsym)).lt.& tol_sym_)) cycle transloop - diff = trans(i,1:3) - tmpsav(jsym,4,1:3) + diff = trans(i,1:3) - tmpsav(4,1:3,jsym) diff = diff - ceiling( diff - 0.5_real32 ) do k=1,i if(all(abs(diff-trans(k,1:3)).lt.tol_sym_)) & @@ -384,8 +384,8 @@ subroutine check_sym( & end if grp%nsymop = grp%nsymop + 1 itmp1 = grp%nsymop + 1 - tmpsav(grp%nsymop,:,:) = grp%sym(isym,:,:) - tmpsav(grp%nsymop,4,1:3) = trans(i,:) + tmpsav(:,:,grp%nsymop) = grp%sym(:,:,isym) + tmpsav(4,1:3,grp%nsymop) = trans(i,:) grp%op(grp%nsymop) = isym end do transloop if(.not.check_all_sym_) exit symloop @@ -400,10 +400,10 @@ subroutine check_sym( & !!!----------------------------------------------------------------------------- if(lsave_)then if(allocated(grp%sym_save)) deallocate(grp%sym_save) - allocate(grp%sym_save(grp%nsymop,4,4)) + allocate(grp%sym_save(4,4,grp%nsymop)) grp%sym_save=0._real32 - grp%sym_save(:grp%nsymop,:,:)=tmpsav(:grp%nsymop,:,:) - grp%sym_save(:,4,4)=1._real32 + grp%sym_save(:,:,:grp%nsymop) = tmpsav(:,:,:grp%nsymop) + grp%sym_save(4,4,:) = 1._real32 deallocate(tmpsav) end if @@ -615,7 +615,7 @@ subroutine gen_fundam_sym_matrices(grp, lat, tol_sym) integer :: i real(real32) :: cosPi3,sinPi3,mcosPi3,msinPi3 real(real32), dimension(3,3) :: inversion,invlat,tmat1 - real(real32), dimension(64,3,3) :: fundam_mat + real(real32), dimension(3,3,64) :: fundam_mat cosPi3 = 0.5_real32 @@ -624,131 +624,131 @@ subroutine gen_fundam_sym_matrices(grp, lat, tol_sym) msinPi3 = -sinPi3 - fundam_mat(1,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,1)=transpose(reshape((/& 1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(2,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,2)=transpose(reshape((/& -1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(3,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,3)=transpose(reshape((/& -1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) - fundam_mat(4,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,4)=transpose(reshape((/& 1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) - fundam_mat(5,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,5)=transpose(reshape((/& 0._real32, 1._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) - fundam_mat(6,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,6)=transpose(reshape((/& 0._real32, -1._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) - fundam_mat(7,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,7)=transpose(reshape((/& 0._real32, -1._real32, 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(8,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,8)=transpose(reshape((/& 0._real32, 1._real32, 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(9,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,9)=transpose(reshape((/& 0._real32, 0._real32, 1._real32, 0._real32, -1._real32, 0._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(10,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,10)=transpose(reshape((/& 0._real32, 0._real32, -1._real32, 0._real32, -1._real32, 0._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(11,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,11)=transpose(reshape((/& 0._real32, 0._real32, -1._real32, 0._real32, 1._real32, 0._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(12,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,12)=transpose(reshape((/& 0._real32, 0._real32, 1._real32, 0._real32, 1._real32, 0._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(13,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,13)=transpose(reshape((/& -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) - fundam_mat(14,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,14)=transpose(reshape((/& -1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, -1._real32, 0._real32 /),& shape(inversion))) - fundam_mat(15,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,15)=transpose(reshape((/& 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) - fundam_mat(16,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,16)=transpose(reshape((/& 1._real32, 0._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32, -1._real32, 0._real32/),& shape(inversion))) - fundam_mat(17,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,17)=transpose(reshape((/& 0._real32, 0._real32, 1._real32, 1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) - fundam_mat(18,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,18)=transpose(reshape((/& 0._real32, 0._real32, -1._real32, -1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 0._real32 /),& shape(inversion))) - fundam_mat(19,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,19)=transpose(reshape((/& 0._real32, 0._real32, -1._real32, 1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32 /),& shape(inversion))) - fundam_mat(20,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,20)=transpose(reshape((/& 0._real32, 0._real32, 1._real32, -1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 0._real32 /),& shape(inversion))) - fundam_mat(21,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,21)=transpose(reshape((/& 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, 1._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(22,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,22)=transpose(reshape((/& 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, -1._real32, 1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(23,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,23)=transpose(reshape((/& 0._real32, -1._real32, 0._real32, 0._real32, 0._real32, 1._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(24,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,24)=transpose(reshape((/& 0._real32, 1._real32, 0._real32, 0._real32, 0._real32, -1._real32, -1._real32, 0._real32, 0._real32 /),& shape(inversion))) - fundam_mat(25,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,25)=transpose(reshape((/& cosPi3, sinPi3, 0._real32, msinPi3, cosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(26,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,26)=transpose(reshape((/& cosPi3, msinPi3, 0._real32, sinPi3, cosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(27,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,27)=transpose(reshape((/& mcosPi3, sinPi3, 0._real32, msinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(28,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,28)=transpose(reshape((/& mcosPi3, msinPi3, 0._real32, sinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, 1._real32 /),& shape(inversion))) - fundam_mat(29,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,29)=transpose(reshape((/& cosPi3, msinPi3, 0._real32, msinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) - fundam_mat(30,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,30)=transpose(reshape((/& cosPi3, sinPi3, 0._real32, sinPi3, mcosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) - fundam_mat(31,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,31)=transpose(reshape((/& mcosPi3, msinPi3, 0._real32, msinPi3, cosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) - fundam_mat(32,1:3,1:3)=transpose(reshape((/& + fundam_mat(1:3,1:3,32)=transpose(reshape((/& mcosPi3, sinPi3, 0._real32, sinPi3, cosPi3, 0._real32, 0._real32, 0._real32, -1._real32 /),& shape(inversion))) @@ -758,29 +758,29 @@ subroutine gen_fundam_sym_matrices(grp, lat, tol_sym) do i=1,32 - fundam_mat(i+32,:3,:3) = matmul(inversion,fundam_mat(i,:3,:3)) + fundam_mat(:3,:3,i+32) = matmul(inversion,fundam_mat(:3,:3,i)) end do grp%nsym=0 invlat=inverse_3x3(lat) - do i=1,64 - tmat1=matmul(lat,fundam_mat(i,:3,:3)) + do i = 1, 64, 1 + tmat1=matmul(lat,fundam_mat(:3,:3,i)) tmat1=matmul(tmat1,(invlat)) !! ensure that the matrix preserves size of 1 !! this is likely redundant if(abs(abs(det(tmat1))-1._real32).gt.tol_sym) cycle if(all(abs(tmat1-nint(tmat1)).le.tol_sym))then grp%nsym=grp%nsym+1 - fundam_mat(grp%nsym,:,:)=fundam_mat(i,:,:) + fundam_mat(:,:,grp%nsym)=fundam_mat(:,:,i) end if end do - allocate(grp%sym(grp%nsym,4,4)) - grp%sym(:,:,:)=0._real32 - grp%sym(:,4,4)=1._real32 - grp%sym(:grp%nsym,:3,:3)=fundam_mat(:grp%nsym,:3,:3) + allocate(grp%sym(4,4,grp%nsym)) + grp%sym(:,:,:) = 0._real32 + grp%sym(4,4,:) = 1._real32 + grp%sym(:3,:3,:grp%nsym) = fundam_mat(:3,:3,:grp%nsym) grp%nlatsym=grp%nsym @@ -832,9 +832,9 @@ subroutine mksym(grp, inlat, tol_sym) !!!----------------------------------------------------------------------------- !!! initialise values and symmetry matrix !!!----------------------------------------------------------------------------- - allocate(tsym1(50000,4,4)) + allocate(tsym1(4,4,50000)) tsym1 = 0._real32 - tsym1(:,4,4)=1._real32 + tsym1(4,4,:) = 1._real32 count = 0 @@ -849,13 +849,13 @@ subroutine mksym(grp, inlat, tol_sym) else tht = 2._real32*pi/real(n) !=2*pi/n end if - tsym1(count,1:3,1:3)=transpose(reshape((/& + tsym1(1:3,1:3,count)=transpose(reshape((/& cos(tht) , sin(tht), 0._real32,& -sin(tht), cos(tht), 0._real32,& 0._real32 , 0._real32, 1._real32/), shape(rotmat))) do i=1,3 do j=1,3 - if(abs(tsym1(count,i,j)).lt.tol_sym) tsym1(count,i,j)=0._real32 + if(abs(tsym1(i,j,count)).lt.tol_sym) tsym1(i,j,count)=0._real32 end do end do end do mksyml @@ -873,13 +873,13 @@ subroutine mksym(grp, inlat, tol_sym) else tht = 2._real32*pi/real(n) !=2*pi/n end if - rotmat=transpose(reshape((/& + rotmat = transpose(reshape((/& 1._real32, 0._real32, 0._real32, & 0._real32, cos(tht), sin(tht),& 0._real32, -sin(tht), cos(tht)/), shape(rotmat))) - rot2: do irot=1,nrot - count=count+1 - tsym1(count,1:3,1:3)=matmul(rotmat(1:3,1:3),tsym1(irot,1:3,1:3)) + rot2: do irot = 1, nrot + count = count + 1 + tsym1(1:3,1:3,count) = matmul(rotmat(1:3,1:3),tsym1(1:3,1:3,irot)) end do rot2 end do philoop nrot=count @@ -896,18 +896,16 @@ subroutine mksym(grp, inlat, tol_sym) else tht = 2._real32*pi/real(n) !=2*pi/n end if - rotmat=transpose(reshape((/& + rotmat = transpose(reshape((/& cos(tht) , 0._real32, sin(tht),& 0._real32 , 1._real32, 0._real32, & -sin(tht), 0._real32, cos(tht)/), shape(rotmat))) rot3: do irot=1,nrot - count=count+1 - tsym1(count,1:3,1:3)=matmul(rotmat(1:3,1:3),tsym1(irot,1:3,1:3)) - do i=1,3 - do j=1,3 - if(abs(tsym1(count,i,j)).lt.tol_sym) tsym1(count,i,j)=0._real32 - end do - end do + count = count + 1 + tsym1(1:3,1:3,count) = matmul(rotmat(1:3,1:3),tsym1(1:3,1:3,irot)) + where (abs(tsym1(1:3,1:3,count)).lt.tol_sym) + tsym1(1:3,1:3,count) = 0._real32 + end where end do rot3 end do psiloop nrot=count @@ -930,44 +928,44 @@ subroutine mksym(grp, inlat, tol_sym) cloop: do ic=cmin,2 c=(-1._real32)**ic ! if((a*b*c).ne.(-1._real32)) cycle cloop - refmat(1:3,1:3)=transpose(reshape((/& + refmat(1:3,1:3) = transpose(reshape((/& a, 0._real32, 0._real32,& 0._real32, b , 0._real32,& 0._real32, 0._real32, c/), shape(rotmat))) - refloop: do irot=1,nrot - count=count+1 - tsym1(count,1:3,1:3)=matmul(refmat(1:3,1:3),tsym1(irot,1:3,1:3)) + refloop: do irot = 1, nrot + count = count + 1 + tsym1(1:3,1:3,count) = matmul(refmat(1:3,1:3),tsym1(1:3,1:3,irot)) end do refloop end do cloop end do bloop end do aloop - grp%nsym=count + grp%nsym = count if(grp%lmolec)then - allocate(grp%sym(grp%nsym,4,4)) - grp%sym(:grp%nsym,:,:)=tsym1(:grp%nsym,:,:) + allocate(grp%sym(4,4,grp%nsym)) + grp%sym(:,:,:grp%nsym)=tsym1(:,:,:grp%nsym) deallocate(tsym1) return end if !! best so far - ! sym(isym,1:3,1:3)=matmul(transpose(lat),sym(isym,1:3,1:3)) - ! sym(isym,1:3,1:3)=matmul(sym(isym,1:3,1:3),(invlat)) + ! sym(1:3,1:3,isym)=matmul(transpose(lat),sym(1:3,1:3,isym)) + ! sym(1:3,1:3,isym)=matmul(sym(1:3,1:3,isym),(invlat)) !!!----------------------------------------------------------------------------- !!! checks all made symmetries to see if they apply to the supplied lattice !!!----------------------------------------------------------------------------- - allocate(tsym2(grp%nsym,4,4)) - tsym2=0._real32 - tsym2(:,4,4)=1._real32 - count=0 - samecheck: do isym=1,grp%nsym - tmat1 = matmul((invlat),tsym1(isym,:3,:3)) + allocate(tsym2(4,4,grp%nsym)) + tsym2 = 0._real32 + tsym2(4,4,:) = 1._real32 + count = 0 + samecheck: do isym = 1, grp%nsym + tmat1 = matmul((invlat),tsym1(:3,:3,isym)) tmat1 = matmul(tmat1,(lat)) - do i=1,3 - do j=1,3 - if(abs(tmat1(i,j)).lt.tol_sym) tmat1(i,j)=0._real32 + do i = 1, 3 + do j = 1, 3 + if(abs(tmat1(i,j)).lt.tol_sym) tmat1(i,j) = 0._real32 if(abs(1._real32-abs(tmat1(i,j))).lt.tol_sym) & - tmat1(i,j)=sign(1._real32,tmat1(i,j)) + tmat1(i,j) = sign(1._real32,tmat1(i,j)) end do end do !!----------------------------------------------------------------------- @@ -977,18 +975,18 @@ subroutine mksym(grp, inlat, tol_sym) !!----------------------------------------------------------------------- if(.not.all(abs(tmat1-nint(tmat1)).lt.tol_sym)) cycle samecheck do jsym = 1, count, 1 - if(all(abs(tmat1-tsym2(jsym,:3,:3)).lt.tol_sym)) cycle samecheck + if(all(abs(tmat1-tsym2(:3,:3,jsym)).lt.tol_sym)) cycle samecheck end do count = count + 1 - tsym2(count,:3,:3) = tmat1 + tsym2(:3,:3,count) = tmat1 end do samecheck - grp%nsym=count + grp%nsym = count deallocate(tsym1) - allocate(grp%sym(grp%nsym,4,4)) - grp%sym(:grp%nsym,:4,:4)=tsym2(:grp%nsym,:4,:4) + allocate(grp%sym(4,4,grp%nsym)) + grp%sym(:4,:4,:grp%nsym)=tsym2(:4,:4,:grp%nsym) deallocate(tsym2) - grp%nlatsym=grp%nsym + grp%nlatsym = grp%nsym return @@ -1006,8 +1004,8 @@ subroutine clone_grp(from, to) if(allocated(from%op)) allocate(to%op(size(from%op))) - if(allocated(from%sym)) allocate(to%sym(size(from%sym,dim=1),4,4)) - if(allocated(from%sym_save)) allocate(to%sym_save(size(from%sym_save,dim=1),4,4)) + if(allocated(from%sym)) allocate(to%sym(4,4,size(from%sym,dim=3))) + if(allocated(from%sym_save)) allocate(to%sym_save(4,4,size(from%sym_save,dim=3))) to = from end subroutine clone_grp @@ -1105,7 +1103,7 @@ subroutine get_primitive_cell(basis, tol_sym) !!----------------------------------------------------------------- do ja=1, itmp1 if(all(abs(basis%spec(is)%atom(ia,1:3)-atom_store(ja,1:3)).lt.& - (/tol_sym,tol_sym,tol_sym/))) cycle atcheck + [ tol_sym,tol_sym,tol_sym ])) cycle atcheck end do itmp1=itmp1+1 atom_store(itmp1,:)=basis%spec(is)%atom(ia,:) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index bd690b8..6f7d989 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -6,7 +6,7 @@ module artemis__terminations use artemis__io_utils, only: err_abort use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: modu, cross, uvec, det - use artemis__sym, only: sym_type, check_sym, sym_setup, clone_grp, s_end + use artemis__sym, only: sym_type, check_sym, sym_setup, clone_grp use artemis__geom_utils, only: shifter, transformer, ortho_axis, set_vacuum implicit none @@ -49,7 +49,7 @@ module artemis__terminations !############################################################################### function get_termination_info( & - basis, axis, verbose, tol_sym, layer_sep, break_on_fail & + basis, axis, verbose, tol_sym, layer_sep, exit_code & ) result(term) !! Function to find the terminations of a material along a given axis implicit none @@ -64,17 +64,16 @@ function get_termination_info( & !! Verbosity level real(real32), intent(in) :: tol_sym !! Tolerance for symmetry operations - real(real32), intent(in), optional :: layer_sep + real(real32), intent(in) :: layer_sep !! Minimum separation between layers - logical, intent(in), optional :: break_on_fail - !! Boolean whether to break on failure to find terminations + integer, intent(inout) :: exit_code ! Local variables integer :: i, j, is, nterm, mterm, dim, ireject !! Loop indices and dimensions integer :: itmp1, itmp2, init, min_loc !! Temporary indices - logical :: lunique, ltmp1, lmirror, break_on_fail_ + logical :: lunique, ltmp1, lmirror !! Boolean flags real(real32) :: rtmp1, tol, height, max_sep, c_along, centre !! Temporary variables @@ -108,25 +107,14 @@ function get_termination_info( & abc = [ 1, 2, 3 ] term%nterm = 0 - s_end=0 + grp_store%end_idx = 0 grp_store%confine%l=.false. grp_store%confine%axis=axis grp_store%confine%laxis=.false. - !--------------------------------------------------------------------------- - ! Set printing option - !--------------------------------------------------------------------------- - break_on_fail_ = .false. - if(present(break_on_fail)) break_on_fail_ = break_on_fail - - !--------------------------------------------------------------------------- ! Set the surface identification tolerance !--------------------------------------------------------------------------- - if(present(layer_sep))then - layer_sep_ = layer_sep - else - layer_sep_ = 1._real32 !!!tolerance of 1 Å for defining a layer - end if + layer_sep_ = layer_sep abc=cshift(abc,3-axis) c_along = abs(dot_product(basis%lat(axis,:),& @@ -160,11 +148,8 @@ function get_termination_info( & end if end do if(max_sep.lt.layer_sep_)then - if(break_on_fail_)then - write(0,'("ERROR: Error in artemis__sym.f90")') - else - write(0,'("WARNING:")') - end if + exit_code = 1 + write(0,'("ERROR: Error in artemis__sym.f90")') write(0,'(2X,"get_terminations subroutine unable to find a separation & &in the material that is greater than LAYER_SEP")') write(0,'(2X,"Writing material to ''unlayerable.vasp''")') @@ -177,16 +162,7 @@ function get_termination_info( & &support the Miller plane")') write(0,'(2X,"Please inform the developers of this and give details & &of what structure caused this")') - if(break_on_fail_)then - write( 0, & - '("To allow the program to continue, set & - &LBREAK_ON_NO_TERM = F")' & - ) - write(0,'("Stopping...")') - call exit() - else - return - end if + return end if basis_list(:,axis) = basis_list(:,axis) - height basis_list(:,axis) = basis_list(:,axis) - floor(basis_list(:,axis)) @@ -252,12 +228,16 @@ function get_termination_info( & !--------------------------------------------------------------------------- ! Print location of unique terminations !--------------------------------------------------------------------------- - mterm = 0 ireject = 0 grp_store%lspace = .true. grp_store%confine%l = .true. grp_store%confine%laxis(axis) = .true. - call sym_setup(grp_store,basis%lat,predefined=.false.,new_start=.true.) + call sym_setup( & + grp_store, & + basis%lat, & + predefined=.false., new_start=.true., & + tol_sym=tol_sym & + ) @@ -275,7 +255,7 @@ function get_termination_info( & end do itmp1 = 0 do i=1,grp_store%nsym - if(all(abs(grp_store%sym(i,:3,:3)-inv_mat).lt.tolerance))then + if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tolerance))then itmp1 = i exit end if @@ -285,8 +265,8 @@ function get_termination_info( & call err_abort(err_msg) end if do i = 1, grp_store%nsym - if(all(abs(grp_store%sym(i,:3,:3)-inv_mat).lt.tolerance)) & - grp_store%sym(itmp1,4,:3) = grp_store%sym(i,4,:3) + if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tolerance)) & + grp_store%sym(4,:3,itmp1) = grp_store%sym(4,:3,i) end do @@ -298,14 +278,15 @@ function get_termination_info( & grp_store%confine%laxis(axis) = .true. allocate(term_arr_uniq(2*nterm)) allocate(reject_match(nterm,2)) - shift_loop1:do i=1,nterm + mterm = 0 + shift_loop1: do i = 1, nterm, 1 mterm = mterm + 1 basis_arr(mterm) = basis centre = term_arr(i)%hmin + (term_arr(i)%hmax - term_arr(i)%hmin)/2._real32 - call shifter(basis_arr(mterm),axis,1-centre,.true.) + call shifter(basis_arr(mterm),axis,1._real32 - centre,.true.) sym_if: if(i.ne.1)then - sym_loop1:do j=1,mterm-1 + sym_loop1: do j = 1, mterm - 1, 1 if(abs(abs(term_arr(i)%hmax-term_arr(i)%hmin) - & abs(term_arr_uniq(j)%hmax-term_arr_uniq(j)%hmin)).gt.tolerance) & cycle sym_loop1 @@ -313,7 +294,7 @@ function get_termination_info( & call check_sym(grp1,basis=basis_arr(mterm),& iperm=-1,tmpbas2=basis_arr(j),lsave=.true.,tol_sym=tol_sym) if(grp1%nsymop.ne.0)then - if(grp1%sym_save(1,axis,axis).eq.-1._real32)then + if(abs(grp1%sym_save(axis,axis,1)+1._real32).lt.tolerance)then ireject = ireject + 1 reject_match(ireject,:) = [ i, j ] basis_arr_reject(ireject) = basis_arr(mterm) @@ -338,14 +319,19 @@ function get_termination_info( & !--------------------------------------------------------------------------- ! Set up mirror/inversion symmetries of the matrix !--------------------------------------------------------------------------- - call sym_setup(grp_store,basis%lat,predefined=.false.,new_start=.true.) - allocate(tmpsym(count(grp_store%sym(:,3,3).eq.-1._real32),4,4)) - allocate(tmpop(count(grp_store%sym(:,3,3).eq.-1._real32))) + call sym_setup( & + grp_store, & + basis%lat, & + predefined=.false., new_start=.true., & + tol_sym=tol_sym & + ) + allocate(tmpsym(count(abs(grp_store%sym(3,3,:)+1._real32).lt.tolerance),4,4)) + allocate(tmpop(count(abs(grp_store%sym(3,3,:)+1._real32).lt.tolerance))) itmp1 = 0 do i=1,grp_store%nsym - if(grp_store%sym(i,3,3).eq.-1._real32)then + if(abs(grp_store%sym(3,3,i)+1._real32).lt.tolerance)then itmp1=itmp1+1 - tmpsym(itmp1,:,:) = grp_store%sym(i,:,:) + tmpsym(itmp1,:,:) = grp_store%sym(:,:,i) tmpop(itmp1) = i end if end do @@ -354,7 +340,7 @@ function get_termination_info( & call move_alloc(tmpsym,grp_store%sym) allocate(grp_store%op(itmp1)) grp_store%op(:) = tmpop(:itmp1) - s_end = grp_store%nsym + grp_store%end_idx = grp_store%nsym !--------------------------------------------------------------------------- @@ -378,41 +364,41 @@ function get_termination_info( & else call clone_grp(grp_store,grp1) call check_sym(grp1,basis_arr(itmp2),& - iperm=-1,lsave=.true.,lcheck_all=.true.,tol_sym=tol_sym) + iperm=-1,lsave=.true.,check_all_sym=.true.,tol_sym=tol_sym) ltmp1=.false. ! Check if pure translations are present in comparison termination? - !! if(all(abs(grp1%sym_save(j,:3,:3)-ident).le.tolerance))then + !! if(all(abs(grp1%sym_save(:3,:3,j)-ident).le.tolerance))then !! write(0,*) "FOUND TRANSLATION" !! cycle reject_loop1 !! end if !! end do ! Check if inversions are present in comparison termination do j=1,grp1%nsymop - if(abs(det(grp1%sym_save(j,:3,:3))+1._real32).le.tolerance) ltmp1=.true. + if(abs(det(grp1%sym_save(:3,:3,j))+1._real32).le.tolerance) ltmp1=.true. end do ! If they are not, then no point comparing. It is a new termination - if(.not.ltmp1) exit prior_check + if(.not.ltmp1) exit prior_check call clone_grp(grp_store,grp1) call check_sym(grp1,basis_arr(itmp2),& tmpbas2=basis_arr_reject(i),iperm=-1,lsave=.true.,& - lcheck_all=.true., tol_sym=tol_sym) + check_all_sym=.true., tol_sym=tol_sym) ! Check det of all symmetry operations. If any are 1, move on ! This is because they are just rotations as can be captured ... ! ... through lattice matches. ! Solely inversions are unique and must be captured. do j=1,grp1%nsymop - if(abs(det(grp1%sym_save(j,:3,:3))-1._real32).le.tolerance) lunique=.false. + if(abs(det(grp1%sym_save(:3,:3,j))-1._real32).le.tolerance) lunique=.false. end do - if(grp1%sym_save(1,4,axis).eq.& + if(grp1%sym_save(4,axis,1).eq.& 2._real32*min(term_arr_uniq(itmp2)%hmin,0.5_real32-term_arr_uniq(itmp2)%hmin))then lunique=.false. end if - if(.not.(all(grp1%sym_save(1,axis,:3).eq.vec_compare(:)).and.& - all(grp1%sym_save(1,:3,axis).eq.vec_compare(:)))) lunique=.false. + if(.not.(all(grp1%sym_save(axis,:3,1).eq.vec_compare(:)).and.& + all(grp1%sym_save(:3,axis,1).eq.vec_compare(:)))) lunique=.false. end if prior_check @@ -442,9 +428,9 @@ function get_termination_info( & term%lmirror = lmirror if(verbose.gt.0)& write(*,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') - rtmp1 = term_arr_uniq(1)%hmin-1.E-6_real32 + rtmp1 = term_arr_uniq(1)%hmin - 1.E-6_real32 itmp1 = 1 - do i=1,mterm + do i = 1, mterm, 1 allocate(term%arr(i)%ladder(term_arr_uniq(i)%nstep)) term%arr(i)%hmin = term_arr_uniq(itmp1)%hmin term%arr(i)%hmax = term_arr_uniq(itmp1)%hmax From f9086c2b538f3edcea3b30acb6033a36c5ed2b9b Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 15:11:43 +0100 Subject: [PATCH 079/137] Reorder symmetry matrices --- src/fortran/lib/mod_swapping.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fortran/lib/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 index 1c84a07..d3c5e4f 100644 --- a/src/fortran/lib/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -146,11 +146,11 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& !!! To Replace with lmirror = .false. call check_sym(grp,tmpbas,lsave=.true., tol_sym=tol_sym) - intf_sym_loop: do i=1,grp%nsymop + intf_sym_loop: do i = 1, grp%nsymop !if(symops(i).eq.1) cycle intf_sym_loop - if(abs(grp%sym(i,4,axis)).lt.tiny) cycle intf_sym_loop - if(abs(grp%sym(i,axis,axis)+1._real32).gt.tiny) cycle intf_sym_loop - intf_sym(1:4,1:4) = grp%sym(i,1:4,1:4) + if(abs(grp%sym(4,axis,i)).lt.tiny) cycle intf_sym_loop + if(abs(grp%sym(axis,axis,i)+1._real32).gt.tiny) cycle intf_sym_loop + intf_sym(1:4,1:4) = grp%sym(1:4,1:4,i) bas_map = basis_map(intf_sym,tmpbas, tol_sym=tol_sym) lmirror = .true. exit intf_sym_loop From d381dc3a299e12130320f2985beefcd48f0128d3 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 15:36:12 +0100 Subject: [PATCH 080/137] Fix symmetry matrix --- src/fortran/lib/mod_terminations.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 6f7d989..92fe5e7 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -240,7 +240,6 @@ function get_termination_info( & ) - !--------------------------------------------------------------------------- ! Handle inversion matrix (centre of inversion must be accounted for) !--------------------------------------------------------------------------- @@ -325,13 +324,13 @@ function get_termination_info( & predefined=.false., new_start=.true., & tol_sym=tol_sym & ) - allocate(tmpsym(count(abs(grp_store%sym(3,3,:)+1._real32).lt.tolerance),4,4)) + allocate(tmpsym(4,4,count(abs(grp_store%sym(3,3,:)+1._real32).lt.tolerance))) allocate(tmpop(count(abs(grp_store%sym(3,3,:)+1._real32).lt.tolerance))) itmp1 = 0 do i=1,grp_store%nsym if(abs(grp_store%sym(3,3,i)+1._real32).lt.tolerance)then itmp1=itmp1+1 - tmpsym(itmp1,:,:) = grp_store%sym(:,:,i) + tmpsym(:,:,itmp1) = grp_store%sym(:,:,i) tmpop(itmp1) = i end if end do From 6c53b75baa757a998174e733df649649470deebb Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Tue, 22 Apr 2025 17:03:33 +0100 Subject: [PATCH 081/137] Handle structure data --- src/artemis/artemis.py | 765 ++++++++++++++++++++++--- src/fortran/lib/mod_generator.f90 | 256 ++++++++- src/fortran/lib/mod_misc_types.f90 | 97 ++++ src/wrapper/f90wrap_artemis.f90 | 4 +- src/wrapper/f90wrap_mod_generator.f90 | 230 +++++++- src/wrapper/f90wrap_mod_geom_rw.f90 | 4 +- src/wrapper/f90wrap_mod_misc_types.f90 | 401 +++++++++++++ 7 files changed, 1655 insertions(+), 102 deletions(-) create mode 100644 src/wrapper/f90wrap_mod_misc_types.f90 diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 7875845..f925188 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -520,6 +520,436 @@ def deallocate(self): + +class Misc_Types(f90wrap.runtime.FortranModule): + """ + Module artemis__misc_types + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + lines 1-261 + + """ + @f90wrap.runtime.register_class("artemis.struc_data_type") + class struc_data_type(f90wrap.runtime.FortranDerivedType): + """ + Type(name=struc_data_type) + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + lines 24-42 + + """ + def __init__(self, handle=None): + """ + self = Struc_Data_Type() + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + lines 24-42 + + + Returns + ------- + this : Struc_Data_Type + Object to be constructed + + + Automatically generated constructor for struc_data_type + """ + f90wrap.runtime.FortranDerivedType.__init__(self) + result = _artemis.f90wrap_misc_types__struc_data_type_initialise() + self._handle = result[0] if isinstance(result, tuple) else result + + def __del__(self): + """ + Destructor for class Struc_Data_Type + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + lines 24-42 + + Parameters + ---------- + this : Struc_Data_Type + Object to be destructed + + + Automatically generated destructor for struc_data_type + """ + if self._alloc: + _artemis.f90wrap_misc_types__struc_data_type_finalise(this=self._handle) + + @property + def match_idx(self): + """ + Element match_idx ftype=integer pytype=int + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 25 + + """ + return _artemis.f90wrap_struc_data_type__get__match_idx(self._handle) + + @match_idx.setter + def match_idx(self, match_idx): + _artemis.f90wrap_struc_data_type__set__match_idx(self._handle, match_idx) + + @property + def shift_idx(self): + """ + Element shift_idx ftype=integer pytype=int + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 26 + + """ + return _artemis.f90wrap_struc_data_type__get__shift_idx(self._handle) + + @shift_idx.setter + def shift_idx(self, shift_idx): + _artemis.f90wrap_struc_data_type__set__shift_idx(self._handle, shift_idx) + + @property + def swap_idx(self): + """ + Element swap_idx ftype=integer pytype=int + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 27 + + """ + return _artemis.f90wrap_struc_data_type__get__swap_idx(self._handle) + + @swap_idx.setter + def swap_idx(self, swap_idx): + _artemis.f90wrap_struc_data_type__set__swap_idx(self._handle, swap_idx) + + @property + def from_pricel_lw(self): + """ + Element from_pricel_lw ftype=logical pytype=bool + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 28 + + """ + return _artemis.f90wrap_struc_data_type__get__from_pricel_lw(self._handle) + + @from_pricel_lw.setter + def from_pricel_lw(self, from_pricel_lw): + _artemis.f90wrap_struc_data_type__set__from_pricel_lw(self._handle, \ + from_pricel_lw) + + @property + def from_pricel_up(self): + """ + Element from_pricel_up ftype=logical pytype=bool + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 29 + + """ + return _artemis.f90wrap_struc_data_type__get__from_pricel_up(self._handle) + + @from_pricel_up.setter + def from_pricel_up(self, from_pricel_up): + _artemis.f90wrap_struc_data_type__set__from_pricel_up(self._handle, \ + from_pricel_up) + + @property + def term_lw_idx(self): + """ + Element term_lw_idx ftype=integer pytype=int + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 30 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_struc_data_type__array__term_lw_idx(self._handle) + if array_handle in self._arrays: + term_lw_idx = self._arrays[array_handle] + else: + term_lw_idx = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_struc_data_type__array__term_lw_idx) + self._arrays[array_handle] = term_lw_idx + return term_lw_idx + + @term_lw_idx.setter + def term_lw_idx(self, term_lw_idx): + self.term_lw_idx[...] = term_lw_idx + + @property + def term_up_idx(self): + """ + Element term_up_idx ftype=integer pytype=int + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 31 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_struc_data_type__array__term_up_idx(self._handle) + if array_handle in self._arrays: + term_up_idx = self._arrays[array_handle] + else: + term_up_idx = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_struc_data_type__array__term_up_idx) + self._arrays[array_handle] = term_up_idx + return term_up_idx + + @term_up_idx.setter + def term_up_idx(self, term_up_idx): + self.term_up_idx[...] = term_up_idx + + @property + def transform_lw(self): + """ + Element transform_lw ftype=integer pytype=int + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 32 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_struc_data_type__array__transform_lw(self._handle) + if array_handle in self._arrays: + transform_lw = self._arrays[array_handle] + else: + transform_lw = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_struc_data_type__array__transform_lw) + self._arrays[array_handle] = transform_lw + return transform_lw + + @transform_lw.setter + def transform_lw(self, transform_lw): + self.transform_lw[...] = transform_lw + + @property + def transform_up(self): + """ + Element transform_up ftype=integer pytype=int + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 33 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_struc_data_type__array__transform_up(self._handle) + if array_handle in self._arrays: + transform_up = self._arrays[array_handle] + else: + transform_up = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_struc_data_type__array__transform_up) + self._arrays[array_handle] = transform_up + return transform_up + + @transform_up.setter + def transform_up(self, transform_up): + self.transform_up[...] = transform_up + + @property + def approx_thickness_lw(self): + """ + Element approx_thickness_lw ftype=real(real32) pytype=float + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 34 + + """ + return _artemis.f90wrap_struc_data_type__get__approx_thickness_lw(self._handle) + + @approx_thickness_lw.setter + def approx_thickness_lw(self, approx_thickness_lw): + _artemis.f90wrap_struc_data_type__set__approx_thickness_lw(self._handle, \ + approx_thickness_lw) + + @property + def approx_thickness_up(self): + """ + Element approx_thickness_up ftype=real(real32) pytype=float + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 35 + + """ + return _artemis.f90wrap_struc_data_type__get__approx_thickness_up(self._handle) + + @approx_thickness_up.setter + def approx_thickness_up(self, approx_thickness_up): + _artemis.f90wrap_struc_data_type__set__approx_thickness_up(self._handle, \ + approx_thickness_up) + + @property + def mismatch(self): + """ + Element mismatch ftype=real(real32) pytype=float + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 36 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_struc_data_type__array__mismatch(self._handle) + if array_handle in self._arrays: + mismatch = self._arrays[array_handle] + else: + mismatch = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_struc_data_type__array__mismatch) + self._arrays[array_handle] = mismatch + return mismatch + + @mismatch.setter + def mismatch(self, mismatch): + self.mismatch[...] = mismatch + + @property + def shift(self): + """ + Element shift ftype=real(real32) pytype=float + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 37 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_struc_data_type__array__shift(self._handle) + if array_handle in self._arrays: + shift = self._arrays[array_handle] + else: + shift = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_struc_data_type__array__shift) + self._arrays[array_handle] = shift + return shift + + @shift.setter + def shift(self, shift): + self.shift[...] = shift + + @property + def swap_density(self): + """ + Element swap_density ftype=real(real32) pytype=float + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 39 + + """ + return _artemis.f90wrap_struc_data_type__get__swap_density(self._handle) + + @swap_density.setter + def swap_density(self, swap_density): + _artemis.f90wrap_struc_data_type__set__swap_density(self._handle, swap_density) + + @property + def approx_eff_swap_conc(self): + """ + Element approx_eff_swap_conc ftype=real(real32) pytype=float + + + Defined at \ + ../fortran/lib/mod_misc_types.f90 \ + line 40 + + """ + array_ndim, array_type, array_shape, array_handle = \ + _artemis.f90wrap_struc_data_type__array__approx_eff_swap_conc(self._handle) + if array_handle in self._arrays: + approx_eff_swap_conc = self._arrays[array_handle] + else: + approx_eff_swap_conc = \ + f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, + self._handle, + _artemis.f90wrap_struc_data_type__array__approx_eff_swap_conc) + self._arrays[array_handle] = approx_eff_swap_conc + return approx_eff_swap_conc + + @approx_eff_swap_conc.setter + def approx_eff_swap_conc(self, approx_eff_swap_conc): + self.approx_eff_swap_conc[...] = approx_eff_swap_conc + + def __str__(self): + ret = ['{\n'] + ret.append(' match_idx : ') + ret.append(repr(self.match_idx)) + ret.append(',\n shift_idx : ') + ret.append(repr(self.shift_idx)) + ret.append(',\n swap_idx : ') + ret.append(repr(self.swap_idx)) + ret.append(',\n from_pricel_lw : ') + ret.append(repr(self.from_pricel_lw)) + ret.append(',\n from_pricel_up : ') + ret.append(repr(self.from_pricel_up)) + ret.append(',\n term_lw_idx : ') + ret.append(repr(self.term_lw_idx)) + ret.append(',\n term_up_idx : ') + ret.append(repr(self.term_up_idx)) + ret.append(',\n transform_lw : ') + ret.append(repr(self.transform_lw)) + ret.append(',\n transform_up : ') + ret.append(repr(self.transform_up)) + ret.append(',\n approx_thickness_lw : ') + ret.append(repr(self.approx_thickness_lw)) + ret.append(',\n approx_thickness_up : ') + ret.append(repr(self.approx_thickness_up)) + ret.append(',\n mismatch : ') + ret.append(repr(self.mismatch)) + ret.append(',\n shift : ') + ret.append(repr(self.shift)) + ret.append(',\n swap_density : ') + ret.append(repr(self.swap_density)) + ret.append(',\n approx_eff_swap_conc : ') + ret.append(repr(self.approx_eff_swap_conc)) + ret.append('}') + return ''.join(ret) + + _dt_array_initialisers = [] + + +misc_types = Misc_Types() + + + + class Generator(f90wrap.runtime.FortranModule): """ Module artemis__generator @@ -584,6 +1014,219 @@ def __del__(self): if self._alloc: _artemis.f90wrap_intf_gen__artemis_gen_type_finalise(this=self._handle) + def get_all_structures_data(self): + """ + output = get_all_structure_data__binding__artemis_generator_type(self) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 134-146 + + Parameters + ---------- + this : Artemis_Generator_Type + + Returns + ------- + output : Struc_Data_Type array + + """ + output = [] + for i in range(self.num_structures): + output.append(self.get_structure_data(i)) + + # output = \ + # _artemis.f90wrap_intf_gen__get_all_structures_data__binding_agt(this=self._handle) + # output = \ + # f90wrap.runtime.lookup_class("artemis.struc_data_type").from_handle(output, \ + # alloc=True) + return output + + def get_structure_data(self, idx): + """ + output = get_structure_data__binding__artemis_generator_type(self, idx) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 150-160 + + Parameters + ---------- + this : Artemis_Generator_Type + idx : int + + Returns + ------- + output : Struc_Data_Type + + """ + output = \ + _artemis.f90wrap_intf_gen__get_structure_data__binding_agt(this=self._handle, \ + idx=idx) + output = \ + f90wrap.runtime.lookup_class("artemis.struc_data_type").from_handle(output, \ + alloc=True) + + output_dict = { + 'match_idx': output.match_idx, + 'shift_idx': output.shift_idx, + 'swap_idx': output.swap_idx, + 'from_pricel_lw': output.from_pricel_lw, + 'from_pricel_up': output.from_pricel_up, + 'term_lw_idx': output.term_lw_idx, + 'term_up_idx': output.term_up_idx, + 'transform_lw': output.transform_lw, + 'transform_up': output.transform_up, + 'approx_thickness_lw': output.approx_thickness_lw, + 'approx_thickness_up': output.approx_thickness_up, + 'mismatch': output.mismatch, + 'shift': output.shift, + 'swap_density': output.swap_density, + 'approx_eff_swap_conc': output.approx_eff_swap_conc + } + + return output_dict + + def get_all_structures_mismatch(self): + """ + output = get_all_structures_mismatch__binding__artemis_generator_type(self) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 130-142 + + Parameters + ---------- + this : Artemis_Generator_Type + + Returns + ------- + output : float array + + """ + output = \ + _artemis.f90wrap_intf_gen__get_all_structures_mismatch__binding_agt(this=self._handle) + return output + + def get_structure_mismatch(self, idx): + """ + output = get_structure_mismatch__binding__artemis_generator_type(self, idx) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 146-156 + + Parameters + ---------- + this : Artemis_Generator_Type + idx : int + + Returns + ------- + output : float array + + """ + output = \ + _artemis.f90wrap_intf_gen__get_structure_mismatch__binding_agt(this=self._handle, \ + idx=idx) + return output + + def get_all_structures_transform(self): + """ + output = get_all_structures_transform__binding__artemis_generator_type(self) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 160-174 + + Parameters + ---------- + this : Artemis_Generator_Type + + Returns + ------- + output : int array + + """ + output = \ + _artemis.f90wrap_intf_gen__get_all_structures_transform__binding_agt(this=self._handle) + return output + + def get_structure_transform(self, idx): + """ + output = get_structure_transform__binding__artemis_generator_type(self, idx) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 178-189 + + Parameters + ---------- + this : Artemis_Generator_Type + idx : int + + Returns + ------- + output : int array + + """ + output = \ + _artemis.f90wrap_intf_gen__get_structure_transform__binding_agt(this=self._handle, \ + idx=idx) + return output + + def get_all_structures_shift(self): + """ + output = get_all_structures_shifts__binding__artemis_generator_type(self) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 193-205 + + Parameters + ---------- + this : Artemis_Generator_Type + + Returns + ------- + output : float array + + """ + output = \ + _artemis.f90wrap_intf_gen__get_all_structures_shift__binding_agt(this=self._handle) + return output + + def get_structure_shift(self, idx): + """ + output = get_structure_shifts__binding__artemis_generator_type(self, idx) + + + Defined at \ + ../fortran/lib/mod_generator.f90 \ + lines 209-219 + + Parameters + ---------- + this : Artemis_Generator_Type + idx : int + + Returns + ------- + output : float array + + """ + output = \ + _artemis.f90wrap_intf_gen__get_structure_shift__binding_agt(this=self._handle, \ + idx=idx) + return output + def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ area_mismatch=None, max_length=None, max_area=None, max_fit=None, \ max_extension=None, angle_weight=None, area_weight=None): @@ -626,7 +1269,7 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + ../fortran/lib/mod_generator.f90 \ lines 180-252 Parameters @@ -666,7 +1309,7 @@ def set_swap_method(self, method=None, num_swaps=None, swap_density=None, \ Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + ../fortran/lib/mod_generator.f90 \ lines 259-283 Parameters @@ -693,7 +1336,7 @@ def set_match_method(self, method=None, max_num_matches=None, \ Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + ../fortran/lib/mod_generator.f90 \ lines 290-310 Parameters @@ -719,7 +1362,7 @@ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ lines 252-287 Parameters @@ -761,7 +1404,7 @@ def set_surface_properties(self, miller_lw=None, miller_up=None, \ Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_generator.f90 \ + ../fortran/lib/mod_generator.f90 \ lines 364-435 Parameters @@ -790,7 +1433,7 @@ def reset_is_layered_lw(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ lines 322-329 Parameters @@ -806,7 +1449,7 @@ def reset_is_layered_up(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ lines 333-340 Parameters @@ -1073,23 +1716,23 @@ def structure_lw(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 32 """ structure_lw_handle = \ - _artemis.f90wrap_artemis_generator_type__get__structure_lw(self._handle) + _artemis.f90wrap_artemis_gen_type__get__structure_lw(self._handle) if tuple(structure_lw_handle) in self._objs: structure_lw = self._objs[tuple(structure_lw_handle)] else: - structure_lw = artemis__geom_rw.basis_type.from_handle(structure_lw_handle) + structure_lw = geom_rw.basis_type.from_handle(structure_lw_handle) self._objs[tuple(structure_lw_handle)] = structure_lw return structure_lw @structure_lw.setter def structure_lw(self, structure_lw): structure_lw = structure_lw._handle - _artemis.f90wrap_artemis_generator_type__set__structure_lw(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__structure_lw(self._handle, \ structure_lw) @property @@ -1099,23 +1742,23 @@ def structure_up(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 32 """ structure_up_handle = \ - _artemis.f90wrap_artemis_generator_type__get__structure_up(self._handle) + _artemis.f90wrap_artemis_gen_type__get__structure_up(self._handle) if tuple(structure_up_handle) in self._objs: structure_up = self._objs[tuple(structure_up_handle)] else: - structure_up = artemis__geom_rw.basis_type.from_handle(structure_up_handle) + structure_up = geom_rw.basis_type.from_handle(structure_up_handle) self._objs[tuple(structure_up_handle)] = structure_up return structure_up @structure_up.setter def structure_up(self, structure_up): structure_up = structure_up._handle - _artemis.f90wrap_artemis_generator_type__set__structure_up(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__structure_up(self._handle, \ structure_up) @property @@ -1125,19 +1768,19 @@ def elastic_constants_lw(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 34 """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_generator_type__array__elastic_co4c3f(self._handle) + _artemis.f90wrap_artemis_gen_type__array__elastic_co4c3f(self._handle) if array_handle in self._arrays: elastic_constants_lw = self._arrays[array_handle] else: elastic_constants_lw = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_generator_type__array__elastic_co4c3f) + _artemis.f90wrap_artemis_gen_type__array__elastic_co4c3f) self._arrays[array_handle] = elastic_constants_lw return elastic_constants_lw @@ -1152,19 +1795,19 @@ def elastic_constants_up(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 34 """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_generator_type__array__elastic_coedb6(self._handle) + _artemis.f90wrap_artemis_gen_type__array__elastic_coedb6(self._handle) if array_handle in self._arrays: elastic_constants_up = self._arrays[array_handle] else: elastic_constants_up = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_generator_type__array__elastic_coedb6) + _artemis.f90wrap_artemis_gen_type__array__elastic_coedb6) self._arrays[array_handle] = elastic_constants_up return elastic_constants_up @@ -1179,16 +1822,16 @@ def use_pricel_lw(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 36 """ return \ - _artemis.f90wrap_artemis_generator_type__get__use_pricel_lw(self._handle) + _artemis.f90wrap_artemis_gen_type__get__use_pricel_lw(self._handle) @use_pricel_lw.setter def use_pricel_lw(self, use_pricel_lw): - _artemis.f90wrap_artemis_generator_type__set__use_pricel_lw(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__use_pricel_lw(self._handle, \ use_pricel_lw) @property @@ -1198,16 +1841,16 @@ def use_pricel_up(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 36 """ return \ - _artemis.f90wrap_artemis_generator_type__get__use_pricel_up(self._handle) + _artemis.f90wrap_artemis_gen_type__get__use_pricel_up(self._handle) @use_pricel_up.setter def use_pricel_up(self, use_pricel_up): - _artemis.f90wrap_artemis_generator_type__set__use_pricel_up(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__use_pricel_up(self._handle, \ use_pricel_up) @property @@ -1217,18 +1860,18 @@ def miller_lw(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 38 """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_generator_type__array__miller_lw(self._handle) + _artemis.f90wrap_artemis_gen_type__array__miller_lw(self._handle) if array_handle in self._arrays: miller_lw = self._arrays[array_handle] else: miller_lw = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_generator_type__array__miller_lw) + _artemis.f90wrap_artemis_gen_type__array__miller_lw) self._arrays[array_handle] = miller_lw return miller_lw @@ -1243,18 +1886,18 @@ def miller_up(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 38 """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_generator_type__array__miller_up(self._handle) + _artemis.f90wrap_artemis_gen_type__array__miller_up(self._handle) if array_handle in self._arrays: miller_up = self._arrays[array_handle] else: miller_up = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, - _artemis.f90wrap_artemis_generator_type__array__miller_up) + _artemis.f90wrap_artemis_gen_type__array__miller_up) self._arrays[array_handle] = miller_up return miller_up @@ -1269,16 +1912,16 @@ def is_layered_lw(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 40 """ return \ - _artemis.f90wrap_artemis_generator_type__get__is_layered_lw(self._handle) + _artemis.f90wrap_artemis_gen_type__get__is_layered_lw(self._handle) @is_layered_lw.setter def is_layered_lw(self, is_layered_lw): - _artemis.f90wrap_artemis_generator_type__set__is_layered_lw(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__is_layered_lw(self._handle, \ is_layered_lw) @property @@ -1288,16 +1931,16 @@ def is_layered_up(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 40 """ return \ - _artemis.f90wrap_artemis_generator_type__get__is_layered_up(self._handle) + _artemis.f90wrap_artemis_gen_type__get__is_layered_up(self._handle) @is_layered_up.setter def is_layered_up(self, is_layered_up): - _artemis.f90wrap_artemis_generator_type__set__is_layered_up(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__is_layered_up(self._handle, \ is_layered_up) @property @@ -1307,16 +1950,16 @@ def ludef_is_layered_lw(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 42 """ return \ - _artemis.f90wrap_artemis_generator_type__get__ludef_is_lay4aa6(self._handle) + _artemis.f90wrap_artemis_gen_type__get__ludef_is_lay4aa6(self._handle) @ludef_is_layered_lw.setter def ludef_is_layered_lw(self, ludef_is_layered_lw): - _artemis.f90wrap_artemis_generator_type__set__ludef_is_lay87a5(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__ludef_is_lay87a5(self._handle, \ ludef_is_layered_lw) @property @@ -1326,16 +1969,16 @@ def ludef_is_layered_up(self): Defined at \ - /Users/nedtaylor/DCoding/DGit/ARTEMIS/src/fortran/lib/mod_intf_generator.f90 \ + ../fortran/lib/mod_intf_generator.f90 \ line 42 """ return \ - _artemis.f90wrap_artemis_generator_type__get__ludef_is_lay60fd(self._handle) + _artemis.f90wrap_artemis_gen_type__get__ludef_is_lay60fd(self._handle) @ludef_is_layered_up.setter def ludef_is_layered_up(self, ludef_is_layered_up): - _artemis.f90wrap_artemis_generator_type__set__ludef_is_laye6e4(self._handle, \ + _artemis.f90wrap_artemis_gen_type__set__ludef_is_laye6e4(self._handle, \ ludef_is_layered_up) @property @@ -1459,31 +2102,21 @@ def depth_method(self, depth_method): _artemis.f90wrap_artemis_gen_type__set__depth_method(self._handle, \ depth_method) - @property - def shift_data(self): - """ - Element shift_data ftype=real(real32) pytype=float + def init_array_structure_data(self): + self.structure_data = f90wrap.runtime.FortranDerivedTypeArray(self, + _artemis.f90wrap_artemis_gen_type__array_getitem__structure_data, + _artemis.f90wrap_artemis_gen_type__array_setitem__structure_data, + _artemis.f90wrap_artemis_gen_type__array_len__structure_data, + """ + Element structure_data ftype=type(struc_data_type) pytype=Struc_Data_Type Defined at \ - ../src/fortran/lib/mod_intf_generator.f90 \ - line 43 + ../fortran/lib/mod_generator.f90 line \ + 56 - """ - array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_gen_type__array__shift_data(self._handle) - if array_handle in self._arrays: - shift_data = self._arrays[array_handle] - else: - shift_data = f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, - self._handle, - _artemis.f90wrap_artemis_gen_type__array__shift_data) - self._arrays[array_handle] = shift_data - return shift_data - - @shift_data.setter - def shift_data(self, shift_data): - self.shift_data[...] = shift_data + """, Misc_Types.struc_data_type) + return self.structure_data @property def swap_method(self): diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 5ed6d67..1c5d640 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -7,7 +7,7 @@ module artemis__generator use artemis__constants, only: real32, ierror, pi use artemis__misc, only: to_lower,to_upper - use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type + use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type, struc_data_type use artemis__geom_rw, only: basis_type,geom_write use lat_compare, only: lattice_matching, cyc_lat1 use artemis__io_utils, only: err_abort, print_warning, stop_program @@ -61,17 +61,8 @@ module artemis__generator integer :: depth_method = 0 !! Method for determining the depth to which consider atoms from interface - integer, dimension(:,:,:,:), allocatable :: match_data - !! Data of matches for each interface - !! indices 1 and 2 are the transformation matrices - !! index 3 is length 2, where element 1 is lower, element 2 is upper - !! index 4 is the interface number in structures - real(real32), dimension(:,:), allocatable :: mismatch_data - !! Data of mismatches for each interface - !! index 1 is length 3, element 1 = length, element 2 = angle, element 3 = area - !! index 2 is the interface number in structures - real(real32), dimension(:,:), allocatable :: shift_data - !! Data of shifts for each interface, where index 1 is the interface number in structures + type(struc_data_type), dimension(:), allocatable :: structure_data + !! Structure data integer :: swap_method = 0 !! Swap method @@ -110,6 +101,23 @@ module artemis__generator real(real32) :: tol_sym = 1.E-6_real32 contains + procedure, pass(this) :: get_all_structures_data + !! Get the structure data for all structures + procedure, pass(this) :: get_structure_data + !! Get the structure data for a specific structure + procedure, pass(this) :: get_all_structures_mismatch + !! Get the mismatch data for all structures + procedure, pass(this) :: get_structure_mismatch + !! Get the mismatch data for a specific structure + procedure, pass(this) :: get_all_structures_transform + !! Get the structure data for a specific structure + procedure, pass(this) :: get_structure_transform + !! Get the structure data for a specific structure + procedure, pass(this) :: get_all_structures_shift + !! Get the shifts for all structures + procedure, pass(this) :: get_structure_shift + !! Get the shifts for a specific structure + procedure, pass(this) :: set_tolerance !! Set tolerance for identifying good lattice matches procedure, pass(this) :: set_shift_method @@ -127,7 +135,7 @@ module artemis__generator !! Reset the is_layered flags for the lower bulk structure procedure, pass(this) :: reset_is_layered_up !! Reset the is_layered flags for the upper bulk structure - + procedure, pass(this) :: get_terminations !! Return the terminations for structure procedure, pass(this) :: get_interface_location @@ -143,6 +151,181 @@ module artemis__generator contains +!############################################################################### + function get_all_structures_data(this) result(output) + !! Get the structure data for all structures + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + + type(struc_data_type), dimension(this%num_structures) :: output + !! Structure data + + ! Local variables + integer :: i + + do i = 1, this%num_structures + output(i) = this%structure_data(i) + end do + + end function get_all_structures_data +!############################################################################### + + +!############################################################################### + function get_structure_data(this, idx) result(output) + !! Get the structure data for a specific structure + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + integer, intent(in) :: idx + !! Index of the structure + + type(struc_data_type) :: output + !! Structure data + + output = this%structure_data(idx) + + end function get_structure_data +!############################################################################### + + +!############################################################################### + function get_all_structures_mismatch(this) result(output) + !! Get the mismatch data for all structures + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + + real(real32), dimension(3,this%num_structures) :: output + !! Mismatch data + + ! Local variables + integer :: i + + do i = 1, this%num_structures + output(:,i) = this%structure_data(i)%mismatch + end do + + end function get_all_structures_mismatch +!############################################################################### + + +!############################################################################### + function get_structure_mismatch(this, idx) result(output) + !! Get the mismatch data for a specific structure + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + integer, intent(in) :: idx + !! Index of the structure + + real(real32), dimension(3) :: output + !! Mismatch data + + output = this%structure_data(idx)%mismatch + + end function get_structure_mismatch +!############################################################################### + + +!############################################################################### + function get_all_structures_transform(this) result(output) + !! Get the structure data for a specific structure + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + + integer, dimension(3,3,2,this%num_structures) :: output + !! Transformation data + + ! Local variables + integer :: i + ! Loop over all structures + + do i = 1, this%num_structures + output(:,:,1,i) = this%structure_data(i)%transform_lw + output(:,:,2,i) = this%structure_data(i)%transform_up + end do + + end function get_all_structures_transform +!############################################################################### + + +!############################################################################### + function get_structure_transform(this, idx) result(output) + !! Get the structure data for a specific structure + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + integer, intent(in) :: idx + !! Index of the structure + + integer, dimension(3,3,2) :: output + !! Transformation data + + output(:,:,1) = this%structure_data(idx)%transform_lw + output(:,:,2) = this%structure_data(idx)%transform_up + + end function get_structure_transform +!############################################################################### + + +!############################################################################### + function get_all_structures_shift(this) result(output) + !! Get the shifts for all structures + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + + real(real32), dimension(3,this%num_structures) :: output + !! Shift data + + ! Local variables + integer :: i + + do i = 1, this%num_structures + output(:,i) = this%structure_data(i)%shift + end do + + end function get_all_structures_shift +!############################################################################### + + +!############################################################################### + function get_structure_shift(this, idx) result(output) + !! Get the shifts for a specific structure + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + integer, intent(in) :: idx + !! Index of the structure + + real(real32), dimension(3) :: output + !! Shift data + + output = this%structure_data(idx)%shift + + end function get_structure_shift +!############################################################################### + + !############################################################################### subroutine set_tolerance( & this, & @@ -503,6 +686,13 @@ subroutine set_surface_properties( & return end select end if + if(any(this%layer_separation_cutoff.lt.1.E-2_real32))then + write(err_msg,'(A,I0,A)') & + "A layer separation this small is not realistic: ", & + this%layer_separation_cutoff + call stop_program(trim(err_msg)) + return + end if end subroutine set_surface_properties !############################################################################### @@ -902,6 +1092,8 @@ subroutine generate_interfaces_from_existing( & !! Minimum bond length type(intf_info_type) :: intf !! Interface information + type(struc_data_type) :: struc_data + !! Structure data real(real32), dimension(3) :: vtmp1 !! Temporary vector logical :: print_shift_info_ @@ -1000,6 +1192,7 @@ subroutine generate_interfaces_from_existing( & call this%generate_perturbations( & structure, intf%loc, & min_bond, bulk_DON, & + struc_data, & print_shift_info_, seed_arr, verbose_, exit_code_ & ) @@ -1122,6 +1315,9 @@ subroutine generate_interfaces( & !! Boolean whether to generate structures or just print information + type(struc_data_type) :: struc_data + !! Structure data (i.e. mismatch, terminations, etc) + integer :: ntrans, iunique, itmp1, num_structures_old integer :: layered_axis_lw, layered_axis_up real(real32) :: dtmp1, bondlength @@ -1215,6 +1411,7 @@ subroutine generate_interfaces( & call structure_lw%copy(this%structure_lw, length=4) call structure_up%copy(this%structure_up, length=4) if(.not.allocated(this%structures)) allocate(this%structures(0)) + if(.not.allocated(this%structure_data)) allocate(this%structure_data(0)) !--------------------------------------------------------------------------- @@ -1894,8 +2091,20 @@ subroutine generate_interfaces( & !------------------------------------------------------------------ ! Write information of current match to file in save directory !------------------------------------------------------------------ - call output_intf_data(SAV, ifit, lw_term, iterm_lw, up_term, iterm_up,& + call output_intf_data(SAV, ifit, lw_term, iterm_lw, up_term, iterm_up,& this%use_pricel_lw, this%use_pricel_up) + struc_data = struc_data_type( & + match_idx = ifit, & + from_pricel_lw = this%use_pricel_lw, & + from_pricel_up = this%use_pricel_up, & + term_lw_idx = iterm_lw, & + term_up_idx = iterm_up, & + approx_thickness_lw = max(thickness_lw_,height_lw), & + approx_thickness_up = max(thickness_up_,height_up), & + transform_lw = SAV%tf1(ifit,:,:), & + transform_up = SAV%tf2(ifit,:,:), & + mismatch = SAV%tol(ifit,:3) & + ) !------------------------------------------------------------------ @@ -1904,6 +2113,7 @@ subroutine generate_interfaces( & call this%generate_perturbations( & intf_basis, intf_loc, avg_min_bond, & bulk_DON, & + struc_data, & print_shift_info_, & seed_arr, & verbose_, & @@ -1931,7 +2141,7 @@ end subroutine generate_interfaces !!!############################################################################# !!! ISWAP METHOD NOT YET SET UP subroutine generate_shifts_and_swaps( & - this, basis, intf_loc, bond, bulk_DON, print_shift_info, & + this, basis, intf_loc, bond, bulk_DON, struc_data, print_shift_info, & seed_arr, verbose, exit_code, map & ) implicit none @@ -1941,6 +2151,7 @@ subroutine generate_shifts_and_swaps( & real(real32), intent(in) :: bond type(bulk_DON_type), dimension(2), intent(in) :: bulk_DON !! Distribution functions for the lower and upper bulk structures + type(struc_data_type), intent(in) :: struc_data logical, intent(in) :: print_shift_info integer, dimension(:), intent(in) :: seed_arr integer, intent(in) :: verbose @@ -1953,6 +2164,8 @@ subroutine generate_shifts_and_swaps( & real(real32) :: dtmp1 type(basis_type) :: tbas type(bond_type) :: min_bond + type(struc_data_type) :: struc_data_shift + type(struc_data_type), dimension(:), allocatable :: struc_data_swaps character(len=256) :: err_msg integer, dimension(3) :: abc real(real32), dimension(3) :: toffset @@ -2124,8 +2337,12 @@ subroutine generate_shifts_and_swaps( & ! open(unit=ounit,file=trim(adjustl(filename))) ! call geom_write(ounit,tbas) ! close(ounit) + struc_data_shift = struc_data + struc_data_shift%shift_idx = k + struc_data_shift%shift = toffset this%structures = [ this%structures, tbas ] this%num_structures = size(this%structures, dim = 1) + this%structure_data = [ this%structure_data, struc_data_shift ] if(this%num_structures.ge.this%max_num_structures) return @@ -2148,11 +2365,20 @@ subroutine generate_shifts_and_swaps( & if(ngen_swaps.eq.0)then exit if_swap end if + if(allocated(struc_data_swaps)) deallocate(struc_data_swaps) + allocate(struc_data_swaps(ngen_swaps)) + do l=1,ngen_swaps + struc_data_swaps(l) = struc_data_shift + struc_data_swaps(l)%swap_idx = l + struc_data_swaps(l)%swap_density = this%swap_density + ! struc_data_swaps(l)%approx_eff_swap_conc = + end do ! call chdir(dirpath) ! call system('mkdir -p '//trim(adjustl(swapdir))) ! call chdir(swapdir) ! write(*,'(3X,"Number of unique swap structures: ",I0)') ngen_swaps this%structures = [ this%structures, bas_arr(1:ngen_swaps) ] + this%structure_data = [ this%structure_data, struc_data_swaps ] ! do l=1,ngen_swaps ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),l ! call system('mkdir -p '//trim(adjustl(dirpath))) diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 68372dc..cccd489 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -9,11 +9,59 @@ module artemis__misc_types private + public :: struc_data_type public :: latmatch_type public :: tol_type public :: abstract_artemis_generator_type + type struc_data_type + integer :: match_idx = 0 + integer :: shift_idx = 0 + integer :: swap_idx = 0 + logical :: from_pricel_lw = .false. + logical :: from_pricel_up = .false. + integer, dimension(2) :: term_lw_idx = 0 + integer, dimension(2) :: term_up_idx = 0 + integer, dimension(3,3) :: transform_lw = 0 + integer, dimension(3,3) :: transform_up = 0 + real(real32) :: approx_thickness_lw = 0._real32 + real(real32) :: approx_thickness_up = 0._real32 + real(real32), dimension(3) :: mismatch + real(real32), dimension(3) :: shift = 0._real32 + ! real(real32), dimension(:,:) :: swaps !!! UNSURE HOW TO DO THIS + real(real32) :: swap_density = 0._real32 + real(real32), dimension(2) :: approx_eff_swap_conc = 0._real32 + ! contains + ! procedure, pass(this) :: init => init_struc_data_type + end type struc_data_type + + interface struc_data_type + module function init_struc_data_type( & + match_idx, & + from_pricel_lw, from_pricel_up, & + term_lw_idx, term_up_idx, & + transform_lw, transform_up, & + approx_thickness_lw, approx_thickness_up, & + mismatch, & + shift_idx, shift, & + swap_idx, swap_density, approx_eff_swap_conc & + ) result(output) + integer, intent(in) :: match_idx + logical, intent(in) :: from_pricel_lw, from_pricel_up + integer, dimension(2), intent(in) :: term_lw_idx, term_up_idx + integer, dimension(3,3), intent(in) :: transform_lw, transform_up + real(real32), intent(in) :: approx_thickness_lw, approx_thickness_up + real(real32), dimension(3), intent(in) :: mismatch + integer, intent(in), optional :: shift_idx + real(real32), dimension(3), intent(in), optional :: shift + integer, intent(in), optional :: swap_idx + real(real32), intent(in), optional :: swap_density + real(real32), dimension(2), intent(in), optional :: approx_eff_swap_conc + type(struc_data_type) :: output + end function init_struc_data_type + end interface struc_data_type + type latmatch_type integer :: nfit integer :: max_num_matches = 5 @@ -62,6 +110,55 @@ module artemis__misc_types contains +!############################################################################### + module function init_struc_data_type( & + match_idx, & + from_pricel_lw, from_pricel_up, & + term_lw_idx, term_up_idx, & + transform_lw, transform_up, & + approx_thickness_lw, approx_thickness_up, & + mismatch, & + shift_idx, shift, & + swap_idx, swap_density, approx_eff_swap_conc & + ) result(output) + implicit none + integer, intent(in) :: match_idx + logical, intent(in) :: from_pricel_lw, from_pricel_up + integer, dimension(2), intent(in) :: term_lw_idx, term_up_idx + integer, dimension(3,3), intent(in) :: transform_lw, transform_up + real(real32), intent(in) :: approx_thickness_lw, approx_thickness_up + real(real32), dimension(3), intent(in) :: mismatch + integer, intent(in), optional :: shift_idx + real(real32), dimension(3), intent(in), optional :: shift + integer, intent(in), optional :: swap_idx + real(real32), intent(in), optional :: swap_density + real(real32), dimension(2), intent(in), optional :: approx_eff_swap_conc + + type(struc_data_type) :: output + + output%match_idx = match_idx + output%from_pricel_lw = from_pricel_lw + output%from_pricel_up = from_pricel_up + output%term_lw_idx = term_lw_idx + output%term_up_idx = term_up_idx + output%transform_lw = transform_lw + output%transform_up = transform_up + output%approx_thickness_lw = approx_thickness_lw + output%approx_thickness_up = approx_thickness_up + output%mismatch = mismatch + + if(present(shift)) output%shift = shift + if(present(shift_idx)) output%shift_idx = shift_idx + + if(present(swap_idx)) output%swap_idx = swap_idx + if(present(swap_density)) output%swap_density = swap_density + if(present(approx_eff_swap_conc)) output%approx_eff_swap_conc = approx_eff_swap_conc + + end function init_struc_data_type + +!############################################################################### + + !############################################################################### subroutine latmatch_init( & this, tol, lattice_lw, lattice_up, max_num_matches, reduce_matches & diff --git a/src/wrapper/f90wrap_artemis.f90 b/src/wrapper/f90wrap_artemis.f90 index 2107ddb..09046ee 100644 --- a/src/wrapper/f90wrap_artemis.f90 +++ b/src/wrapper/f90wrap_artemis.f90 @@ -1,4 +1,4 @@ -! Module artemis defined in file ../artemis.f90 +! Module artemis defined in file ../fortran/artemis.f90 -! End of module artemis defined in file ../artemis.f90 +! End of module artemis defined in file ../fortran/artemis.f90 diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index e0807d8..4421685 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1,4 +1,4 @@ -! Module artemis__generator defined in file ../src/fortran/lib/mod_intf_generator.f90 +! Module artemis__generator defined in file ../fortran/lib/mod_intf_generator.f90 subroutine f90wrap_artemis_gen_type__get__num_structures(this, f90wrap_num_structures) use artemis__generator, only: artemis_generator_type @@ -546,30 +546,88 @@ subroutine f90wrap_artemis_gen_type__set__depth_method(this, f90wrap_depth_metho this_ptr%p%depth_method = f90wrap_depth_method end subroutine f90wrap_artemis_gen_type__set__depth_method -subroutine f90wrap_artemis_gen_type__array__shift_data(this, nd, dtype, dshape, dloc) +subroutine f90wrap_artemis_gen_type__array_getitem__structure_data(f90wrap_this, f90wrap_i, structure_dataitem) use artemis__generator, only: artemis_generator_type - use, intrinsic :: iso_c_binding, only : c_int + use artemis__misc_types, only: struc_data_type implicit none + type artemis_generator_type_ptr_type type(artemis_generator_type), pointer :: p => NULL() end type artemis_generator_type_ptr_type - integer(c_int), intent(in) :: this(2) + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: f90wrap_this(2) type(artemis_generator_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 + integer, intent(in) :: f90wrap_i + integer, intent(out) :: structure_dataitem(2) + type(struc_data_type_ptr_type) :: structure_data_ptr - nd = 2 - dtype = 11 - this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%shift_data)) then - dshape(1:2) = shape(this_ptr%p%shift_data) - dloc = loc(this_ptr%p%shift_data) + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structure_data)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structure_data)) then + call f90wrap_abort("array index out of range") + else + structure_data_ptr%p => this_ptr%p%structure_data(f90wrap_i) + structure_dataitem = transfer(structure_data_ptr,structure_dataitem) + endif else - dloc = 0 + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_artemis_gen_type__array_getitem__structure_data + +subroutine f90wrap_artemis_gen_type__array_setitem__structure_data(f90wrap_this, f90wrap_i, structure_dataitem) + use artemis__generator, only: artemis_generator_type + use artemis__misc_types, only: struc_data_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: f90wrap_this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_i + integer, intent(in) :: structure_dataitem(2) + type(struc_data_type_ptr_type) :: structure_data_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structure_data)) then + if (f90wrap_i < 1 .or. f90wrap_i > size(this_ptr%p%structure_data)) then + call f90wrap_abort("array index out of range") + else + structure_data_ptr = transfer(structure_dataitem,structure_data_ptr) + this_ptr%p%structure_data(f90wrap_i) = structure_data_ptr%p + endif + else + call f90wrap_abort("derived type array not allocated") + end if +end subroutine f90wrap_artemis_gen_type__array_setitem__structure_data + +subroutine f90wrap_artemis_gen_type__array_len__structure_data(f90wrap_this, f90wrap_n) + use artemis__generator, only: artemis_generator_type + use artemis__misc_types, only: struc_data_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(out) :: f90wrap_n + integer, intent(in) :: f90wrap_this(2) + type(artemis_generator_type_ptr_type) :: this_ptr + + this_ptr = transfer(f90wrap_this, this_ptr) + if (allocated(this_ptr%p%structure_data)) then + f90wrap_n = size(this_ptr%p%structure_data) + else + f90wrap_n = 0 end if -end subroutine f90wrap_artemis_gen_type__array__shift_data +end subroutine f90wrap_artemis_gen_type__array_len__structure_data subroutine f90wrap_artemis_gen_type__get__swap_method(this, f90wrap_swap_method) use artemis__generator, only: artemis_generator_type @@ -956,6 +1014,144 @@ subroutine f90wrap_intf_gen__artemis_gen_type_finalise(this) deallocate(this_ptr%p) end subroutine f90wrap_intf_gen__artemis_gen_type_finalise +subroutine f90wrap_intf_gen__get_all_structures_data__binding_agt(ret_output, this, n0) + use artemis__generator, only: artemis_generator_type + use artemis__misc_types, only: struc_data_type + implicit none + + type struc_data_type_xnum_array + type(struc_data_type), dimension(:), allocatable :: items + end type struc_data_type_xnum_array + + type struc_data_type_xnum_array_ptr_type + type(struc_data_type_xnum_array), pointer :: p => NULL() + end type struc_data_type_xnum_array_ptr_type + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(struc_data_type_xnum_array_ptr_type) :: ret_output_ptr + integer, intent(out), dimension(2) :: ret_output + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer :: n0 + this_ptr = transfer(this, this_ptr) + allocate(ret_output_ptr%p) + ret_output_ptr%p%items = this_ptr%p%get_all_structures_data() + ret_output = transfer(ret_output_ptr, ret_output) +end subroutine f90wrap_intf_gen__get_all_structures_data__binding_agt + +subroutine f90wrap_intf_gen__get_structure_data__binding_agt(this, ret_output, idx) + use artemis__generator, only: artemis_generator_type + use artemis__misc_types, only: struc_data_type + implicit none + + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + type(struc_data_type_ptr_type) :: ret_output_ptr + integer, intent(out), dimension(2) :: ret_output + integer, intent(in) :: idx + this_ptr = transfer(this, this_ptr) + allocate(ret_output_ptr%p) + ret_output_ptr%p = this_ptr%p%get_structure_data(idx=idx+1) + ret_output = transfer(ret_output_ptr, ret_output) +end subroutine f90wrap_intf_gen__get_structure_data__binding_agt + +subroutine f90wrap_intf_gen__get_all_structures_mismatch__binding_agt(ret_output, this, n0) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + real(4), intent(out), dimension(3,n0) :: ret_output + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer :: n0 + this_ptr = transfer(this, this_ptr) + ret_output = this_ptr%p%get_all_structures_mismatch() +end subroutine f90wrap_intf_gen__get_all_structures_mismatch__binding_agt + +subroutine f90wrap_intf_gen__get_structure_mismatch__binding_agt(this, ret_output, idx) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(3), intent(out) :: ret_output + integer, intent(in) :: idx + this_ptr = transfer(this, this_ptr) + ret_output = this_ptr%p%get_structure_mismatch(idx=idx) +end subroutine f90wrap_intf_gen__get_structure_mismatch__binding_agt + +subroutine f90wrap_intf_gen__get_all_structures_transform__binding_agt(ret_output, this, n0) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer, intent(out), dimension(3,3,2,n0) :: ret_output + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer :: n0 + this_ptr = transfer(this, this_ptr) + ret_output = this_ptr%p%get_all_structures_transform() +end subroutine f90wrap_intf_gen__get_all_structures_transform__binding_agt + +subroutine f90wrap_intf_gen__get_structure_transform__binding_agt(this, ret_output, idx) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer, dimension(3,3,2), intent(out) :: ret_output + integer, intent(in) :: idx + this_ptr = transfer(this, this_ptr) + ret_output = this_ptr%p%get_structure_transform(idx=idx) +end subroutine f90wrap_intf_gen__get_structure_transform__binding_agt + +subroutine f90wrap_intf_gen__get_all_structures_shift__binding_agt(ret_output, this, n0) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + real(4), intent(out), dimension(3,n0) :: ret_output + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + integer :: n0 + this_ptr = transfer(this, this_ptr) + ret_output = this_ptr%p%get_all_structures_shift() +end subroutine f90wrap_intf_gen__get_all_structures_shift__binding_agt + +subroutine f90wrap_intf_gen__get_structure_shift__binding_agt(this, ret_output, idx) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + real(4), dimension(3), intent(out) :: ret_output + integer, intent(in) :: idx + this_ptr = transfer(this, this_ptr) + ret_output = this_ptr%p%get_structure_shift(idx=idx) +end subroutine f90wrap_intf_gen__get_structure_shift__binding_agt + subroutine f90wrap_intf_gen__set_tolerance__bindind_agt(this, vector_mismatch, angle_mismatch, & area_mismatch, max_length, max_area, max_fit, max_extension, angle_weight, area_weight) use artemis__generator, only: artemis_generator_type @@ -1464,5 +1660,5 @@ subroutine f90wrap_artemis_gen_type__array_len__structures( & end subroutine f90wrap_artemis_gen_type__array_len__structures !############################################################################### -! End of module artemis__generator defined in file ../src/fortran/lib/mod_intf_generator.f90 +! End of module artemis__generator defined in file ../fortran/lib/mod_intf_generator.f90 diff --git a/src/wrapper/f90wrap_mod_geom_rw.f90 b/src/wrapper/f90wrap_mod_geom_rw.f90 index abb63ac..9713c12 100644 --- a/src/wrapper/f90wrap_mod_geom_rw.f90 +++ b/src/wrapper/f90wrap_mod_geom_rw.f90 @@ -1,4 +1,4 @@ -! Module artemis__geom_rw defined in file ../src/lib/mod_geom_rw.f90 +! Module artemis__geom_rw defined in file ../fortran/lib/mod_geom_rw.f90 subroutine f90wrap_species_type__array__atom(this, nd, dtype, dshape, dloc) use artemis__geom_rw, only: species_type @@ -861,5 +861,5 @@ subroutine f90wrap_geom_rw__set__igeom_output(f90wrap_igeom_output) artemis__geom_rw_igeom_output = f90wrap_igeom_output end subroutine f90wrap_geom_rw__set__igeom_output -! End of module artemis__geom_rw defined in file ../src/lib/mod_geom_rw.f90 +! End of module artemis__geom_rw defined in file ../fortran/lib/mod_geom_rw.f90 diff --git a/src/wrapper/f90wrap_mod_misc_types.f90 b/src/wrapper/f90wrap_mod_misc_types.f90 new file mode 100644 index 0000000..b96d092 --- /dev/null +++ b/src/wrapper/f90wrap_mod_misc_types.f90 @@ -0,0 +1,401 @@ +! Module artemis__misc_types defined in file ../fortran/lib/mod_misc_types.f90 + +subroutine f90wrap_struc_data_type__get__match_idx(this, f90wrap_match_idx) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_match_idx + + this_ptr = transfer(this, this_ptr) + f90wrap_match_idx = this_ptr%p%match_idx +end subroutine f90wrap_struc_data_type__get__match_idx + +subroutine f90wrap_struc_data_type__set__match_idx(this, f90wrap_match_idx) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_match_idx + + this_ptr = transfer(this, this_ptr) + this_ptr%p%match_idx = f90wrap_match_idx +end subroutine f90wrap_struc_data_type__set__match_idx + +subroutine f90wrap_struc_data_type__get__shift_idx(this, f90wrap_shift_idx) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_shift_idx + + this_ptr = transfer(this, this_ptr) + f90wrap_shift_idx = this_ptr%p%shift_idx +end subroutine f90wrap_struc_data_type__get__shift_idx + +subroutine f90wrap_struc_data_type__set__shift_idx(this, f90wrap_shift_idx) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_shift_idx + + this_ptr = transfer(this, this_ptr) + this_ptr%p%shift_idx = f90wrap_shift_idx +end subroutine f90wrap_struc_data_type__set__shift_idx + +subroutine f90wrap_struc_data_type__get__swap_idx(this, f90wrap_swap_idx) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(out) :: f90wrap_swap_idx + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_idx = this_ptr%p%swap_idx +end subroutine f90wrap_struc_data_type__get__swap_idx + +subroutine f90wrap_struc_data_type__set__swap_idx(this, f90wrap_swap_idx) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(in) :: f90wrap_swap_idx + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_idx = f90wrap_swap_idx +end subroutine f90wrap_struc_data_type__set__swap_idx + +subroutine f90wrap_struc_data_type__get__from_pricel_lw(this, f90wrap_from_pricel_lw) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_from_pricel_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_from_pricel_lw = this_ptr%p%from_pricel_lw +end subroutine f90wrap_struc_data_type__get__from_pricel_lw + +subroutine f90wrap_struc_data_type__set__from_pricel_lw(this, f90wrap_from_pricel_lw) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_from_pricel_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%from_pricel_lw = f90wrap_from_pricel_lw +end subroutine f90wrap_struc_data_type__set__from_pricel_lw + +subroutine f90wrap_struc_data_type__get__from_pricel_up(this, f90wrap_from_pricel_up) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + logical, intent(out) :: f90wrap_from_pricel_up + + this_ptr = transfer(this, this_ptr) + f90wrap_from_pricel_up = this_ptr%p%from_pricel_up +end subroutine f90wrap_struc_data_type__get__from_pricel_up + +subroutine f90wrap_struc_data_type__set__from_pricel_up(this, f90wrap_from_pricel_up) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + logical, intent(in) :: f90wrap_from_pricel_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%from_pricel_up = f90wrap_from_pricel_up +end subroutine f90wrap_struc_data_type__set__from_pricel_up + +subroutine f90wrap_struc_data_type__array__term_lw_idx(this, nd, dtype, dshape, dloc) + use artemis__misc_types, only: struc_data_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(struc_data_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%term_lw_idx) + dloc = loc(this_ptr%p%term_lw_idx) +end subroutine f90wrap_struc_data_type__array__term_lw_idx + +subroutine f90wrap_struc_data_type__array__term_up_idx(this, nd, dtype, dshape, dloc) + use artemis__misc_types, only: struc_data_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(struc_data_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%term_up_idx) + dloc = loc(this_ptr%p%term_up_idx) +end subroutine f90wrap_struc_data_type__array__term_up_idx + +subroutine f90wrap_struc_data_type__array__transform_lw(this, nd, dtype, dshape, dloc) + use artemis__misc_types, only: struc_data_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(struc_data_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 = 5 + this_ptr = transfer(this, this_ptr) + dshape(1:2) = shape(this_ptr%p%transform_lw) + dloc = loc(this_ptr%p%transform_lw) +end subroutine f90wrap_struc_data_type__array__transform_lw + +subroutine f90wrap_struc_data_type__array__transform_up(this, nd, dtype, dshape, dloc) + use artemis__misc_types, only: struc_data_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(struc_data_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 = 5 + this_ptr = transfer(this, this_ptr) + dshape(1:2) = shape(this_ptr%p%transform_up) + dloc = loc(this_ptr%p%transform_up) +end subroutine f90wrap_struc_data_type__array__transform_up + +subroutine f90wrap_struc_data_type__get__approx_thickness_lw(this, f90wrap_approx_thickness_lw) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_approx_thickness_lw + + this_ptr = transfer(this, this_ptr) + f90wrap_approx_thickness_lw = this_ptr%p%approx_thickness_lw +end subroutine f90wrap_struc_data_type__get__approx_thickness_lw + +subroutine f90wrap_struc_data_type__set__approx_thickness_lw(this, f90wrap_approx_thickness_lw) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_approx_thickness_lw + + this_ptr = transfer(this, this_ptr) + this_ptr%p%approx_thickness_lw = f90wrap_approx_thickness_lw +end subroutine f90wrap_struc_data_type__set__approx_thickness_lw + +subroutine f90wrap_struc_data_type__get__approx_thickness_up(this, f90wrap_approx_thickness_up) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_approx_thickness_up + + this_ptr = transfer(this, this_ptr) + f90wrap_approx_thickness_up = this_ptr%p%approx_thickness_up +end subroutine f90wrap_struc_data_type__get__approx_thickness_up + +subroutine f90wrap_struc_data_type__set__approx_thickness_up(this, f90wrap_approx_thickness_up) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_approx_thickness_up + + this_ptr = transfer(this, this_ptr) + this_ptr%p%approx_thickness_up = f90wrap_approx_thickness_up +end subroutine f90wrap_struc_data_type__set__approx_thickness_up + +subroutine f90wrap_struc_data_type__array__mismatch(this, nd, dtype, dshape, dloc) + use artemis__misc_types, only: struc_data_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(struc_data_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%mismatch) + dloc = loc(this_ptr%p%mismatch) +end subroutine f90wrap_struc_data_type__array__mismatch + +subroutine f90wrap_struc_data_type__array__shift(this, nd, dtype, dshape, dloc) + use artemis__misc_types, only: struc_data_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(struc_data_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%shift) + dloc = loc(this_ptr%p%shift) +end subroutine f90wrap_struc_data_type__array__shift + +subroutine f90wrap_struc_data_type__get__swap_density(this, f90wrap_swap_density) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + real(4), intent(out) :: f90wrap_swap_density + + this_ptr = transfer(this, this_ptr) + f90wrap_swap_density = this_ptr%p%swap_density +end subroutine f90wrap_struc_data_type__get__swap_density + +subroutine f90wrap_struc_data_type__set__swap_density(this, f90wrap_swap_density) + use artemis__misc_types, only: struc_data_type + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer, intent(in) :: this(2) + type(struc_data_type_ptr_type) :: this_ptr + real(4), intent(in) :: f90wrap_swap_density + + this_ptr = transfer(this, this_ptr) + this_ptr%p%swap_density = f90wrap_swap_density +end subroutine f90wrap_struc_data_type__set__swap_density + +subroutine f90wrap_struc_data_type__array__approx_eff_swap_conc(this, nd, dtype, dshape, dloc) + use artemis__misc_types, only: struc_data_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(struc_data_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%approx_eff_swap_conc) + dloc = loc(this_ptr%p%approx_eff_swap_conc) +end subroutine f90wrap_struc_data_type__array__approx_eff_swap_conc + +subroutine f90wrap_misc_types__struc_data_type_initialise(this) + use artemis__misc_types, only: struc_data_type + implicit none + + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(out), dimension(2) :: this + allocate(this_ptr%p) + this = transfer(this_ptr, this) +end subroutine f90wrap_misc_types__struc_data_type_initialise + +subroutine f90wrap_misc_types__struc_data_type_finalise(this) + use artemis__misc_types, only: struc_data_type + implicit none + + type struc_data_type_ptr_type + type(struc_data_type), pointer :: p => NULL() + end type struc_data_type_ptr_type + type(struc_data_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + deallocate(this_ptr%p) +end subroutine f90wrap_misc_types__struc_data_type_finalise + +! End of module artemis__misc_types defined in file ../fortran/lib/mod_misc_types.f90 + From fbfa3b0795c68d3cf4d6d88abffdc290362ac093 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Wed, 23 Apr 2025 08:43:29 +0100 Subject: [PATCH 082/137] Reintroduce file printing to fortran app --- CMakeLists.txt | 5 +++-- app/inputs.f90 | 4 ++-- app/main.f90 | 18 ++++++++++++++++-- src/fortran/lib/mod_misc_types.f90 | 10 +++++----- 4 files changed, 26 insertions(+), 11 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 47b08de..3d4d1dc 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,7 +65,6 @@ set(LIB_FILES mod_io_utils_extd.F90 mod_sym.f90 mod_terminations.f90 - mod_misc_types.f90 mod_intf_identifier.f90 mod_plane_matching.f90 mod_lat_compare.f90 @@ -76,6 +75,7 @@ set(LIB_FILES # Main source files set(SPECIAL_LIB_FILES + mod_misc_types.f90 mod_geom_rw.f90 mod_generator.f90 ) @@ -284,6 +284,7 @@ if (BUILD_PYTHON) # Generate f90wrap signature file set(F90WRAP_FILE ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_generator.f90 + ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_misc_types.f90 ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_mod_geom_rw.f90 ${CMAKE_CURRENT_LIST_DIR}/src/wrapper/f90wrap_artemis.f90 ) @@ -297,7 +298,7 @@ if (BUILD_PYTHON) -m ${PROJECT_NAME} -k ${KIND_MAP} ${F90WRAP_FORTRAN_SRC_FILES} - --only artemis_generator_type basis_type: + --only artemis_generator_type basis_type struc_data_type: DEPENDS ${F90WRAP_FORTRAN_SRC_FILES} WORKING_DIRECTORY ${CMAKE_BUILD_DIR} COMMENT "Generating f90wrap signature file" diff --git a/app/inputs.f90 b/app/inputs.f90 index 8585435..bb611e7 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -116,8 +116,8 @@ subroutine set_global_vars() struc2_file="" out_filename="" dirname="DINTERFACES" - shiftdir="DSHIFTS" - swapdir="DSWAPS" + shiftdir="DSHIFT" + swapdir="DSWAP" subdir_prefix="D" n=1 clock = 0 diff --git a/app/main.f90 b/app/main.f90 index 7ffe2c9..c086433 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -11,7 +11,7 @@ program artemis_executable integer :: i, unit - character(len=256) :: filename + character(len=256) :: filepath, filename type(artemis_generator_type) :: generator type(basis_type), allocatable, dimension(:) :: structures @@ -180,7 +180,21 @@ program artemis_executable seed = clock, & verbose = verbose & ) - call generator%write_structures(directory = "DINTERFACES", prefix= "") + ! call generator%write_structures(directory = "DINTERFACES", prefix= "") + do i = 1, generator%num_structures + write(filepath, '(A,"/",A,I0.2)') trim(dirname), trim(subdir_prefix), generator%structure_data(i)%match_idx + if(generator%structure_data(i)%shift_idx.gt.0)then + write(filepath, '(A,"/",A,"/",A,I0.2)') trim(filepath), trim(shiftdir), trim(subdir_prefix), generator%structure_data(i)%shift_idx + end if + if(generator%structure_data(i)%swap_idx.gt.0)then + write(filepath, '(A,"/",A,"/",A,I0.2)') trim(filepath), trim(swapdir), trim(subdir_prefix), generator%structure_data(i)%swap_idx + end if + call system("mkdir -p " // trim(filepath)) + write(filename, '(A,"/",A)') trim(filepath), "POSCAR" + open(newunit=unit, status='replace', file=trim(filename)) + call geom_write(unit, generator%structures(i)) + close(unit) + end do else call generator%restart(struc1_bas) end if diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index cccd489..6ef6f43 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -81,12 +81,12 @@ end function init_struc_data_type type tol_type integer :: maxfit = 100 integer :: maxsize = 10 - real(real32) :: maxlen=20._real32 - real(real32) :: maxarea=400._real32 - real(real32) :: vec = 5._real32 / 100._real32 - real(real32) :: ang = 1._real32 * pi / 180._real32 + real(real32) :: maxlen = 20._real32 + real(real32) :: maxarea = 400._real32 + real(real32) :: vec = 5._real32 / 100._real32 + real(real32) :: ang = 1._real32 * pi / 180._real32 real(real32) :: area = 10._real32 / 100._real32 - real(real32) :: ang_weight = 10._real32 + real(real32) :: ang_weight = 10._real32 real(real32) :: area_weight = 100._real32 end type tol_type From 0d44a0f53bf61fffdf0a20f16eda032218b51244 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 07:06:26 +0100 Subject: [PATCH 083/137] Reintroduce match, termination, and shift data printing --- app/main.f90 | 71 +++++--- src/fortran/lib/mod_generator.f90 | 251 ++++++++++++++++++++-------- src/fortran/lib/mod_lat_compare.f90 | 4 +- src/fortran/lib/mod_misc_types.f90 | 19 ++- src/fortran/lib/mod_shifting.f90 | 54 +++--- src/fortran/lib/mod_swapping.f90 | 26 ++- 6 files changed, 294 insertions(+), 131 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index c086433..6916bfa 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -10,7 +10,8 @@ program artemis_executable implicit none - integer :: i, unit + integer :: i, j, unit + integer, dimension(:), allocatable :: match_idx_list, idx_list(:) character(len=256) :: filepath, filename type(artemis_generator_type) :: generator type(basis_type), allocatable, dimension(:) :: structures @@ -163,9 +164,6 @@ program artemis_executable !! interface generator !!------------------------------------------------------------------------- if(irestart.eq.0)then - !!! NEED TO BE ABLE TO SET MAX_NUM_STRUCTURES - !!! lortho, printing directories and directory space - !!! sort out match, term, shift, and swap data call generator%generate( & surface_lw = lw_surf, surface_up = up_surf, & thickness_lw = lw_thickness, thickness_up = up_thickness, & @@ -180,24 +178,59 @@ program artemis_executable seed = clock, & verbose = verbose & ) - ! call generator%write_structures(directory = "DINTERFACES", prefix= "") - do i = 1, generator%num_structures - write(filepath, '(A,"/",A,I0.2)') trim(dirname), trim(subdir_prefix), generator%structure_data(i)%match_idx - if(generator%structure_data(i)%shift_idx.gt.0)then - write(filepath, '(A,"/",A,"/",A,I0.2)') trim(filepath), trim(shiftdir), trim(subdir_prefix), generator%structure_data(i)%shift_idx - end if - if(generator%structure_data(i)%swap_idx.gt.0)then - write(filepath, '(A,"/",A,"/",A,I0.2)') trim(filepath), trim(swapdir), trim(subdir_prefix), generator%structure_data(i)%swap_idx - end if - call system("mkdir -p " // trim(filepath)) - write(filename, '(A,"/",A)') trim(filepath), "POSCAR" - open(newunit=unit, status='replace', file=trim(filename)) - call geom_write(unit, generator%structures(i)) - close(unit) - end do else call generator%restart(struc1_bas) end if + allocate(match_idx_list(0)) + do i = 1, generator%num_structures + write(filepath, '(A,"/",A,I0.2)') & + trim(adjustl(dirname)), & + trim(adjustl(subdir_prefix)), & + generator%structure_data(i)%match_idx + if(all(generator%structure_data(1:i-1:1)%match_idx.ne.generator%structure_data(i)%match_idx))then + call system("mkdir -p " // trim(filepath)) + call generator%write_match_and_term_data(i, & + directory = trim(filepath), & + filename = "struc_data.txt" & + ) + else + match_idx_list = [ match_idx_list, generator%structure_data(i)%match_idx ] + end if + if(generator%structure_data(i)%shift_idx.gt.0)then + write(filepath, '(A,"/",A,"/",A,I0.2)') & + trim(adjustl(filepath)), trim(adjustl(shiftdir)), & + trim(adjustl(subdir_prefix)), & + generator%structure_data(i)%shift_idx + end if + if(generator%structure_data(i)%swap_idx.gt.0)then + write(filepath, '(A,"/",A,"/",A,I0.2)') & + trim(adjustl(filepath)), & + trim(adjustl(swapdir)), & + trim(adjustl(subdir_prefix)), & + generator%structure_data(i)%swap_idx + end if + call system("mkdir -p " // trim(filepath)) + write(filename, '(A,"/",A)') trim(filepath), "POSCAR" + open(newunit=unit, status='replace', file=trim(filename)) + call geom_write(unit, generator%structures(i)) + close(unit) + end do + ! get all indices with the same match_idx + ! write the shift data associated with all of them + do i = 1, size(match_idx_list) + idx_list = pack([(j, j=1, generator%num_structures)], & + generator%structure_data(:)%match_idx .eq. match_idx_list(i) ) + if(size(idx_list).eq.0) cycle + write(filepath, '(A,"/",A,I0.2,"/",A)') & + trim(dirname), & + trim(subdir_prefix), & + generator%structure_data(idx_list(1))%match_idx, & + trim(shiftdir) + call generator%write_shift_data(idx_list, & + directory = trim(filepath), & + filename = "shift_data.txt" & + ) + end do case(2) ! defects/ARTIE diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 1c5d640..3032da5 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -5,7 +5,7 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module artemis__generator - use artemis__constants, only: real32, ierror, pi + use artemis__constants, only: real32, pi use artemis__misc, only: to_lower,to_upper use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type, struc_data_type use artemis__geom_rw, only: basis_type,geom_write @@ -118,6 +118,11 @@ module artemis__generator procedure, pass(this) :: get_structure_shift !! Get the shifts for a specific structure + procedure, pass(this) :: write_match_and_term_data + !! Write the match and termination data to a file + procedure, pass(this) :: write_shift_data + !! Write the shift data to a file + procedure, pass(this) :: set_tolerance !! Set tolerance for identifying good lattice matches procedure, pass(this) :: set_shift_method @@ -1728,33 +1733,13 @@ subroutine generate_interfaces( & !! Determines the cell change for the upper lattice to get the new DON !!----------------------------------------------------------------------- if(this%shift_method.eq.4)then - !! Issue with using this method when large deformations result in large - !! angle changes. REMOVING IT FOR NOW AND RETURNING TO CALCULATING DONS - !! FOR THE SUPERCELL. t1up_map=0 !TEMPORARY TO USE SUPERCELL DONS. - !do i=1,2 - ! mtmp1(i,:) = & - ! ( modu(lw_lat(i,:)) )*uvec(supercell_up%lat(i,:)) - !end do - !mtmp1(3,:) = supercell_up%lat(3,:) !DONsupercell_up%lat = matmul(mtmp1,inverse(real(SAV%tf2(ifit,:,:),real32))) - !if(ierror.eq.1)then - ! write(0,*) "#####################################" - ! write(0,*) "ifit", ifit - ! write(0,*) "undeformed lattice" - ! write(0,'(3(2X,F6.2))') (mtmp1(i,:),i=1,3) - ! write(0,*) - ! write(0,*) "deformed lattice" - ! write(0,'(3(2X,F8.4))') (DONsupercell_up%lat(i,:),i=1,3) - ! write(0,*) - !end if deallocate(bulk_DON(2)%spec) bulk_DON(2)%spec=gen_DON(supercell_up%lat,supercell_up,& dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) - !call err_abort_print_struc(structure_up,"bulk_up_term.vasp",& - ! "",.false.) end if @@ -1785,7 +1770,7 @@ subroutine generate_interfaces( & if(.not.compare_stoichiometry(structure_lw,supercell_lw))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the lower material on match ",I0)') ifit - if(ierror.eq.1)then + if(verbose_.gt.1)then call err_abort_print_struc(supercell_lw, "broken_primitive.vasp", & "Code exiting due to IPRINT = 1") end if @@ -1878,7 +1863,7 @@ subroutine generate_interfaces( & if(.not.compare_stoichiometry(structure_up,supercell_up))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the upper material on match ",I0)') ifit - if(ierror.eq.1)then + if(verbose_.gt.1)then call err_abort_print_struc(supercell_up, "broken_primitive.vasp", & "Code exiting due to IPRINT = 1") end if @@ -2062,16 +2047,16 @@ subroutine generate_interfaces( & this%vacuum_gap)/modu(intf_basis%lat(this%axis,:)) intf_loc(2) = ( modu(slab_lw%lat(this%axis,:)) + modu(slab_up%lat(this%axis,:)) + & 1.5_real32*init_offset(this%axis) - 2._real32*this%vacuum_gap )/modu(intf_basis%lat(this%axis,:)) - if(ierror.ge.1)then + if(verbose_.ge.1)then write(0,*) "interface:",intf_loc - if(ierror.eq.1.and.iunique.eq.icheck_term_pair_-1)then + if(verbose_.eq.1.and.iunique.eq.icheck_term_pair_-1)then ! call chdir(intf_dir) call err_abort_print_struc(slab_lw,"lw_term.vasp",& "",.false.) call err_abort_print_struc(slab_up,"up_term.vasp",& "As IPRINT = 1 and ICHECK has been set, & &code is now exiting...") - elseif(ierror.eq.2.and.iunique.eq.icheck_term_pair_-1)then + elseif(verbose_.eq.2.and.iunique.eq.icheck_term_pair_-1)then ! call chdir(intf_dir) call err_abort_print_struc(intf_basis,"test_intf.vasp",& "As IPRINT = 2 and ICHECK has been set, & @@ -2091,14 +2076,30 @@ subroutine generate_interfaces( & !------------------------------------------------------------------ ! Write information of current match to file in save directory !------------------------------------------------------------------ - call output_intf_data(SAV, ifit, lw_term, iterm_lw, up_term, iterm_up,& - this%use_pricel_lw, this%use_pricel_up) + ! call output_intf_data(SAV, ifit, lw_term, iterm_lw, up_term, iterm_up,& + ! this%use_pricel_lw, this%use_pricel_up) struc_data = struc_data_type( & match_idx = ifit, & from_pricel_lw = this%use_pricel_lw, & from_pricel_up = this%use_pricel_up, & - term_lw_idx = iterm_lw, & - term_up_idx = iterm_up, & + term_lw_idx = [iterm_lw,max(surface_lw_(2),iterm_lw)], & + term_up_idx = [iterm_up,max(surface_up_(2),iterm_up)], & + term_lw_bounds = [ lw_term%arr(iterm_lw)%hmin, & + lw_term%arr(iterm_lw)%hmax, & + lw_term%arr(max(surface_lw_(2),iterm_lw))%hmin, & + lw_term%arr(max(surface_lw_(2),iterm_lw))%hmax & + ], & + term_up_bounds = [ up_term%arr(iterm_up)%hmin, & + up_term%arr(iterm_up)%hmax, & + up_term%arr(max(surface_up_(2),iterm_up))%hmin, & + up_term%arr(max(surface_up_(2),iterm_up))%hmax & + ], & + term_lw_natom = [ lw_term%arr(iterm_lw)%natom, & + lw_term%arr(max(surface_lw_(2),iterm_lw))%natom & + ], & + term_up_natom = [ up_term%arr(iterm_up)%natom, & + up_term%arr(max(surface_up_(2),iterm_up))%natom & + ], & approx_thickness_lw = max(thickness_lw_,height_lw), & approx_thickness_up = max(thickness_up_,height_up), & transform_lw = SAV%tf1(ifit,:,:), & @@ -2233,7 +2234,7 @@ subroutine generate_shifts_and_swaps( & nstore=this%num_shifts, & c_scale=this%separation_scale, & offset=this%shifts(1,:3),& - lprint=print_shift_info, & + verbose=merge(1,verbose,print_shift_info), & bulk_DON=bulk_DON,bulk_map=map,& max_bondlength=this%bondlength_cutoff,& tol_sym=this%tol_sym) @@ -2245,7 +2246,7 @@ subroutine generate_shifts_and_swaps( & nstore=this%num_shifts, & c_scale=this%separation_scale, & offset=this%shifts(1,:3),& - lprint=print_shift_info,& + verbose=merge(1,verbose,print_shift_info), & max_bondlength=this%bondlength_cutoff,& tol_sym=this%tol_sym) end if @@ -2352,9 +2353,12 @@ subroutine generate_shifts_and_swaps( & if_swap: if(this%swap_method.ne.0)then bas_arr = rand_swapper(tbas%lat,tbas,this%axis,this%swap_depth,& nswaps_per_cell,this%num_swaps,intf_loc,this%swap_method,& - seed_arr,tol_sym=this%tol_sym,& - sigma=this%swap_sigma,& - require_mirror=this%require_mirror_swaps) + seed_arr, & + tol_sym = this%tol_sym, & + verbose = verbose, & + sigma=this%swap_sigma, & + require_mirror=this%require_mirror_swaps & + ) ngen_swaps = this%num_swaps LOOPswaps: do l=1,this%num_swaps if (bas_arr(l)%nspec.eq.0) then @@ -2404,51 +2408,150 @@ end subroutine generate_shifts_and_swaps !!!############################################################################# -!!!############################################################################# -!!! write structure data in each structure directory -!!!############################################################################# - subroutine output_intf_data(SAV, ifit, lw_term, term_lw_idx, up_term, term_up_idx, lw_pricel,up_pricel) +!############################################################################### + subroutine write_match_and_term_data(this, idx, directory, filename) + !! This subroutine writes the match and termination data to a file implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + integer, intent(in) :: idx + !! List of indices for the structures to be written + character(len=*), intent(in) :: directory + !! Directory where the files will be written + character(len=*), intent(in) :: filename + !! Name of the file to be written + + ! Local variables integer :: unit - integer, intent(in) :: ifit, term_lw_idx, term_up_idx - logical, intent(in) :: lw_pricel,up_pricel - type(term_arr_type), intent(in) :: lw_term, up_term - type(latmatch_type), intent(in) :: SAV + open(newunit=unit, file=trim(adjustl(directory))//"/"//trim(adjustl(filename))) + associate( struc_data => this%structure_data(idx) ) + write(unit,'("Lower material primitive cell used: ",L1)') struc_data%from_pricel_lw + write(unit,'("Upper material primitive cell used: ",L1)') struc_data%from_pricel_up + write(unit,*) + write(unit,'("Lattice match: ",I0)') struc_data%match_idx + write(unit,'((1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & + "a", "b", "c", "a", "b", "c", & + struc_data%transform_lw(1,1:3), struc_data%transform_up(1,1:3), & + struc_data%transform_lw(2,1:3), struc_data%transform_up(2,1:3), & + struc_data%transform_lw(3,1:3), struc_data%transform_up(3,1:3) + write(unit,'(" vector mismatch (%) = ",F0.9)') struc_data%mismatch(1) + write(unit,'(" angle mismatch (°) = ",F0.9)') struc_data%mismatch(2) * 180._real32 / pi + write(unit,'(" area mismatch (%) = ",F0.9)') struc_data%mismatch(3) + write(unit,*) + write(unit,'(" Lower crystal Miller plane: ",3(I3," "))') struc_data%transform_lw(3,1:3) + write(unit,'(" Lower termination")') + write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') + write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + struc_data%term_lw_idx(1), & + struc_data%term_lw_bounds(1:2), & + struc_data%term_lw_natom(1) + write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + struc_data%term_lw_idx(2), & + struc_data%term_lw_bounds(3:4), & + struc_data%term_lw_natom(2) + write(unit,*) + write(unit,'(" Upper crystal Miller plane: ",3(I3," "))') struc_data%transform_up(3,1:3) + write(unit,'(" Upper termination")') + write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') + write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + struc_data%term_up_idx(1), & + struc_data%term_up_bounds(1:2), & + struc_data%term_up_natom(1) + write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & + struc_data%term_up_idx(2), & + struc_data%term_up_bounds(3:4), & + struc_data%term_up_natom(2) + write(unit,*) + end associate - - unit=99 - open(unit=unit, file="struc_dat.txt") - write(unit,'("Lower material primitive cell used: ",L1)') lw_pricel - write(unit,'("Upper material primitive cell used: ",L1)') lw_pricel - write(unit,*) - write(unit,'("Lattice match: ",I0)') ifit - write(unit,'((1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & - SAV%abc,SAV%abc,& - SAV%tf1(ifit,1,1:3),SAV%tf2(ifit,1,1:3),& - SAV%tf1(ifit,2,1:3),SAV%tf2(ifit,2,1:3),& - SAV%tf1(ifit,3,1:3),SAV%tf2(ifit,3,1:3) - write(unit,'(" vector mismatch (%) = ",F0.9)') SAV%tol(ifit,1) - write(unit,'(" angle mismatch (°) = ",F0.9)') SAV%tol(ifit,2)*180/pi - write(unit,'(" area mismatch (%) = ",F0.9)') SAV%tol(ifit,3) - write(unit,*) - write(unit,'(" Lower crystal Miller plane: ",3(I3," "))') SAV%tf1(ifit,3,1:3) - write(unit,'(" Lower termination")') - write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') - write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - term_lw_idx,lw_term%arr(term_lw_idx)%hmin,lw_term%arr(term_lw_idx)%hmax,lw_term%arr(term_lw_idx)%natom - write(unit,*) - write(unit,'(" Upper crystal Miller plane: ",3(I3," "))') SAV%tf2(ifit,3,1:3) - write(unit,'(" Upper termination")') - write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') - write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & - term_up_idx,up_term%arr(term_up_idx)%hmin,up_term%arr(term_up_idx)%hmax,up_term%arr(term_up_idx)%natom - write(unit,*) close(unit) + + end subroutine write_match_and_term_data +!############################################################################### + + +!############################################################################### + subroutine write_shift_data(this, idx_list, directory, filename) + !! This subroutine writes the shift data to a file + implicit none + + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + integer, dimension(:), intent(in) :: idx_list + !! List of indices for the structures to be written + character(len=*), intent(in) :: directory + !! Directory where the files will be written + character(len=*), intent(in) :: filename + !! Name of the file to be written + + ! Local variables + integer :: i + integer :: unit + + + open(newunit=unit, file=trim(adjustl(directory))//"/"//trim(adjustl(filename))) + write(unit, & + '("# shift_num shift (a,b,c) units=(direct,direct,Å)")') + do i = 1, size(idx_list), 1 + write(unit,'(2X,I0.2,15X,"(",2(" ",F9.6,", ")," ",F9.6," )")') & + idx_list(i), this%structure_data(idx_list(i))%shift + end do + close(unit) + + end subroutine write_shift_data +!############################################################################### + + +! !!!############################################################################# +! !!! write structure data in each structure directory +! !!!############################################################################# +! subroutine output_intf_data(SAV, ifit, lw_term, term_lw_idx, up_term, term_up_idx, lw_pricel,up_pricel) +! implicit none +! integer :: unit + +! integer, intent(in) :: ifit, term_lw_idx, term_up_idx +! logical, intent(in) :: lw_pricel,up_pricel +! type(term_arr_type), intent(in) :: lw_term, up_term +! type(latmatch_type), intent(in) :: SAV + + - return - end subroutine output_intf_data -!!!############################################################################# +! unit=99 +! open(unit=unit, file="struc_dat.txt") +! write(unit,'("Lower material primitive cell used: ",L1)') lw_pricel +! write(unit,'("Upper material primitive cell used: ",L1)') lw_pricel +! write(unit,*) +! write(unit,'("Lattice match: ",I0)') ifit +! write(unit,'((1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & +! SAV%abc,SAV%abc,& +! SAV%tf1(ifit,1,1:3),SAV%tf2(ifit,1,1:3),& +! SAV%tf1(ifit,2,1:3),SAV%tf2(ifit,2,1:3),& +! SAV%tf1(ifit,3,1:3),SAV%tf2(ifit,3,1:3) +! write(unit,'(" vector mismatch (%) = ",F0.9)') SAV%tol(ifit,1) +! write(unit,'(" angle mismatch (°) = ",F0.9)') SAV%tol(ifit,2)*180/pi +! write(unit,'(" area mismatch (%) = ",F0.9)') SAV%tol(ifit,3) +! write(unit,*) +! write(unit,'(" Lower crystal Miller plane: ",3(I3," "))') SAV%tf1(ifit,3,1:3) +! write(unit,'(" Lower termination")') +! write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') +! write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & +! term_lw_idx,lw_term%arr(term_lw_idx)%hmin,lw_term%arr(term_lw_idx)%hmax,lw_term%arr(term_lw_idx)%natom +! write(unit,*) +! write(unit,'(" Upper crystal Miller plane: ",3(I3," "))') SAV%tf2(ifit,3,1:3) +! write(unit,'(" Upper termination")') +! write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') +! write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & +! term_up_idx,up_term%arr(term_up_idx)%hmin,up_term%arr(term_up_idx)%hmax,up_term%arr(term_up_idx)%natom +! write(unit,*) +! close(unit) + +! return +! end subroutine output_intf_data +! !!!############################################################################# end module artemis__generator diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index 3d500b0..a41d13a 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -14,7 +14,7 @@ !!! convert_n_tf1!!! endcode !!!############################################################################# module lat_compare - use artemis__constants, only: real32, pi, INF, ierror + use artemis__constants, only: real32, pi, INF use artemis__misc_types, only: latmatch_type, tol_type use misc_linalg, only: cross,uvec,modu,get_area,find_tf,det,reduce_vec_gcd,& inverse_3x3,get_vec_multiple,get_frac_denom @@ -1196,7 +1196,7 @@ subroutine lattice_matching( & if_reduce: if(reduce)then tf = find_tf(comb_trans_1(i,:,:),comb_trans_2(i,:,:)) if(abs(abs(det(comb_trans_1(i,:,:)))-1._real32).lt.1.E-6_real32) exit if_reduce - if(ierror.eq.1)then + if(verbose.ge.1)then write(0,*) i write(0,'( 3( 3(F7.3,1X), /) )') tf end if diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 6ef6f43..16ec443 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -23,6 +23,10 @@ module artemis__misc_types logical :: from_pricel_up = .false. integer, dimension(2) :: term_lw_idx = 0 integer, dimension(2) :: term_up_idx = 0 + real(real32), dimension(4) :: term_lw_bounds = 0._real32 + real(real32), dimension(4) :: term_up_bounds = 0._real32 + integer, dimension(2) :: term_lw_natom = 0 + integer, dimension(2) :: term_up_natom = 0 integer, dimension(3,3) :: transform_lw = 0 integer, dimension(3,3) :: transform_up = 0 real(real32) :: approx_thickness_lw = 0._real32 @@ -32,8 +36,7 @@ module artemis__misc_types ! real(real32), dimension(:,:) :: swaps !!! UNSURE HOW TO DO THIS real(real32) :: swap_density = 0._real32 real(real32), dimension(2) :: approx_eff_swap_conc = 0._real32 - ! contains - ! procedure, pass(this) :: init => init_struc_data_type + end type struc_data_type interface struc_data_type @@ -41,6 +44,8 @@ module function init_struc_data_type( & match_idx, & from_pricel_lw, from_pricel_up, & term_lw_idx, term_up_idx, & + term_lw_bounds, term_up_bounds, & + term_lw_natom, term_up_natom, & transform_lw, transform_up, & approx_thickness_lw, approx_thickness_up, & mismatch, & @@ -50,6 +55,8 @@ module function init_struc_data_type( & integer, intent(in) :: match_idx logical, intent(in) :: from_pricel_lw, from_pricel_up integer, dimension(2), intent(in) :: term_lw_idx, term_up_idx + real(real32), dimension(4), intent(in) :: term_lw_bounds, term_up_bounds + integer, dimension(2), intent(in) :: term_lw_natom, term_up_natom integer, dimension(3,3), intent(in) :: transform_lw, transform_up real(real32), intent(in) :: approx_thickness_lw, approx_thickness_up real(real32), dimension(3), intent(in) :: mismatch @@ -115,6 +122,8 @@ module function init_struc_data_type( & match_idx, & from_pricel_lw, from_pricel_up, & term_lw_idx, term_up_idx, & + term_lw_bounds, term_up_bounds, & + term_lw_natom, term_up_natom, & transform_lw, transform_up, & approx_thickness_lw, approx_thickness_up, & mismatch, & @@ -125,6 +134,8 @@ module function init_struc_data_type( & integer, intent(in) :: match_idx logical, intent(in) :: from_pricel_lw, from_pricel_up integer, dimension(2), intent(in) :: term_lw_idx, term_up_idx + real(real32), dimension(4), intent(in) :: term_lw_bounds, term_up_bounds + integer, dimension(2), intent(in) :: term_lw_natom, term_up_natom integer, dimension(3,3), intent(in) :: transform_lw, transform_up real(real32), intent(in) :: approx_thickness_lw, approx_thickness_up real(real32), dimension(3), intent(in) :: mismatch @@ -141,6 +152,10 @@ module function init_struc_data_type( & output%from_pricel_up = from_pricel_up output%term_lw_idx = term_lw_idx output%term_up_idx = term_up_idx + output%term_lw_bounds = term_lw_bounds + output%term_up_bounds = term_up_bounds + output%term_lw_natom = term_lw_natom + output%term_up_natom = term_up_natom output%transform_lw = transform_lw output%transform_up = transform_up output%approx_thickness_lw = approx_thickness_lw diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index 9ce3c7b..3b831cf 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -4,7 +4,7 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module shifting - use artemis__constants, only: real32, ierror, pi, INF + use artemis__constants, only: real32, pi, INF use misc_maths, only: get_nth_plane use misc_linalg, only: modu use artemis__geom_rw, only: basis_type,geom_write @@ -741,7 +741,7 @@ end function get_descriptive_ab_shifts !!! generate shifts by filling missing neighours for surface atoms !!!############################################################################# function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& - bulk_DON,bulk_map,lprint,max_bondlength) result(res_shifts) + bulk_DON,bulk_map,verbose,max_bondlength) result(res_shifts) use artemis__sym, only: gldfnd,confine_type use artemis__geom_utils, only: get_bulk,wyck_spec_type,get_wyckoff use artemis__interface_identifier, only: gen_single_DON,nstep_default,den_of_neigh_type @@ -756,11 +756,11 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& !! Number of shifts to be generated real(real32), intent(in) :: tol_sym !! Tolerance for symmetry - real(real32), optional :: c_scale + real(real32), intent(in), optional :: c_scale !! Scaling factor for the interface separation real(real32), dimension(3), optional, intent(in) :: offset !! Input offset of the two interface substructures - logical, optional :: lprint + integer, intent(in), optional :: verbose !! Boolean whether to print the shifts type(bulk_DON_type), dimension(:), optional, intent(in) :: bulk_DON !! Bulk DONs to be used for the interface @@ -772,6 +772,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& integer :: i,j,k,l,is,ia,ja,jb,jc,count1,itmp1 integer :: ntrans,iatom,nneigh,ncheck + integer :: verbose_ real(real32) :: stepsize,max_sep,dist_max real(real32) :: rtmp1,rtmp2,rtmp3 real(real32) :: val,dtmp1,dtmp2 @@ -815,6 +816,8 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& + verbose_ = 0 + if(present(verbose)) verbose_ = verbose !!!----------------------------------------------------------------------------- !!! check if bulk DONs supplied !!!----------------------------------------------------------------------------- @@ -872,7 +875,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& where(abs(min_trans).lt.1.E-5_real32) min_trans=1._real32 end where - if(ierror.eq.1) write(*,*) "repeated_trans:",min_trans + if(verbose_.eq.1) write(*,*) "repeated_trans:",min_trans !!!----------------------------------------------------------------------------- @@ -908,9 +911,9 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& dist_max = 4.0 end if allocate(DON_missing(2,bas%nspec)) - if(ierror.ge.1) write(*,*) + if(verbose_.ge.1) write(*,*) region_loop: do i=1,2 - if(ierror.ge.1) write(*,'& + if(verbose_.ge.1) write(*,'& &(2X,"is",2X,"ia",4X,"nmissing",4X,"bond size (Å)",8X,"position")') count1 = 0 @@ -993,7 +996,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& ( maxloc(DON_missing(i,is)%atom(ia,:plane_loc(1)),dim=1) & - 1 ) * dist_max/nstep_default neighbour(i,count1)%num = itmp1 - if(ierror.ge.1)& + if(verbose_.ge.1)& write(*,'(2X,I2,3X,I3,7X,I2,9X,F0.3,8X,3(1X,F5.2))') & is,ia,& neighbour(i,count1)%num,& @@ -1035,7 +1038,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& end if end do atom_loop1 end do spec_loop - if(ierror.ge.1)then + if(verbose_.ge.1)then write(*,*) "nneigh:",count1 write(*,*) end if @@ -1061,7 +1064,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& intf(2)%neigh(:)%pos(3) = intf(2)%neigh(:)%pos(3) - lowest_atom(2) lowest_atom(1) = minval(intf(1)%neigh(:)%pos(3),dim=1) highest_atom(2) = maxval(intf(2)%neigh(:)%pos(3),dim=1) - if(abs(ierror).ge.1)then + if(abs(verbose_).ge.1)then write(*,*) "lowest atom:",lowest_atom write(*,*) "highest atom:",highest_atom end if @@ -1101,7 +1104,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& nstep(3) = nstep(3) + 1 end do if(present(offset))then - if(ierror.ge.1) write(*,'(1X,"user-defined offset:",3(3X,F7.3))') offset + if(verbose_.ge.1) write(*,'(1X,"user-defined offset:",3(3X,F7.3))') offset add = -1.0 do i=1,3 if(offset(i).ge.0._real32)then @@ -1124,7 +1127,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& !!!----------------------------------------------------------------------------- !!! Determines neighbours for each grid point !!!----------------------------------------------------------------------------- - if(abs(ierror).ge.1)then + if(abs(verbose_).ge.1)then write(*,'(1X,A,3(2X,F8.4))') & "lat:",modu(bas%lat(1,:)),modu(bas%lat(2,:)),modu(bas%lat(3,:)) write(*,'(1X,A,3(2X,F8.4))') "gridsize:",gridsize @@ -1282,26 +1285,27 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& !!!----------------------------------------------------------------------------- !!! Sets output of shifts !!!----------------------------------------------------------------------------- - write(*,'("Determined shifts (gridsize:",3(2X,F6.4),")")') gridsize - write(*,'(" num fit_val x y z")') - do i=1,nstore + if(verbose_.gt.0)then + write(*,'("Determined shifts (gridsize:",3(2X,F6.4),")")') gridsize + write(*,'(" num fit_val x y z")') + end if + do i = 1, nstore, 1 res_shifts(i,:) = real(shift_store(i,:),real32)/real(ngrid(:)-1,real32) res_shifts(i,:2) = res_shifts(i,:2) + add(:2) - write(*,'(1X,I3,":",2X,F6.2,3(2X,I3))') i,fit_store(i),shift_store(i,:) + if(verbose_.gt.0) & + write(*,'(1X,I3,":",2X,F6.2,3(2X,I3))') i,fit_store(i),shift_store(i,:) end do res_shifts(:,axis) = (res_shifts(:,axis)*max_sep)/modu(bas%lat(axis,:)) + & add(axis) - if(present(c_scale)) res_shifts(:,axis) = res_shifts(:,axis)*c_scale + if(present(c_scale)) res_shifts(:,axis) = res_shifts(:,axis) * c_scale - if(present(lprint))then - if(lprint)then - write(*,'(1X,"Shifts to be applied (Å)")') - do i=1,nstore - write(*,'(I3,":",2X,3(2X,F7.4))') & - i,res_shifts(i,:2),res_shifts(i,3)*modu(bas%lat(axis,:)) - end do - end if + if(verbose_.gt.0)then + write(*,'(1X,"Shifts to be applied (Å)")') + do i = 1, nstore, 1 + write(*,'(I3,":",2X,3(2X,F7.4))') & + i,res_shifts(i,:2),res_shifts(i,3)*modu(bas%lat(axis,:)) + end do end if diff --git a/src/fortran/lib/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 index d3c5e4f..df69b80 100644 --- a/src/fortran/lib/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -4,7 +4,7 @@ !!! Think Hepplestone, think HRG. !!!############################################################################# module swapping - use artemis__constants, only: real32, ierror + use artemis__constants, only: real32 use artemis__misc, only: sort1D use misc_maths, only: gauss use misc_linalg, only: modu @@ -29,7 +29,7 @@ module swapping !!! Main function to be called from ARTEMIS !!!############################################################################# function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& - iswap,seed_arr,tol_sym,sigma,require_mirror) result(bas_arr) + iswap,seed_arr,tol_sym, verbose, sigma,require_mirror) result(bas_arr) implicit none integer :: i,j,is,iout,itmp,count1 integer :: axis,nswap @@ -58,6 +58,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& type(basis_type), allocatable, dimension(:) :: bas_arr real(real32), dimension(3,3), intent(in) :: lat real(real32), intent(in) :: tol_sym + integer, intent(in) :: verbose !!!----------------------------------------------------------------------------- @@ -122,8 +123,8 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& !!! set up symmetries !!!----------------------------------------------------------------------------- call sym_setup(grp,lat, tol_sym = tol_sym) - call tmpbas%copy(bas) - call store_bas%copy(tmpbas) + call tmpbas%copy(bas, length = 4) + call store_bas%copy(tmpbas, length = 4) !!!----------------------------------------------------------------------------- @@ -166,7 +167,7 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& &Exiting...",fmtd=.true.) end if end do - if(ierror.ge.1)then + if(verbose.ge.1)then write(*,*) "mirror found for swaps" write(*,'(4(2X,F9.4))') intf_sym(:,:) write(*,*) @@ -227,7 +228,9 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& lw_list,up_list,& lw_dist_list,up_dist_list,& lw_close_list,up_close_list,& - lw_weight_list,up_weight_list) + lw_weight_list,up_weight_list, & + verbose=verbose & + ) end select bas_arr(1) = tmpbas iout = 1 @@ -249,7 +252,9 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& lw_list,up_list,& lw_dist_list,up_dist_list,& lw_close_list,up_close_list,& - lw_weight_list,up_weight_list) + lw_weight_list,up_weight_list, & + verbose=verbose & + ) end select !call check_sym(tmpbas,itmp,tol_sym=tol_sym) !call loadbar(iout,10) @@ -578,7 +583,9 @@ subroutine rand_swap_depth(bas,swap_bas,& lw_list,up_list,& lw_dist_list,up_dist_list,& lw_close_list,up_close_list,& - lw_weight_list,up_weight_list) + lw_weight_list,up_weight_list, & + verbose & + ) implicit none integer :: i,loc1,loc2 integer :: nbelow,nabove @@ -598,6 +605,7 @@ subroutine rand_swap_depth(bas,swap_bas,& type(basis_type), intent(inout) :: swap_bas integer, intent(in) :: nswaps_per_cell type(basis_type), intent(in) :: bas + integer, intent(in) :: verbose ! make a list of natoms long, with each location pointing to a specific atomic species and number @@ -709,7 +717,7 @@ subroutine rand_swap_depth(bas,swap_bas,& swap_list(:i,2),& sigma,small_sigma) - if(ierror.ge.1) & + if(verbose.ge.1) & write(0,'(& I0,"th swap is ",I0,& &" with ",I0," at distances ",F7.3," and ",F7.3)') & From 2139c949ca384009a8e3006bca256f381208250a Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 07:12:45 +0100 Subject: [PATCH 084/137] Add python examples --- example/python_pkg/ARTEMIS_and_RAFFLE.py | 32 ++++++++++++++++++++++++ example/python_pkg/Si-Ge.py | 29 +++++++++++++++++++++ 2 files changed, 61 insertions(+) create mode 100644 example/python_pkg/ARTEMIS_and_RAFFLE.py create mode 100644 example/python_pkg/Si-Ge.py diff --git a/example/python_pkg/ARTEMIS_and_RAFFLE.py b/example/python_pkg/ARTEMIS_and_RAFFLE.py new file mode 100644 index 0000000..8d9935a --- /dev/null +++ b/example/python_pkg/ARTEMIS_and_RAFFLE.py @@ -0,0 +1,32 @@ +from time import sleep +import numpy +from ase.io import read, write +from ase.visualize import view +atoms = read("structures.traj", index=":") +from artemis.generator import artemis_generator +from raffle.generator import raffle_generator +art_gen = artemis_generator() +raff_gen = raffle_generator() +location, axis = art_gen.get_interface_location(atoms[0], return_fractional=True) +print("location", location) +print("axis", axis) +raff_gen.set_host(atoms[0]) + +missing_stoich = raff_gen.prepare_host(interface_location=location, depth=2, location_as_fractional=True)#11.97]) +print("missing_stoich", missing_stoich) +host_1 = raff_gen.get_host() +view(host_1) + +raff_gen.set_host(atoms[0]) + +host_a = raff_gen.get_host() +view(host_a) + +location, axis = art_gen.get_interface_location(atoms[0], return_fractional=False) +print("location", location) +print("axis", axis) +raff_gen.set_host(atoms[0]) +missing_stoich = raff_gen.prepare_host(interface_location=location, depth=3, location_as_fractional=False)#11.97]) +print("missing_stoich", missing_stoich) +host_2 = raff_gen.get_host() +view(host_2) diff --git a/example/python_pkg/Si-Ge.py b/example/python_pkg/Si-Ge.py new file mode 100644 index 0000000..9613519 --- /dev/null +++ b/example/python_pkg/Si-Ge.py @@ -0,0 +1,29 @@ +from ase import Atoms +from ase.build import bulk +from ase.io import write +from artemis.generator import artemis_generator + +generator = artemis_generator() + +Si = bulk('Si', 'diamond', a=5.43, cubic=True) +Ge = bulk('Ge', 'diamond', a=5.66, cubic=True) + +generator.set_materials(Si, Ge) + +generator.set_surface_properties( + miller_lw = [ 1, 1, 0 ], + miller_up = [ 1, 1, 0 ], +) + +generator.set_shift_method(num_shifts = 1) +generator.set_match_method(max_num_matches = 1) +structures = generator.generate(verbose=1)#calc=calc) + + +write('structures.traj', structures) + +output = generator.get_all_structures_data() +print(output) + +output = generator.get_structure_data(0) +print(output) \ No newline at end of file From b7092b2022f5512da24566b2ab1083fc4c8bc83e Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 07:17:14 +0100 Subject: [PATCH 085/137] Fix import issue --- docs/source/conf.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index e5989f4..317da70 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -5,8 +5,8 @@ import os import sys -# from unittest.mock import Mock -# +from unittest.mock import Mock + MOCK_MODULES = ["artemis._artemis"] # List any other modules if needed sys.modules.update((mod_name, Mock()) for mod_name in MOCK_MODULES) From 9a066323b050bcd68c8c6157e6884ed716aee02e Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 09:45:49 +0100 Subject: [PATCH 086/137] Implement edits from main --- src/fortran/lib/mod_generator.f90 | 79 ++++++------ src/fortran/lib/mod_geom_rw.f90 | 2 - src/fortran/lib/mod_geom_utils.f90 | 17 ++- src/fortran/lib/mod_help.f90 | 4 +- src/fortran/lib/mod_intf_identifier.f90 | 5 +- src/fortran/lib/mod_io_utils.F90 | 4 +- src/fortran/lib/mod_sym.f90 | 1 + src/fortran/lib/mod_terminations.f90 | 160 +++++++++++++++--------- 8 files changed, 160 insertions(+), 112 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 3032da5..3391093 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1275,8 +1275,10 @@ subroutine generate_interfaces( & character(len=256) :: err_msg !! Error message - integer :: j - !! Loop index + integer :: j, is, ia + !! Loop indices + integer :: unit + !! Unit number for file I/O integer :: ifit, intf_start, intf_end !! Interface loop indices integer :: iterm_lw, term_lw_start_idx, term_lw_end_idx, term_lw_step @@ -1528,31 +1530,35 @@ subroutine generate_interfaces( & bulk_DON(1)%spec=gen_DON(structure_lw%lat,structure_lw,& dist_max=this%bondlength_cutoff,& scale_dist=.false.,& - norm=.true.) - do is = 1, inlw_bas%nspec + norm=.true. & + ) + do is = 1, structure_lw%nspec if(all(abs(bulk_DON(1)%spec(is)%atom(:,:)).lt.1._real32))then bondlength = huge(0._real32) - do ia = 1, inlw_bas%spec(is)%num - dtmp1 = modu(get_min_bond(inlw_lat, inlw_bas, is, ia)) - if(dtmp1.lt.bondlength) bondlength = dtmp1 - if(dtmp1.gt.this%bondlength_cutoff)then + do ia = 1, structure_lw%spec(is)%num + rtmp1 = modu(get_min_bond(structure_lw, is, ia)) + if(rtmp1.lt.bondlength) bondlength = rtmp1 + if(rtmp1.gt.this%bondlength_cutoff)then write(filename,'("lw_DON_",I0,"_",I0,".dat")') is,ia - open(unit=13,file=filename) + open(newunit=unit, file=filename) do j=1,1000 - write(13,*) & + write(unit,*) & (j-1)*this%bondlength_cutoff/1000,& bulk_DON(1)%spec(is)%atom(ia,j) end do - close(13) + close(unit) end if end do if(bondlength.gt.this%bondlength_cutoff)then - write(0,*) "Min bondlength for lower species ", & - is, " is ", bondlength - write(0,*) "To account for this, increase MBOND_MAXLEN to at & - &least ",bondlength + write(err_msg,'(A,I0,A,F0.3,A,F0.3)') & + "Minimum bondlength for species ", & + is, " in lower structure is ", bondlength, achar(10) // & + "To account for this, increase bondlength cutoff from ", & + this%bondlength_cutoff + call stop_program(trim(err_msg)) end if - call err_abort("ISSUE WITH THE LOWER BULK DON!!!") + exit_code_ = 1 + return end if end do up_map=0 @@ -1560,30 +1566,33 @@ subroutine generate_interfaces( & dist_max=this%bondlength_cutoff,& scale_dist=.false.,& norm=.true.) - do is = 1, inup_bas%nspec + do is = 1, structure_up%nspec if(all(abs(bulk_DON(2)%spec(is)%atom(:,:)).lt.1._real32))then bondlength = huge(0._real32) - do ia = 1, inup_bas%spec(is)%num - dtmp1 = modu(get_min_bond(inup_lat, inup_bas, is, ia)) - if(dtmp1.lt.bondlength) bondlength = dtmp1 - if(dtmp1.gt.this%bondlength_cutoff)then + do ia = 1, structure_up%spec(is)%num + rtmp1 = modu(get_min_bond(structure_up, is, ia)) + if(rtmp1.lt.bondlength) bondlength = rtmp1 + if(rtmp1.gt.this%bondlength_cutoff)then write(filename,'("up_DON_",I0,"_",I0,".dat")') is,ia - open(unit=13,file=filename) + open(newunit=unit, file=filename) do j=1,1000 - write(13,*) & + write(unit,*) & (j-1)*this%bondlength_cutoff/1000,& bulk_DON(2)%spec(is)%atom(ia,j) end do - close(13) + close(unit) end if end do if(bondlength.gt.this%bondlength_cutoff)then - write(0,*) "Min bondlength for upper species ", & - is, " is ", bondlength - write(0,*) "To account for this, increase MBOND_MAXLEN to at & - &least ",bondlength + write(err_msg,'(A,I0,A,F0.3,A,F0.3)') & + "Minimum bondlength for species ", & + is, " in upper structure is ", bondlength, achar(10) // & + "To account for this, increase bondlength cutoff from ", & + this%bondlength_cutoff + call stop_program(trim(err_msg)) end if - call err_abort("ISSUE WITH THE UPPER BULK DON!!!") + exit_code_ = 1 + return end if end do else @@ -1645,13 +1654,11 @@ subroutine generate_interfaces( & !--------------------------------------------------------------------------- num_structures_old = -1 if(this%match_method.ne.0.and.(any(miller_lw.ne.0).or.any(miller_up.ne.0)))then - call err_abort( '& - &Cannot use LW_MILLER or UP_MILLER with IMATCH>0\n& - Exiting...', & - fmtd=.true. & - ) + call stop_program('Cannot use LW_MILLER or UP_MILLER with IMATCH>0') + exit_code_ = 1 + return elseif(this%match_method.ne.0)then - write(msg,'("& + write(err_msg,'("& &IMATCH /= 0 methods are experimental and may\n& ¬ work as expected.\n& &They are not intended to be thorough searches.\n& @@ -1659,7 +1666,7 @@ subroutine generate_interfaces( & &are clear on its intended use and\n& &limitations.& &")') - call print_warning(trim(msg)) + call print_warning(trim(err_msg)) tfmat = planecutter(structure_lw%lat,real(miller_lw,real32)) call transformer(structure_lw,tfmat,lw_map) end if diff --git a/src/fortran/lib/mod_geom_rw.f90 b/src/fortran/lib/mod_geom_rw.f90 index 89b148c..eb315b5 100644 --- a/src/fortran/lib/mod_geom_rw.f90 +++ b/src/fortran/lib/mod_geom_rw.f90 @@ -1602,8 +1602,6 @@ subroutine remove_atoms(this, atoms) !! The number of species. integer, dimension(:,:), allocatable :: atoms_ordered !! The atoms to remove ordered by species and atom - real(real32), dimension(:,:), allocatable :: atom - !! Temporary array to store the atomic positions. !--------------------------------------------------------------------------- diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index f62f5fd..033b2a1 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -281,7 +281,7 @@ end function get_min_bulk_bond !!!############################################################################# !!! returns minimum bond for a specified atom !!!############################################################################# - function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) + function get_min_bond(basis,is,ia,axis,labove,tol) result(vsave) implicit none integer :: js,ja integer :: iaxis @@ -290,8 +290,7 @@ function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) real(real32), dimension(3) :: vdtmp1, vsave integer, intent(in) :: is,ia - type(basis_type), intent(in) :: bas - real(real32), dimension(3,3), intent(in) :: lat + type(basis_type), intent(in) :: basis integer, intent(in), optional :: axis real(real32), intent(in), optional :: tol @@ -317,10 +316,10 @@ function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) min_bond=huge(0._real32) - do js=1,bas%nspec - atmloop: do ja=1,bas%spec(js)%num + do js=1,basis%nspec + atmloop: do ja=1,basis%spec(js)%num if(is.eq.js.and.ia.eq.ja) cycle atmloop - vdtmp1 = bas%spec(js)%atom(ja,:3) - bas%spec(is)%atom(ia,:3) + vdtmp1 = basis%spec(js)%atom(ja,:3) - basis%spec(is)%atom(ia,:3) if(iaxis.gt.0)then if(abs(vdtmp1(iaxis)).lt.dtol) cycle atmloop if(ludef_above)then @@ -330,9 +329,9 @@ function get_min_bond(lat,bas,is,ia,axis,labove,tol) result(vsave) end if end if vdtmp1 = & - vdtmp1(1)*lat(1,:3) + & - vdtmp1(2)*lat(2,:3) + & - vdtmp1(3)*lat(3,:3) + vdtmp1(1)*basis%lat(1,:3) + & + vdtmp1(2)*basis%lat(2,:3) + & + vdtmp1(3)*basis%lat(3,:3) dtmp1 = modu(vdtmp1) if(dtmp1.lt.min_bond)then min_bond = dtmp1 diff --git a/src/fortran/lib/mod_help.f90 b/src/fortran/lib/mod_help.f90 index 01d4f41..0d40e18 100644 --- a/src/fortran/lib/mod_help.f90 +++ b/src/fortran/lib/mod_help.f90 @@ -515,7 +515,7 @@ function setup_interface_tags() result(tag) tag(ilw_miller_tag)%allowed = 'Three integer numbers' tag(ilw_miller_tag)%default = '(empty)' tag(ilw_miller_tag)%description = & - 'Confines the lower crystal to this Miller plane for lattice matching.\n\n& + &'Confines the lower crystal to this Miller plane for lattice matching.\n\n& &NOTE: Can only be used with IMATCH=0.\n\n& &NOTE: Miller indices used in ARTEMIS are defined for the cell in & &use. Experimental Miller indices are presented with respect to the & @@ -527,7 +527,7 @@ function setup_interface_tags() result(tag) tag(iup_miller_tag)%allowed = 'Three integer numbers' tag(iup_miller_tag)%default = '(empty)' tag(iup_miller_tag)%description = & - 'Confines the upper crystal to this Miller plane for lattice matching.\n\n& + &'Confines the upper crystal to this Miller plane for lattice matching.\n\n& &NOTE: Can only be used with IMATCH=0.\n\n& &NOTE: Miller indices used in ARTEMIS are defined for the cell in & &use. Experimental Miller indices are presented with respect to the & diff --git a/src/fortran/lib/mod_intf_identifier.f90 b/src/fortran/lib/mod_intf_identifier.f90 index b073f0b..45d995b 100644 --- a/src/fortran/lib/mod_intf_identifier.f90 +++ b/src/fortran/lib/mod_intf_identifier.f90 @@ -309,14 +309,15 @@ function gen_DONsim(DON,dist_max,cutoff,avg_mthd) result(intf_atoms) implicit none type(den_of_neigh_type), dimension(:), intent(in) :: DON + real(real32), optional, intent(in) :: dist_max,cutoff + integer, optional, intent(in) :: avg_mthd + integer :: i,is,ia,ja,cutloc,itmp1,udef_avg_mthd integer :: nspec,natom,nstep real(real32) :: avg,rdist_max,rcutoff,maxjump - real(real32), optional, intent(in) :: dist_max,cutoff integer, allocatable, dimension(:) :: intf_list,sumspec real(real32), allocatable, dimension(:) :: newf,simi,distance integer, allocatable, dimension(:,:) :: intf_atoms - integer, optional, intent(in) :: avg_mthd type(den_of_neigh_type), allocatable, dimension(:) :: sim type(den_of_spec_type), allocatable, dimension(:) :: similarity diff --git a/src/fortran/lib/mod_io_utils.F90 b/src/fortran/lib/mod_io_utils.F90 index bc341ba..7371312 100644 --- a/src/fortran/lib/mod_io_utils.F90 +++ b/src/fortran/lib/mod_io_utils.F90 @@ -42,10 +42,10 @@ module artemis__io_utils type, public :: tag_type character(25) :: name character(1) :: type - character(40) :: summary + character(50) :: summary character(60) :: allowed character(60) :: default - character(300) :: description + character(1024) :: description logical :: is_deprecated = .false. logical :: to_be_deprecated = .false. character(25) :: deprecated_name = '' diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 3b0b7c8..1582592 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -203,6 +203,7 @@ subroutine check_sym( & if(allocated(grp%op)) deallocate(grp%op) allocate(grp%op(grp%nsym*minval(basis%spec(:)%num))) grp%op = 0 + if(present(lsave))then lsave_ = lsave else diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 92fe5e7..86351b7 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -69,7 +69,7 @@ function get_termination_info( & integer, intent(inout) :: exit_code ! Local variables - integer :: i, j, is, nterm, mterm, dim, ireject + integer :: i, j, k, is, nterm, mterm, dim, ireject !! Loop indices and dimensions integer :: itmp1, itmp2, init, min_loc !! Temporary indices @@ -79,7 +79,7 @@ function get_termination_info( & !! Temporary variables real(real32) :: layer_sep_ !! Minimum separation between layers - type(sym_type) :: grp1, grp_store + type(sym_type) :: grp1, grp_store, grp_store_inv !! Symmetry group structure type(term_arr_type) :: term !! Termination information @@ -103,6 +103,8 @@ function get_termination_info( & !! Temporary symmetry matrix character(len=256) :: err_msg !! Error message + integer, dimension(:), allocatable :: comparison_list + !! List of terminations to compare against abc = [ 1, 2, 3 ] @@ -318,28 +320,34 @@ function get_termination_info( & !--------------------------------------------------------------------------- ! Set up mirror/inversion symmetries of the matrix !--------------------------------------------------------------------------- + grp_store_inv%confine%axis = axis + grp_store_inv%confine%laxis = .false. + grp_store_inv%lspace = .true. + grp_store_inv%confine%l = .true. + grp_store_inv%confine%laxis(axis) = .true. call sym_setup( & - grp_store, & + grp_store_inv, & basis%lat, & predefined=.false., new_start=.true., & tol_sym=tol_sym & ) - allocate(tmpsym(4,4,count(abs(grp_store%sym(3,3,:)+1._real32).lt.tolerance))) - allocate(tmpop(count(abs(grp_store%sym(3,3,:)+1._real32).lt.tolerance))) + itmp1 = count(abs(grp_store_inv%sym(3,3,:)+1._real32).lt.tol_sym) + allocate(tmpsym(4,4,itmp1)) + allocate(tmpop(itmp1)) itmp1 = 0 - do i=1,grp_store%nsym - if(abs(grp_store%sym(3,3,i)+1._real32).lt.tolerance)then + do i = 1, grp_store_inv%nsym + if(abs(grp_store_inv%sym(3,3,i)+1._real32).lt.tol_sym)then itmp1=itmp1+1 - tmpsym(:,:,itmp1) = grp_store%sym(:,:,i) + tmpsym(:,:,itmp1) = grp_store_inv%sym(:,:,i) tmpop(itmp1) = i end if end do - grp_store%nsym = itmp1 - grp_store%nlatsym = itmp1 - call move_alloc(tmpsym,grp_store%sym) - allocate(grp_store%op(itmp1)) - grp_store%op(:) = tmpop(:itmp1) - grp_store%end_idx = grp_store%nsym + grp_store_inv%nsym = itmp1 + grp_store_inv%nlatsym = itmp1 + call move_alloc(tmpsym,grp_store_inv%sym) + allocate(grp_store_inv%op(itmp1)) + grp_store_inv%op(:) = tmpop(:itmp1) + grp_store_inv%end_idx = grp_store_inv%nsym !--------------------------------------------------------------------------- @@ -358,54 +366,86 @@ function get_termination_info( & itmp1=reject_match(i,1) itmp2=reject_match(i,2) ! Check if comparison termination has already been compared successfully - prior_check: if(any(success(1:i-1).eq.itmp2))then - lunique=.false. - else - call clone_grp(grp_store,grp1) - call check_sym(grp1,basis_arr(itmp2),& - iperm=-1,lsave=.true.,check_all_sym=.true.,tol_sym=tol_sym) - ltmp1=.false. - - ! Check if pure translations are present in comparison termination? - !! if(all(abs(grp1%sym_save(:3,:3,j)-ident).le.tolerance))then - !! write(0,*) "FOUND TRANSLATION" - !! cycle reject_loop1 - !! end if - !! end do - ! Check if inversions are present in comparison termination - do j=1,grp1%nsymop - if(abs(det(grp1%sym_save(:3,:3,j))+1._real32).le.tolerance) ltmp1=.true. - end do - ! If they are not, then no point comparing. It is a new termination - if(.not.ltmp1) exit prior_check - - call clone_grp(grp_store,grp1) - call check_sym(grp1,basis_arr(itmp2),& - tmpbas2=basis_arr_reject(i),iperm=-1,lsave=.true.,& - check_all_sym=.true., tol_sym=tol_sym) - - ! Check det of all symmetry operations. If any are 1, move on - ! This is because they are just rotations as can be captured ... - ! ... through lattice matches. - ! Solely inversions are unique and must be captured. - do j=1,grp1%nsymop - if(abs(det(grp1%sym_save(:3,:3,j))-1._real32).le.tolerance) lunique=.false. + comparison_list = [ itmp2 ] + !! check against all previous reject-turned-unique terminations + prior_check: if(any(success(1:i-1:1).eq.itmp2))then + do j = 1, i-1, 1 + if(success(j).eq.itmp2)then + grp_store%end_idx = grp_store%nsym + call clone_grp(grp_store,grp1) + call check_sym(grp1,basis=basis_arr_reject(j),& + iperm=-1,tmpbas2=basis_arr_reject(i),lsave=.true., & + tol_sym=tol_sym & + ) + if(grp1%nsymop.ne.0)then + if(abs(grp1%sym_save(axis,axis,1)+1._real32).gt.tol_sym)then + lunique = .false. + itmp2 = reject_match(j,2) + exit prior_check + end if + end if + comparison_list = [ comparison_list, reject_match(j,2) ] + end if end do - if(grp1%sym_save(4,axis,1).eq.& - 2._real32*min(term_arr_uniq(itmp2)%hmin,0.5_real32-term_arr_uniq(itmp2)%hmin))then - lunique=.false. - end if - - if(.not.(all(grp1%sym_save(axis,:3,1).eq.vec_compare(:)).and.& - all(grp1%sym_save(:3,axis,1).eq.vec_compare(:)))) lunique=.false. - end if prior_check + unique_condition1: if(lunique)then + grp_store_inv%end_idx = grp_store_inv%nsym + lunique = .true. + do k = 1, size(comparison_list) + itmp2 = comparison_list(k) + call clone_grp(grp_store_inv,grp1) + call check_sym(grp1,basis_arr(itmp2),& + iperm=-1,lsave=.true.,check_all_sym=.true., & + tol_sym=tol_sym & + ) + + !! Check if inversions are present in comparison termination + ltmp1=.false. + do j = 1, grp1%nsymop, 1 + if(abs(det(grp1%sym_save(:3,:3,j))+1._real32).le.tol_sym) ltmp1=.true. + end do + !! If they are not, then no point comparing. It is a new termination + if(.not.ltmp1) cycle + + call clone_grp(grp_store_inv,grp1) + call check_sym(grp1,basis_arr(itmp2),& + tmpbas2=basis_arr_reject(i), & + iperm=-1, & + lsave=.true., & + check_all_sym=.true., & + tol_sym=tol_sym & + ) + + !! Check det of all symmetry operations. If any are 1, move on + !! This is because they are just rotations as can be captured ... + !! ... through lattice matches. + !! Solely inversions are unique and must be captured. + do j = 1, grp1%nsymop, 1 + if(abs(det(grp1%sym_save(:3,:3,j))-1._real32).le.tol_sym) lunique=.false. + end do + if(grp1%sym_save(4,axis,1).eq.& + 2._real32 * min( & + term_arr_uniq(itmp2)%hmin, & + 0.5_real32 - term_arr_uniq(itmp2)%hmin & + ) & + ) lunique=.false. + + if(.not.( & + all(abs(grp1%sym_save(axis,:3,1) - vec_compare(:)).lt.tol_sym).and.& + all(abs(grp1%sym_save(:3,axis,1) - vec_compare(:)).lt.tol_sym) & + ) ) lunique=.false. + + if(lunique) exit unique_condition1 + end do + end if unique_condition1 + if(lunique)then - mterm=mterm+1 - success(i)=itmp2 - term_arr_uniq(mterm)=term_arr(reject_match(i,1)) - reject_match(i,2)=0 + mterm = mterm + 1 + success(i) = itmp2 + basis_arr(mterm) = basis_arr_reject(i) + term_arr_uniq(mterm) = term_arr(itmp1) + reject_match(i,2) = mterm term_arr_uniq(mterm)%nstep = 1 allocate(term_arr_uniq(mterm)%ladder(ireject+1)) term_arr_uniq(mterm)%ladder(1) = 0._real32 @@ -435,7 +475,8 @@ function get_termination_info( & term%arr(i)%hmax = term_arr_uniq(itmp1)%hmax term%arr(i)%natom = term_arr_uniq(itmp1)%natom term%arr(i)%nstep = term_arr_uniq(itmp1)%nstep - term%arr(i)%ladder(:term%arr(i)%nstep) = term_arr_uniq(i)%ladder(:term%arr(i)%nstep) + term%arr(i)%ladder(:term%arr(i)%nstep) = & + term_arr_uniq(i)%ladder(:term%arr(i)%nstep) if(verbose.gt.0) write(*,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & i,term%arr(i)%hmin,term%arr(i)%hmax,term%arr(i)%natom itmp1 = minloc(term_arr_uniq(:)%hmin,& @@ -1020,6 +1061,7 @@ subroutine build_slab( & !--------------------------------------------------------------------------- ! Apply slab_cuber to orthogonalise lower material !--------------------------------------------------------------------------- + call basis%normalise(ceil_val=0.9999_real32,floor_coords=.true.,zero_round=0._real32) call set_vacuum(basis,term%axis,1._real32-term%tol/tfmat(term%axis,term%axis),vacuum) abc=cshift(abc,3-term%axis) if(orthogonalise_)then From e57cbe942ad5e96808bd45ee7512163c0ba264b4 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 09:46:21 +0100 Subject: [PATCH 087/137] Add tag --- app/inputs.f90 | 4 +++- src/fortran/lib/mod_help.f90 | 12 +++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/app/inputs.f90 b/app/inputs.f90 index bb611e7..e449f2b 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -587,7 +587,7 @@ subroutine read_card_cell_edits(unit,count,skip) character(1024) :: buffer,tagname,store integer, intent(in) :: unit integer, intent(inout) :: count - integer, dimension(13) :: readvar + integer, dimension(14) :: readvar logical, optional, intent(in) :: skip character(len=6), dimension(4) :: & tag_list = ["axis ","loc ","val ","bounds"] @@ -678,6 +678,8 @@ subroutine read_card_cell_edits(unit,count,skip) call assign(buffer,lnorm_lat, readvar(12)) case("MIN_THICKNESS") call assign(buffer,lw_thickness, readvar(13)) + case("USE_PRICEL") + call assign(buffer,lw_use_pricel, readvar(14)) case default write(*,'("NOTE: unable to assign variable on line ",I0)') count end select diff --git a/src/fortran/lib/mod_help.f90 b/src/fortran/lib/mod_help.f90 index 0d40e18..4cb9192 100644 --- a/src/fortran/lib/mod_help.f90 +++ b/src/fortran/lib/mod_help.f90 @@ -29,7 +29,7 @@ module mod_help ! Cell_edits number of tags - integer, parameter :: ntags_cell_edits=13 + integer, parameter :: ntags_cell_edits=14 ! Cell_edits tags integer, parameter :: iout_file_tag=1 integer, parameter :: ilsurf_gen_CE_tag=2 @@ -44,6 +44,7 @@ module mod_help integer, parameter :: isurf_tag=11 integer, parameter :: ilnorm_lat_tag=12 integer, parameter :: imin_thick_tag=13 + integer, parameter :: iuse_pricel_tag=14 integer, parameter :: ntags_depr_cell_edits=1 ! Cell_edits deprecated tags @@ -334,6 +335,15 @@ function setup_cell_edits_tags() result(tag) &The generated slab will be the smallest possible thickness equal to & &or greater than this value.' + tag(iuse_pricel_tag)%name = 'USE_PRICEL' + tag(iuse_pricel_tag)%type = 'L' + tag(iuse_pricel_tag)%summary = 'Use primitive cell' + tag(iuse_pricel_tag)%allowed = 'TRUE or FALSE' + tag(iuse_pricel_tag)%default = 'TRUE' + tag(iuse_pricel_tag)%description = & + 'Defines whether to generate and use the primitive unit cell & + &for the crystal' + tag(imiller_tag)%name = 'MILLER_PLANE' tag(imiller_tag)%type = 'U' tag(imiller_tag)%summary = 'Crystal Miller plane' From f3d1dbed34aaf2b58b494b35b48573d61744265d Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 09:46:59 +0100 Subject: [PATCH 088/137] Tidy up --- src/fortran/lib/mod_generator.f90 | 186 +++++++-------------------- src/fortran/lib/mod_geom_rw.f90 | 6 +- src/fortran/lib/mod_terminations.f90 | 47 ++++--- 3 files changed, 78 insertions(+), 161 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 3391093..ccce843 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -6,22 +6,24 @@ !!!############################################################################# module artemis__generator use artemis__constants, only: real32, pi - use artemis__misc, only: to_lower,to_upper - use artemis__misc_types, only: abstract_artemis_generator_type, latmatch_type, tol_type, struc_data_type - use artemis__geom_rw, only: basis_type,geom_write + use artemis__misc, only: to_lower, to_upper + use artemis__misc_types, only: abstract_artemis_generator_type, & + latmatch_type, tol_type, struc_data_type + use artemis__geom_rw, only: basis_type use lat_compare, only: lattice_matching, cyc_lat1 use artemis__io_utils, only: err_abort, print_warning, stop_program use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: uvec,modu,get_area,inverse,cross use artemis__interface_identifier, only: intf_info_type,& get_interface,get_layered_axis,gen_DON - use artemis__geom_utils, only: planecutter,primitive_lat,ortho_axis,& - shift_region,set_vacuum,transformer,shifter,reducer,& - get_min_bulk_bond,get_min_bond,get_shortest_bond,bond_type,& + use artemis__geom_utils, only: planecutter, primitive_lat, ortho_axis,& + shift_region, set_vacuum, transformer, shifter, reducer, & + get_min_bulk_bond, get_min_bond, get_shortest_bond, bond_type, & share_strain, MATNORM, basis_stack, compare_stoichiometry - use artemis__sym, only: confine_type,gldfnd,& + use artemis__sym, only: confine_type, gldfnd,& get_primitive_cell - use artemis__terminations, only: get_termination_info, term_arr_type, set_slab_height, set_layer_tol, build_slab + use artemis__terminations, only: get_termination_info, term_arr_type, & + set_layer_tol, build_slab_supercell, cut_slab_to_height use swapping, only: rand_swapper use shifting !!! CHANGE TO SHIFTER? implicit none @@ -571,12 +573,13 @@ subroutine set_materials( & !! Use primitive cell for lower bulk structure logical, intent(in), optional :: use_pricel_up - ! Local variables - character(len=256) :: err_msg - - if(present(structure_lw)) call this%structure_lw%copy(structure_lw, length=4) - if(present(structure_up)) call this%structure_up%copy(structure_up, length=4) + if(present(structure_lw))then + if(structure_lw%natom.gt.0) call this%structure_lw%copy(structure_lw, length=4) + end if + if(present(structure_up))then + if(structure_up%natom.gt.0) call this%structure_up%copy(structure_up, length=4) + end if !--------------------------------------------------------------------------- ! Handle the elastic constants @@ -986,7 +989,7 @@ function get_terminations( & call set_layer_tol(term) ! determine required extension and perform that - call set_slab_height(structure, bas_map, term, surface_,& + call build_slab_supercell(structure, bas_map, term, surface_,& height, num_layers_, thickness_, num_cells,& term_start, term_end, term_step & ) @@ -1011,7 +1014,7 @@ function get_terminations( & call output(i)%copy(structure, length=4) if(allocated(t1bas_map)) deallocate(t1bas_map) allocate(t1bas_map,source=bas_map) - call build_slab(output(i),bas_map,term,[iterm,surface_(2)],& + call cut_slab_to_height(output(i),bas_map,term,[iterm,surface_(2)],& thickness_, num_cells, num_layers_, height,& prefix, lcycle, orthogonalise_, this%vacuum_gap & ) @@ -1091,9 +1094,9 @@ subroutine generate_interfaces_from_existing( & !! Exit code for the program ! Local variables - integer :: is,ia,js,ja + integer :: is, ia, js, ja !! Loop variables - real(real32) :: dtmp1,min_bond,min_bond1,min_bond2 + real(real32) :: rtmp1,min_bond,min_bond1,min_bond2 !! Minimum bond length type(intf_info_type) :: intf !! Interface information @@ -1115,8 +1118,6 @@ subroutine generate_interfaces_from_existing( & !! Verbosity level integer :: exit_code_ !! Exit code for the program - character(len=256) :: err_msg - !! Error message !--------------------------------------------------------------------------- @@ -1171,8 +1172,8 @@ subroutine generate_interfaces_from_existing( & structure%spec(js)%atom(ja,intf%axis).lt.intf%loc(2) ) )then vtmp1 = (structure%spec(is)%atom(ia,:3)-structure%spec(js)%atom(ja,:3)) vtmp1 = matmul(vtmp1,structure%lat) - dtmp1 = modu(vtmp1) - if(dtmp1.lt.min_bond1) min_bond1 = dtmp1 + rtmp1 = modu(vtmp1) + if(rtmp1.lt.min_bond1) min_bond1 = rtmp1 elseif( & ( structure%spec(is)%atom(ia,intf%axis).lt.intf%loc(1).or.& structure%spec(is)%atom(ia,intf%axis).gt.intf%loc(2) ).and.& @@ -1180,8 +1181,8 @@ subroutine generate_interfaces_from_existing( & structure%spec(js)%atom(ja,intf%axis).gt.intf%loc(2) ) )then vtmp1 = (structure%spec(is)%atom(ia,:3)-structure%spec(js)%atom(ja,:3)) vtmp1 = matmul(vtmp1,structure%lat) - dtmp1 = modu(vtmp1) - if(dtmp1.lt.min_bond2) min_bond2 = dtmp1 + rtmp1 = modu(vtmp1) + if(rtmp1.lt.min_bond2) min_bond2 = rtmp1 end if end do atomloop2 @@ -1324,6 +1325,10 @@ subroutine generate_interfaces( & type(struc_data_type) :: struc_data !! Structure data (i.e. mismatch, terminations, etc) + character(len=256) :: filename + !! Filename for error output data + real(real32) :: rtmp1, bondlength + !! Temporary variables integer :: ntrans, iunique, itmp1, num_structures_old integer :: layered_axis_lw, layered_axis_up @@ -1815,7 +1820,7 @@ subroutine generate_interfaces( & if(any(surface_lw_.gt.lw_term%nterm))then write(err_msg, '("surface_lw_ACE VALUES INVALID!\nOne or more value & &exceeds the maximum number of terminations in the & - structure.\n& + &structure.\n& & Supplied values: ",I0,1X,I0,"\n& & Maximum allowed: ",I0)') surface_lw_, lw_term%nterm call err_abort(trim(err_msg),fmtd=.true.) @@ -1839,7 +1844,7 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------------- !! Defines height of lower slab from user-defined values !!----------------------------------------------------------------------- - call set_slab_height(supercell_lw,t1lw_map,lw_term,surface_lw_,& + call build_slab_supercell(supercell_lw,t1lw_map,lw_term,surface_lw_,& height_lw,num_layers_lw_, thickness_lw_,num_cells_lw,& term_lw_start_idx,term_lw_end_idx,term_lw_step & ) @@ -1908,7 +1913,7 @@ subroutine generate_interfaces( & if(any(surface_up_.gt.up_term%nterm))then write(err_msg, '("surface_up_ACE VALUES INVALID!\nOne or more value & &exceeds the maximum number of terminations in the & - structure.\n& + &structure.\n& & Supplied values: ",I0,1X,I0,"\n& & Maximum allowed: ",I0)') surface_up_, up_term%nterm call err_abort(trim(err_msg),fmtd=.true.) @@ -1932,7 +1937,7 @@ subroutine generate_interfaces( & !!----------------------------------------------------------------------- !! Defines height of upper slab from user-defined values !!----------------------------------------------------------------------- - call set_slab_height(supercell_up,t1up_map,up_term,surface_up_,& + call build_slab_supercell(supercell_up,t1up_map,up_term,surface_up_,& height_up,num_layers_up_, thickness_up_, num_cells_up,& term_up_start_idx,term_up_end_idx,term_up_step & ) @@ -1956,7 +1961,7 @@ subroutine generate_interfaces( & !!-------------------------------------------------------------------- !! Shifts lower material to specified termination !!-------------------------------------------------------------------- - call build_slab(slab_lw,t2lw_map,lw_term,[iterm_lw,surface_lw_(2)],& + call cut_slab_to_height(slab_lw,t2lw_map,lw_term,[iterm_lw,surface_lw_(2)],& thickness_lw_, num_cells_lw, num_layers_lw_, height_lw,& "lw",lcycle, & vacuum = this%vacuum_gap & @@ -1971,7 +1976,7 @@ subroutine generate_interfaces( & call slab_up%copy(supercell_up) if(allocated(t2up_map)) deallocate(t2up_map) allocate(t2up_map,source=t1up_map) - call build_slab(slab_up,t2up_map,up_term,[iterm_up,surface_up_(2)],& + call cut_slab_to_height(slab_up,t2up_map,up_term,[iterm_up,surface_up_(2)],& thickness_up_, num_cells_up, num_layers_up_, height_up,& "up",lcycle, & vacuum = this%vacuum_gap & @@ -2166,10 +2171,9 @@ subroutine generate_shifts_and_swaps( & integer, intent(inout) :: exit_code integer, dimension(:,:,:), optional, intent(in) :: map - integer :: shift_unit - integer :: ounit,iaxis,k,l + integer :: iaxis,k,l integer :: ngen_swaps,nswaps_per_cell - real(real32) :: dtmp1 + real(real32) :: rtmp1 type(basis_type) :: tbas type(bond_type) :: min_bond type(struc_data_type) :: struc_data_shift @@ -2177,7 +2181,7 @@ subroutine generate_shifts_and_swaps( & character(len=256) :: err_msg integer, dimension(3) :: abc real(real32), dimension(3) :: toffset - type(basis_type), allocatable, dimension(:) :: bas_arr + type(basis_type), allocatable, dimension(:) :: basis_arr real(real32), allocatable, dimension(:,:) :: output_shifts @@ -2189,20 +2193,6 @@ subroutine generate_shifts_and_swaps( & abc = cshift(abc,this%axis) -!!!----------------------------------------------------------------------------- -!!! Sets up and moves to appropriate directories -!!!----------------------------------------------------------------------------- - ! call getcwd(pwd1) - ! if(this%shift_method.gt.0.or.this%num_shifts.gt.1)then - ! call system('mkdir -p '//trim(adjustl(shiftdir))) - ! call chdir(shiftdir) - ! end if - ! call getcwd(pwd2) - ! open(newunit=shift_unit,file="shift_vals.txt") - ! write(shift_unit,& - ! '("# interface_num shift (a,b,c) units=(direct,direct,Å)")') - - !!!----------------------------------------------------------------------------- !!! Generates sets of shifts based on shift version !!!----------------------------------------------------------------------------- @@ -2211,7 +2201,7 @@ subroutine generate_shifts_and_swaps( & case(1) output_shifts(1,:3)=0._real32 do k=2,this%num_shifts - do iaxis=1,2 + do iaxis = 1, 2 call random_number(output_shifts(k,iaxis)) end do end do @@ -2302,15 +2292,15 @@ subroutine generate_shifts_and_swaps( & intf_loc(1),intf_loc(2),& shift_axis=iaxis,shift=toffset(iaxis),renorm=.true.) end do - dtmp1=modu(tbas%lat(this%axis,:)) + rtmp1=modu(tbas%lat(this%axis,:)) call set_vacuum(& basis=tbas,& axis=this%axis,loc=maxval(intf_loc(:)),& vac=toffset(this%axis)) - dtmp1=minval(intf_loc(:))*dtmp1/modu(tbas%lat(this%axis,:)) + rtmp1=minval(intf_loc(:))*rtmp1/modu(tbas%lat(this%axis,:)) call set_vacuum(& basis=tbas,& - axis=this%axis,loc=dtmp1,& + axis=this%axis,loc=rtmp1,& vac=toffset(this%axis)) min_bond = get_shortest_bond(tbas) if(min_bond%length.le.1.5_real32)then @@ -2322,29 +2312,10 @@ subroutine generate_shifts_and_swaps( & end if - !!----------------------------------------------------------------------- - !! prints shift vector to shift_vals.txt - !!----------------------------------------------------------------------- - ! write(shift_unit,'(2X,I0.2,15X,"(",2(" ",F9.6,", ")," ",F9.6," )")') & - ! k,toffset(:) - - !!----------------------------------------------------------------------- !! Merges lower and upper materials !! Writes interfaces to output directories !!----------------------------------------------------------------------- - ! ounit=100+intf - ! if(this%shift_method.gt.0.or.this%num_shifts.gt.1)then - ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),k - ! call system('mkdir -p '//trim(adjustl(dirpath))) - ! write(filename,'(A,"/",A)') trim(adjustl(dirpath)),trim(out_filename) - ! else - ! filename = trim(out_filename) - ! end if - ! write(*,'(2X,"Writing interface ",I0,"...")') intf - ! open(unit=ounit,file=trim(adjustl(filename))) - ! call geom_write(ounit,tbas) - ! close(ounit) struc_data_shift = struc_data struc_data_shift%shift_idx = k struc_data_shift%shift = toffset @@ -2358,7 +2329,7 @@ subroutine generate_shifts_and_swaps( & !! Performs swaps within the shifted structures if requested !!----------------------------------------------------------------------- if_swap: if(this%swap_method.ne.0)then - bas_arr = rand_swapper(tbas%lat,tbas,this%axis,this%swap_depth,& + basis_arr = rand_swapper(tbas%lat,tbas,this%axis,this%swap_depth,& nswaps_per_cell,this%num_swaps,intf_loc,this%swap_method,& seed_arr, & tol_sym = this%tol_sym, & @@ -2368,7 +2339,7 @@ subroutine generate_shifts_and_swaps( & ) ngen_swaps = this%num_swaps LOOPswaps: do l=1,this%num_swaps - if (bas_arr(l)%nspec.eq.0) then + if (basis_arr(l)%nspec.eq.0) then ngen_swaps = l - 1 exit LOOPswaps end if @@ -2384,32 +2355,13 @@ subroutine generate_shifts_and_swaps( & struc_data_swaps(l)%swap_density = this%swap_density ! struc_data_swaps(l)%approx_eff_swap_conc = end do - ! call chdir(dirpath) - ! call system('mkdir -p '//trim(adjustl(swapdir))) - ! call chdir(swapdir) - ! write(*,'(3X,"Number of unique swap structures: ",I0)') ngen_swaps - this%structures = [ this%structures, bas_arr(1:ngen_swaps) ] + this%structures = [ this%structures, basis_arr(1:ngen_swaps) ] this%structure_data = [ this%structure_data, struc_data_swaps ] - ! do l=1,ngen_swaps - ! write(dirpath,'(A,I0.2)') trim(adjustl(subdir_prefix)),l - ! call system('mkdir -p '//trim(adjustl(dirpath))) - ! write(filename,'(A,"/",A)') & - ! trim(adjustl(dirpath)),trim(out_filename) - ! ounit=100+l - ! write(*,'(3X,"Writing swap ",I0,"...")') l - ! open(unit=ounit,file=trim(adjustl(filename))) - ! call geom_write(ounit,bas_arr(l)) - ! close(ounit) - ! end do - deallocate(bas_arr) - ! call chdir(pwd2) + deallocate(basis_arr) end if if_swap end do shift_loop - ! call chdir(pwd1) - ! close(unit=shift_unit) - end subroutine generate_shifts_and_swaps !!!############################################################################# @@ -2513,52 +2465,4 @@ subroutine write_shift_data(this, idx_list, directory, filename) end subroutine write_shift_data !############################################################################### - -! !!!############################################################################# -! !!! write structure data in each structure directory -! !!!############################################################################# -! subroutine output_intf_data(SAV, ifit, lw_term, term_lw_idx, up_term, term_up_idx, lw_pricel,up_pricel) -! implicit none -! integer :: unit - -! integer, intent(in) :: ifit, term_lw_idx, term_up_idx -! logical, intent(in) :: lw_pricel,up_pricel -! type(term_arr_type), intent(in) :: lw_term, up_term -! type(latmatch_type), intent(in) :: SAV - - - -! unit=99 -! open(unit=unit, file="struc_dat.txt") -! write(unit,'("Lower material primitive cell used: ",L1)') lw_pricel -! write(unit,'("Upper material primitive cell used: ",L1)') lw_pricel -! write(unit,*) -! write(unit,'("Lattice match: ",I0)') ifit -! write(unit,'((1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & -! SAV%abc,SAV%abc,& -! SAV%tf1(ifit,1,1:3),SAV%tf2(ifit,1,1:3),& -! SAV%tf1(ifit,2,1:3),SAV%tf2(ifit,2,1:3),& -! SAV%tf1(ifit,3,1:3),SAV%tf2(ifit,3,1:3) -! write(unit,'(" vector mismatch (%) = ",F0.9)') SAV%tol(ifit,1) -! write(unit,'(" angle mismatch (°) = ",F0.9)') SAV%tol(ifit,2)*180/pi -! write(unit,'(" area mismatch (%) = ",F0.9)') SAV%tol(ifit,3) -! write(unit,*) -! write(unit,'(" Lower crystal Miller plane: ",3(I3," "))') SAV%tf1(ifit,3,1:3) -! write(unit,'(" Lower termination")') -! write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') -! write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & -! term_lw_idx,lw_term%arr(term_lw_idx)%hmin,lw_term%arr(term_lw_idx)%hmax,lw_term%arr(term_lw_idx)%natom -! write(unit,*) -! write(unit,'(" Upper crystal Miller plane: ",3(I3," "))') SAV%tf2(ifit,3,1:3) -! write(unit,'(" Upper termination")') -! write(unit,'(1X,"Term.",3X,"Min layer loc",3X,"Max layer loc",3X,"no. atoms")') -! write(unit,'(1X,I3,8X,F7.5,9X,F7.5,8X,I3)') & -! term_up_idx,up_term%arr(term_up_idx)%hmin,up_term%arr(term_up_idx)%hmax,up_term%arr(term_up_idx)%natom -! write(unit,*) -! close(unit) - -! return -! end subroutine output_intf_data -! !!!############################################################################# - end module artemis__generator diff --git a/src/fortran/lib/mod_geom_rw.f90 b/src/fortran/lib/mod_geom_rw.f90 index eb315b5..f6ab779 100644 --- a/src/fortran/lib/mod_geom_rw.f90 +++ b/src/fortran/lib/mod_geom_rw.f90 @@ -1470,7 +1470,11 @@ subroutine copy(this, basis, length) !--------------------------------------------------------------------------- ! determines whether user wants output basis extra translational dimension !--------------------------------------------------------------------------- - length_input = size(basis%spec(1)%atom,dim=2) + if(.not.allocated(basis%spec))then + call stop_program("Basis not allocated") + return + end if + length_input = size(basis%spec(lbound(basis%spec,1))%atom,dim=2) if(present(length))then length_ = length else diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 86351b7..549245a 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -1,9 +1,9 @@ module artemis__terminations !! Module for handling termination identification and generation - use artemis__constants, only: real32, tolerance + use artemis__constants, only: real32 use artemis__geom_rw, only: basis_type, geom_write use artemis__misc, only: sort_col, to_lower, to_upper - use artemis__io_utils, only: err_abort + use artemis__io_utils, only: err_abort, stop_program use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: modu, cross, uvec, det use artemis__sym, only: sym_type, check_sym, sym_setup, clone_grp @@ -16,8 +16,8 @@ module artemis__terminations public :: term_arr_type public :: get_termination_info public :: set_layer_tol - public :: set_slab_height - public :: build_slab + public :: build_slab_supercell + public :: cut_slab_to_height type term_type @@ -75,7 +75,7 @@ function get_termination_info( & !! Temporary indices logical :: lunique, ltmp1, lmirror !! Boolean flags - real(real32) :: rtmp1, tol, height, max_sep, c_along, centre + real(real32) :: rtmp1, height, max_sep, c_along, centre !! Temporary variables real(real32) :: layer_sep_ !! Minimum separation between layers @@ -255,18 +255,19 @@ function get_termination_info( & inv_mat(i,i) = -1._real32 end do itmp1 = 0 - do i=1,grp_store%nsym - if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tolerance))then + do i = 1, grp_store%nsym + if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tol_sym))then itmp1 = i exit end if end do if(itmp1.eq.0)then - write(err_msg,*) "No inversion symmetry found!" - call err_abort(err_msg) + call stop_program("No inversion symmetry found!") + exit_code = max(exit_code, 1) + return end if do i = 1, grp_store%nsym - if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tolerance)) & + if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tol_sym)) & grp_store%sym(4,:3,itmp1) = grp_store%sym(4,:3,i) end do @@ -289,13 +290,13 @@ function get_termination_info( & sym_if: if(i.ne.1)then sym_loop1: do j = 1, mterm - 1, 1 if(abs(abs(term_arr(i)%hmax-term_arr(i)%hmin) - & - abs(term_arr_uniq(j)%hmax-term_arr_uniq(j)%hmin)).gt.tolerance) & + abs(term_arr_uniq(j)%hmax-term_arr_uniq(j)%hmin)).gt.tol_sym) & cycle sym_loop1 call clone_grp(grp_store,grp1) call check_sym(grp1,basis=basis_arr(mterm),& iperm=-1,tmpbas2=basis_arr(j),lsave=.true.,tol_sym=tol_sym) if(grp1%nsymop.ne.0)then - if(abs(grp1%sym_save(axis,axis,1)+1._real32).lt.tolerance)then + if(abs(grp1%sym_save(axis,axis,1)+1._real32).lt.tol_sym)then ireject = ireject + 1 reject_match(ireject,:) = [ i, j ] basis_arr_reject(ireject) = basis_arr(mterm) @@ -600,7 +601,7 @@ end subroutine set_layer_tol !############################################################################### - subroutine set_slab_height( basis, map, term, surf, & + subroutine build_slab_supercell( basis, map, term, surf, & height, num_layers, thickness, num_cells, & term_start, term_end, term_step & ) @@ -667,7 +668,7 @@ subroutine set_slab_height( basis, map, term, surf, & if(any(surf.gt.term%nterm))then write(msg, '("INVALID SURFACE VALUES!\nOne or more value & &exceeds the maximum number of terminations in the & - structure.\n& + &structure.\n& & Supplied values: ",I0,1X,I0,"\n& & Maximum allowed: ",I0)') surf, term%nterm call err_abort(trim(msg),fmtd=.true.) @@ -736,6 +737,10 @@ subroutine set_slab_height( basis, map, term, surf, & slab_thickness = abs( dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(3,:) ])), [ basis%lat(2,:) ]) ) case(3) slab_thickness = abs( dot_product(uvec(cross([ basis%lat(1,:) ], [ basis%lat(2,:) ])), [ basis%lat(3,:) ]) ) + case default + write(msg, '("INVALID SURFACE AXIS!")') + call stop_program(trim(msg)) + return end select ! get the largest separation between two terminations if(ludef_surf)then @@ -826,13 +831,13 @@ subroutine set_slab_height( basis, map, term, surf, & term%tol = term%tol/real(num_cells,real32) - end subroutine set_slab_height + end subroutine build_slab_supercell !############################################################################### !############################################################################### - subroutine build_slab( & + subroutine cut_slab_to_height( & basis, map, term, surf, thickness, num_cells, num_layers, & height, prefix, lcycle, & orthogonalise, vacuum & @@ -842,7 +847,7 @@ subroutine build_slab( & !! This procedure builds a slab of the specified terminations from a !! supplied supercell. The supercell must be large enough to be able to !! be cut down to the required slab size. The supercell is built by - !! set_slab_height. + !! build_slab_supercell. implicit none ! Arguments @@ -862,7 +867,7 @@ subroutine build_slab( & integer, intent(in) :: num_cells !! Number of cells in the input slab real(real32), intent(in) :: height - !! Height of the slab if user-defined surf (calculated in set_slab_height) + !! Height of the slab if user-defined surf (calculated in build_slab_supercell) character(2), intent(in) :: prefix !! Prefix for file names !! (e.g. "lw" for lower, "up" for upper) @@ -933,6 +938,10 @@ subroutine build_slab( & case(3) surface_normal_vec = uvec(cross( [ basis%lat(1,:) ], [ basis%lat(2,:)] )) slab_thickness = abs( dot_product(surface_normal_vec, [ basis%lat(3,:) ]) ) + case default + write(msg, '("INVALID SURFACE AXIS!")') + call stop_program(trim(msg)) + return end select if(thickness.gt.0._real32)then rtmp1 = slab_thickness / num_cells * ( num_cells - 1 ) @@ -1075,7 +1084,7 @@ subroutine build_slab( & call basis%normalise(ceil_val=0.9999_real32,floor_coords=.true.,zero_round=0._real32) - end subroutine build_slab + end subroutine cut_slab_to_height !############################################################################### end module artemis__terminations From 62ff9a54d7a6915db78b088baba1b51c2560cb94 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 10:33:44 +0100 Subject: [PATCH 089/137] Check tests and examples --- .../fortran_exe/generate_interface/param.in | 2 +- src/fortran/lib/mod_generator.f90 | 6 +-- src/fortran/lib/mod_geom_utils.f90 | 54 ++++++++++--------- src/fortran/lib/mod_sym.f90 | 3 +- .../param.in | 3 +- 5 files changed, 34 insertions(+), 34 deletions(-) diff --git a/example/fortran_exe/generate_interface/param.in b/example/fortran_exe/generate_interface/param.in index bb28722..f4ec892 100644 --- a/example/fortran_exe/generate_interface/param.in +++ b/example/fortran_exe/generate_interface/param.in @@ -3,7 +3,7 @@ SETTINGS RESTART = 0 STRUC1_FILE = POSCAR_Si ! lower structure/interface structure STRUC2_FILE = POSCAR_Ge ! upper structure (not used if IRESTART > 0) - IPRINT = -1 + IPRINT = 0 TOL_SYM = 1.D-4 CLOCK = 0 END SETTINGS diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index ccce843..6274638 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1434,16 +1434,14 @@ subroutine generate_interfaces( & call get_primitive_cell(structure_lw, tol_sym=this%tol_sym) else if(verbose_.gt.0) write(*,'(1X,"Using supplied cell for lower material")') - call reducer(structure_lw) - structure_lw%lat = primitive_lat(structure_lw%lat) + call primitive_lat(structure_lw) end if if(this%use_pricel_up)then if(verbose_.gt.0) write(*,'(1X,"Using primitive cell for upper material")') call get_primitive_cell(structure_up, tol_sym=this%tol_sym) else if(verbose_.gt.0) write(*,'(1X,"Using supplied cell for upper material")') - call reducer(structure_up) - structure_up%lat = primitive_lat(structure_up%lat) + call primitive_lat(structure_up) end if diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 033b2a1..329e6fb 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -1011,21 +1011,22 @@ end function centre_of_mass !!! Reorientates lattice to the primitive lattice of its type !!!############################################################################# !!! NEED TO SET UP TO WORK FOR THE EXTRA SWAPPINGS OF A, B AND C - function primitive_lat(inlat) result(plat) + subroutine primitive_lat(basis) implicit none + type(basis_type), intent(inout) :: basis integer :: i,j real(real32) :: dtmp1 real(real32), dimension(3) :: scal real(real32), dimension(3,3) :: lat,plat,tmat1,tmat2 - real(real32), dimension(3,3), intent(in) :: inlat - real(real32), dimension(4,3,3) :: special + real(real32), dimension(3,3,4) :: special !!--------------------------------------------------------------- !! makes all lattice vectors unity !!--------------------------------------------------------------- - lat=inlat - plat=lat + call reducer(basis,ltmp = .true.) + lat = basis%lat + plat = lat do i=1,3 scal(i)=modu(lat(i,:)) lat(i,:)=lat(i,:)/scal(i) @@ -1035,46 +1036,47 @@ function primitive_lat(inlat) result(plat) !!--------------------------------------------------------------- !! sets up the special set of primitive lattices !!--------------------------------------------------------------- - special(1,:,:) = transpose( reshape( (/& + special(:,:,1) = transpose( reshape( (/& 1._real32, 0._real32, 0._real32,& 0._real32, 1._real32, 0._real32,& 0._real32, 0._real32, 1._real32/), shape(lat) ) ) - special(2,:,:) = transpose( reshape( (/& + special(:,:,2) = transpose( reshape( (/& 1._real32, 0._real32, 0._real32,& -0.5_real32, sqrt(3._real32)/2._real32, 0._real32,& 0._real32, 0._real32, 1.0_real32/), shape(lat) ) ) - special(3,:,:) = transpose( reshape( (/& + special(:,:,3) = transpose( reshape( (/& 0.0_real32, 1._real32, 1._real32,& 1._real32, 0._real32, 1._real32,& 1._real32, 1._real32, 0.0_real32/), shape(lat) ) ) - special(3,:,:) = special(3,:,:)/sqrt(2._real32) - special(4,:,:) = transpose( reshape( (/& + special(:,:,3) = special(:,:,3)/sqrt(2._real32) + special(:,:,4) = transpose( reshape( (/& -1._real32, 1._real32, 1._real32,& 1._real32, -1._real32, 1._real32,& 1._real32, 1._real32, -1._real32/), shape(lat) ) ) - special(4,:,:) = special(4,:,:)/sqrt(3._real32) + special(:,:,4) = special(:,:,4)/sqrt(3._real32) !!--------------------------------------------------------------- !! cycles special set to find primitive lattice of supplied lat !!--------------------------------------------------------------- - tmat1=matmul(lat,transpose(lat)) + tmat1 = matmul(lat,transpose(lat)) checkloop: do i=1,4 - !tfmat=matmul(lat,inverse_3x3(special(i,:,:))) + !tfmat=matmul(lat,inverse_3x3(special(:,:,i))) !tfmat=matmul(tfmat,transpose(tfmat)) - tmat2=matmul(special(i,:,:),transpose(special(i,:,:))) - dtmp1=tmat2(1,1)/tmat1(1,1) + tmat2 = matmul(special(:,:,i),transpose(special(:,:,i))) + dtmp1 = tmat2(1,1)/tmat1(1,1) !if(all(abs(tfmat-nint(tfmat)).lt.1.E-8_real32))then - if(all(abs(tmat1*dtmp1-tmat2).lt.1.E-8_real32))then + if(all(abs(tmat1*dtmp1-tmat2).lt.1.E-6_real32))then do j=1,3 - plat(j,:)=scal(j)*special(i,j,:) + plat(j,:)=scal(j)*special(j,:,i) end do exit checkloop end if end do checkloop + basis%lat = plat - end function primitive_lat + end subroutine primitive_lat !!!############################################################################# @@ -1124,12 +1126,12 @@ subroutine reducer(basis,tmptype,ltmp) lreduced=reduced_check(newlat,cell_type,S) if(lreduced) exit if(verb) then - write(67,*) - write(67,*) count - write(67,*) "###############" - write(67,*) (transmat(i,:),i=1,3) - write(67,*) - write(67,*) (newlat(i,:),i=1,3) + write(*,*) + write(*,*) count + write(*,*) "###############" + write(*,*) (transmat(i,:),i=1,3) + write(*,*) + write(*,*) (newlat(i,:),i=1,3) end if if(count.gt.limit) then write(0,'("FAILED to find the reduced cell within ",I0," steps")') count @@ -1240,8 +1242,8 @@ subroutine reducer(basis,tmptype,ltmp) call mkNiggli_lat(basis%lat,newlat,transmat,S) lreduced=reduced_check(newlat,cell_type,S,"n") if(verb) then - write(67,*) lreduced - write(67,*) (transmat(i,:),i=1,3) + write(*,*) lreduced + write(*,*) (transmat(i,:),i=1,3) end if diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 1582592..850f6db 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -1134,10 +1134,9 @@ subroutine get_primitive_cell(basis, tol_sym) !!----------------------------------------------------------------------- !! Reduce the lattice to symmetry definition !!----------------------------------------------------------------------- - call reducer(basis) !! next line necessary as FCC and BCC do not conform to Niggli reduced ... !! ... cell definitions. - basis%lat = primitive_lat(basis%lat) + call primitive_lat(basis) diff --git a/test/cell_edits_identify_terminations_CaZrO3/param.in b/test/cell_edits_identify_terminations_CaZrO3/param.in index 6b36416..35b7332 100644 --- a/test/cell_edits_identify_terminations_CaZrO3/param.in +++ b/test/cell_edits_identify_terminations_CaZrO3/param.in @@ -12,9 +12,10 @@ END SETTINGS CELL_EDITS LSURF_GEN = T - MILLER_PLANE = 0 1 0 + MILLER_PLANE = 0 0 1 SLAB_THICKNESS = 5 VACUUM = 20 + USE_PRICEL = T END CELL_EDITS From a6eb647bd4a9340c157b6a37a91b5a8dce0efcbb Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 13:38:55 +0100 Subject: [PATCH 090/137] Fix termination filepath printing --- app/main.f90 | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 6916bfa..faa6e5b 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -53,12 +53,16 @@ program artemis_executable ) structures = generator%get_terminations(1, & + surface = lw_surf, & num_layers = lw_num_layers, & thickness = lw_thickness, & orthogonalise = lortho & ) + filepath = "DTERMINATIONS" + call system("mkdir -p " // trim(filepath)) do i = 1, size(structures) - write(filename, '(A,I0,A)') "term_", i, ".vasp" + write(filename, '(A,"/POSCAR_term",I0)') & + trim(adjustl(filepath)), i open(newunit=unit, status='replace', file=trim(filename)) call geom_write(unit, structures(i)) close(unit) @@ -131,8 +135,11 @@ program artemis_executable thickness = lw_thickness, & orthogonalise = lortho & ) + filepath = "DTERMINATIONS/DLW_TERMS" + call system("mkdir -p " // trim(filepath)) do i = 1, size(structures) - write(filename, '(A,I0,A)') "lw_term_", i, ".vasp" + write(filename, '(A,"/POSCAR_term",I0)') & + trim(adjustl(filepath)), i open(newunit=unit, status='replace', file=trim(filename)) call geom_write(unit, structures(i)) close(unit) @@ -148,8 +155,11 @@ program artemis_executable thickness = up_thickness, & orthogonalise = lortho & ) + filepath = "DTERMINATIONS/DUP_TERMS" + call system("mkdir -p " // trim(filepath)) do i = 1, size(structures) - write(filename, '(A,I0,A)') "up_term_", i, ".vasp" + write(filename, '(A,"/POSCAR_term",I0)') & + trim(adjustl(filepath)), i open(newunit=unit, status='replace', file=trim(filename)) call geom_write(unit, structures(i)) close(unit) From a77de808a67977f8bccf2a5f11b8ef06a7d18e3f Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 14:23:40 +0100 Subject: [PATCH 091/137] Fix rebase related variable issue --- src/fortran/lib/mod_generator.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 6274638..747a6a0 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1332,7 +1332,6 @@ subroutine generate_interfaces( & integer :: ntrans, iunique, itmp1, num_structures_old integer :: layered_axis_lw, layered_axis_up - real(real32) :: dtmp1, bondlength type(confine_type) :: confine type(latmatch_type) :: SAV type(term_arr_type) :: lw_term, up_term From 990430b3fa4e2d677a83daa8f614b280ceae3cb0 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 15:05:29 +0100 Subject: [PATCH 092/137] Improve documentation --- CODE_OF_CONDUCT.md | 70 +++++++++++ CONTRIBUTING.md | 117 +++++++++++++++++++ README.md | 282 ++++++++++++++++++++++++++++++--------------- 3 files changed, 374 insertions(+), 95 deletions(-) create mode 100644 CODE_OF_CONDUCT.md create mode 100644 CONTRIBUTING.md diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md new file mode 100644 index 0000000..79a5f06 --- /dev/null +++ b/CODE_OF_CONDUCT.md @@ -0,0 +1,70 @@ +# Code of Conduct - ARTEMIS + +## Our Pledge + +In the interest of fostering an open and welcoming environment, we as +contributors and maintainers pledge to make participation in our project and +our community a harassment-free experience for everyone, regardless of age, body +size, disability, ethnicity, sex characteristics, gender identity and expression, +level of experience, education, socio-economic status, nationality, personal +appearance, race, religion, or sexual identity and orientation. + +## Our Standards + +Examples of behavior that contributes to a positive environment for our +community include: + +* Demonstrating empathy and kindness toward other people +* Being respectful of differing opinions, viewpoints, and experiences +* Giving and gracefully accepting constructive feedback +* Accepting responsibility and apologising to those affected by our mistakes, +and learning from the experience +* Focusing on what is best not just for us as individuals, but for the +overall community + +Examples of unacceptable behavior include: + +* The use of sexualised language or imagery, and sexual attention or +advances +* Trolling, insulting or derogatory comments, and personal or political attacks +* Public or private harassment +* Publishing others' private information, such as a physical or email +address, without their explicit permission +* Other conduct which could reasonably be considered inappropriate in a +professional setting + +## Our Responsibilities + +Project maintainers are responsible for clarifying and enforcing our standards of +acceptable behavior and will take appropriate and fair corrective action in +response to any instances of unacceptable behavior. + +Project maintainers have the right and responsibility to remove, edit, or reject +comments, commits, code, wiki edits, issues, and other contributions that are +not aligned to this Code of Conduct, or to ban +temporarily or permanently any contributor for other behaviors that they deem +inappropriate, threatening, offensive, or harmful. + +## Scope + +This Code of Conduct applies within all community spaces, and also applies when +an individual is officially representing the community in public spaces. +Examples of representing our community include using an official e-mail address, +posting via an official social media account, or acting as an appointed +representative at an online or offline event. + +## Enforcement + +Instances of abusive, harassing, or otherwise unacceptable behavior may be +reported to the community leaders responsible for enforcement at . +All complaints will be reviewed and investigated promptly and fairly. + +All community leaders are obligated to respect the privacy and security of the +reporter of any incident. + +## Attribution + +This Code of Conduct is adapted from the [Contributor Covenant](https://contributor-covenant.org/), version +[1.4](https://www.contributor-covenant.org/version/1/4/code-of-conduct/code_of_conduct.md) and +[2.0](https://www.contributor-covenant.org/version/2/0/code_of_conduct/code_of_conduct.md), +and was generated by [contributing-gen](https://github.com/bttger/contributing-gen). diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..2a3b146 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,117 @@ +# Contributing Guidelines + +Thank you for considering contributing to the ARTEMIS project! We appreciate your time and effort. To ensure a smooth collaboration, please follow the guidelines provided below. + +Please first discuss potential changes you wish to make to the project via issue (preferably), or email. + +> And if you like the project, but just don't have time to contribute, that's fine. There are other easy ways to support the project and show your appreciation, which we would also be very happy about: +> - Star the project +> - Mention it on social media platforms +> - Refer this project in your project's readme +> - Mention the project at local meetups and tell your friends/colleagues + + + +## Table of Contents +- [Code of Conduct](#code-of-conduct) +- [I Have a Question](#i-have-a-question) +- [I Want to Contribute](#i-want-to-contribute) +- [Reporting Bugs](#reporting-bugs) +- [Suggesting Enhancements](#suggesting-enhancements) +- [Code Style](#code-style) +- [Testing](#testing) +- [Documentation](#documentation) +- [Contact](#contact) +- [License](#license) + + +## Code of Conduct + +This project and everyone participating in it is governed by the +[ARTEMIS Code of Conduct](CODE_OF_CONDUCT.md). +By participating, you are expected to uphold this code. +Please report unacceptable behavior to the [ARTEMIS developers](mailto:support@artemis-materials.co.uk?subject=ARTEMIS%20-%behaviour). + +## I Have a Question + +> If you want to ask a question, we assume that you have read the available [Documentation](README.md). + +Before you ask a question, it is best to search for existing [Issues](https://github.com/ExeQuantCode/ARTEMIS/issues) that might help you. +In case you have found a suitable issue and still need clarification, you can write your question in this issue. It is also advisable to search the internet for answers first. + +If you then still feel the need to ask a question and need clarification, we recommend the following: + +- Open an [Issue](https://github.com/ExeQuantCode/ARTEMIS/issues/new). +- Provide as much context as you can about what you're running into. +- Provide project and platform versions (python, fortran, pip), depending on what seems relevant. + +We will then take care of the issue as soon as possible. + +## I Want To Contribute + +> ### Legal Notice +> When contributing to this project, you must agree that you have authored 100% of the content, that you have the necessary rights to the content and that the content you contribute may be provided under the project license. + +### Reporting Bugs +If you encounter any issues or have suggestions for improvement, please open an [Issue](https://github.com/ExeQuantCode/ARTEMIS/issues/new) on the repository's issue tracker. + +When reporting, please provide as much context as possible and describe the reproduction steps that someone else can follow to recreate the issue on their own. +This usually includes your code. +For good bug reports you should isolate the problem and create a reduced test case. + + + +### Suggesting Enhancements + +This section guides you through submitting an enhancement suggestion for ARTEMIS, **including completely new features and minor improvements to existing functionality**. +Following these guidelines will help maintainers and the community to understand your suggestion and find related suggestions. + + +#### Before Submitting an Enhancement + +- Make sure that you are using the latest version. +- Read the compilable documentation carefully and find out if the functionality is already covered. +- Perform a [search](https://github.com/ExeQuantCode/ARTEMIS/issues) to see if the enhancement has already been suggested. If it has, add a comment to the existing issue instead of opening a new one. +- Find out whether your idea fits with the scope and aims of the project. It's up to you to make a strong case to convince the project's developers of the merits of this feature. Keep in mind that we want features that will be useful to the majority of our users and not just a small subset. If you're just targeting a minority of users, consider writing an add-on/plugin library. + + +### Contributing Code + +This guide provides the recommended route to contributing to ARTEMIS: + +1. Fork the repository. +2. Clone the forked repository to your local machine. +3. Create a new branch for your changes. +4. Make your changes and commit them. +5. Push the changes to your forked repository. +6. Open a pull request to the main repository. + +When submitting your contributions, please ensure the following: +- Provide a clear and descriptive title for your pull request. +- Include a detailed description of the changes made. +- Reference any related issues or pull requests, if applicable. +- Write unit tests for your contributions +- Ensure all existing tests pass before submitting your changes. +- Update the documentation to reflect your changes, if necessary (i.e. through FORD style commenting). +- Provide examples and usage instructions, if applicable. + +Follow the [Code Style](#code-style) when contributing code to this project to ensure compatibility and a uniform format to the project. + + +### Code Style +- Follow the code style and conventions set out in the [RAFFLE codebase](https://github.com/ExeQuantCode/RAFFLE). Moving forward, the [ARTEMIS codebase](https://github.com/ExeQuantCode/ARTEMIS) will be adopting this format and, as such, will transition all old commenting, documentation, and general code style to this form (this is likely to be a slow process). +- Use meaningful variable and function names. +- Write clear and concise comments. For the Fortran library, use comments compatible with the [FORD Fortran Documenter](https://forddocs.readthedocs.io/en/stable/). The Fortran library does not yet support the FORD documenter, but the plan is to align it with the RAFFLE codebase and maintain the same level of documenter support. For the Python wrapper, use comments compatible with [pandoc](https://pandoc.org). + + + +## Contact +If you have any questions or need further assistance, feel free to contact the [ARTEMIS developers](mailto:support@artemis-materials.co.uk?subject=ARTEMIS%20-%query). + +## License +This project is licensed under the [GPL-3.0 License](LICENSE). + + +## Attribution +This guide is based on the **contributing-gen** and has been copied from the [graphstruc](https://github.com/nedtaylor/graphstruc) repository, with permission from the creator (Ned Taylor). +[Make your own](https://github.com/bttger/contributing-gen)! diff --git a/README.md b/README.md index 356af31..229313c 100644 --- a/README.md +++ b/README.md @@ -2,10 +2,13 @@

-[![License: CC BY-NC 3.0](https://img.shields.io/badge/License-CC_BY--NC_3.0-lightgrey.svg)](https://creativecommons.org/licenses/by-nc/3.0/ "View CC BY-NC 3.0 license") +[![GPLv3 workflow](https://img.shields.io/badge/License-GPLv3-yellow.svg)](https://www.gnu.org/licenses/gpl-3.0.en.html "View GPLv3 license") [![Latest Release](https://img.shields.io/github/v/release/ExeQuantCode/ARTEMIS?sort=semver)](https://github.com/ExeQuantCode/ARTEMIS/releases "View on GitHub") [![Paper](https://img.shields.io/badge/Paper-Comp_Phys_Comms-orange.svg)](https://doi.org/10.1016/j.cpc.2020.107515) -[![GCC compatibility](https://img.shields.io/badge/gcc-14.1.0-green)](https://gcc.gnu.org/gcc-14/ "View GCC") +[![Documentation Status](https://readthedocs.org/projects/artemis-materials/badge/?version=latest)](https://artemis-materials.readthedocs.io/en/latest/?badge=latest "ARTEMIS ReadTheDocs") +[![FPM](https://img.shields.io/badge/fpm-0.11.0-purple)](https://github.com/fortran-lang/fpm "View Fortran Package Manager") +[![CMAKE](https://img.shields.io/badge/cmake-3.27.7-red)](https://github.com/Kitware/CMake/releases/tag/v3.27.7 "View cmake") +[![GCC compatibility](https://img.shields.io/badge/gcc-14.2.0-green)](https://gcc.gnu.org/gcc-14/ "View GCC") Ab Initio Restructuring Tool Enabling Modelling of Interface Structures @@ -29,139 +32,228 @@ All information has been ported over where possible. ARTEMIS is a software package for the generation and modelling of interfaces between materials. -ARTEMIS is distributed with the following directories: +ARTEMIS is both a Fortran and a Python library, with the option of a Fortran executable. +The code relies on recent Fortran features, so has no backwards compatibility with Fortran95. - docs/ Documentation - src/ Source code - tools/ Extra shell script tools - examples/ Example ARTEMIS files -After ARTEMIS is compiled, the following directories may also exist: +## Documentation - bin/ Contains binary executables - obj/ Contains object (built/indermetiate) files, which are compiled binary files that haven't been linked yet -For further information please see the User manual (docs/manual.pdf) +> **_NOTE_:** +> The Read*the*Docs is still under development. +> More guides will be added in the coming weeks and months. +Tutorials and documentation will be provided on the [docs](http://artemis-materials.readthedocs.io/) website. +The methodology is detailed in the [paper](https://doi.org/10.1016/j.cpc.2020.107515). +Refer to the [API Documentation section](#api-documentation) later in this document to see how to access the API-specific documentation. -Setup ------ -Run the following command in the directory containing the Makefile: -make +The Fortran executable/app currently has the most extensive documentation. +This can be found in two forms: +1. [The PDF manual](docs/manual.pdf) +2. The executable help function (`--help` and `--search` flags) -This should create a bin directory, in which the executable -'artemis' can be found. This directory should be found in the -DARTEMIS directory. +## Requirements +- Fortran compiler supporting Fortran 2018 standard or later +- fpm or CMake (fpm works only for Fortran installation) + +Python-specific installation: + +- Python 3.11 or later (might work on earlier, have not tested) +- NumPy.f2py +- f90wrap +- cython +- scikit-build-core +- meson +- make or ninja +- CMake +- ASE + +The library bas been developed and tested using the following Fortran compilers: +- gfortran -- gcc 11.4.0 +- gfortran -- gcc 13.2.0 +- gfortran -- gcc 14.1.0 +- gfortran -- gcc 14.2.0 + +The library is known to not currently work with the intel Fortran compilers. + +## Installation + +The Python library is not yet directly available from PyPi (this will be made available with the first Python library full release). +For now, local pip installation is required. + +First, use the following commands to download the ARTEMIS repository: +``` + git clone https://github.com/ExeQuantCode/artemis.git + cd artemis +``` + +Depending on what language will be used in, installation will vary from this point. + +### Python + +For Python, the easiest installation is through pip: +``` +pip install . +``` + +Another option is installing it through cmake, which involves: +``` +mkdir build +cd build +cmake .. +make install +``` + +Then, the path to the install directory (`${HOME}/.local/artemis`) needs to be added to the include path. NOTE: this method requires that the user manually installs the `ase`, `numpy` and `f90wrap` modules for Python. + +### Fortran + +For Fortran, either fpm or cmake are required. + +#### fpm + +fpm installation is as follows: + +``` +fpm build --profile release +``` + +This will install both the Fortran library and the Fortran application for ARTEMIS. +The library can then be called from other fpm-built Fortran programs through normal means (usually referencing the location of ARTEMIS in the program's own `fpm.toml` file). +The application can be run using +``` +fpm run +``` + +#### cmake + +cmake installation is as follows: +``` +mkdir build +cd build +cmake [-DBUILD_PYTHON=Off] .. +make install +``` +The optional filed (dentoted with `[...]`) can be used to turn off installation of the Python library. +This will build the library in the build/ directory. +All library files will then be found in: +``` +${HOME}/.local/artemis +``` +Inside this directory, the following files will be generated: +``` +include/artemis.mod +lib/libartemis.a +``` How-to ------ -ARTEMIS mainly works off of an input file, but can also perform some -actions via flags. - +Until recently, ARTEMIS has existed solely as a Fortran executable. +This version of the code is currently best documented, but this will change in the near future as the Python library is tested more. To get an example input file, run the following command: +``` artemis -d example.in +``` -This will generate the file 'example.in', with the structure of the +This will generate the file `example.in`, with the structure of the ARTEMIS input file. -To get descriptions of the tags within the input file, run either command: -artemis --help [TAGNAME] -artemis --search +To get descriptions of the tags within the input file, run either command: - -Further documentation on the workings of ARTEMIS can be found in the docs/ -directory or on the wiki (linked below) +``` +artemis --help [all|] +artemis --search +``` Websites -------- -Webpage: http:/www.artemis-materials.co.uk/ -Wiki: http://www.artemis-materials.co.uk/HRG +Group webpage: http://www.artemis-materials.co.uk +Group wiki: http://www.artemis-materials.co.uk/HRG -Contact -------- -Please log issues, bug-reports, and feature requests on the issue tracker for this repository: https://github.com/ExeQuantCode/ARTEMIS/issues +Guide and documentation: https://artemis-materials.readthedocs.io/en/latest/ -For any serious or private concerns, please use the following email address: -support@artemis-materials.co.uk +API documentation +----------------- +> **_NOTE_:** +> API documentation is not yet set up. +> It is planned to be implemented in an upcoming release to work alongside the Read*the*Docs and Python library. -Developers ------------- --Ned Thaddues Taylor --Francis Huw Davies --Isiah Edward Mikel Rudkin --Steven Paul Hepplestone + -Advisors +Contributing ------------ --Elizabeth L. Martin + +Please note that this project adheres to the [Contributing Guide](CONTRIBUTING.md). +If you want to contribute to this project, please first read through the guide. +If you have any questions, bug reports, or feature requests, please either discuss then in [issues](https://github.com/ExeQuantCode/artemis/issues). + +For any serious or private concerns, please use the following email address: +support@artemis-materials.co.uk License ------------ This work is licensed under a [GPL v3 license]([https://opensource.org/license/mit/](https://www.gnu.org/licenses/gpl-3.0.en.html)). +Code Coverage +------------- + +Automated reporting on unit test code coverage in the README is achieved through utilising the [cmake-modules](https://github.com/rpavlik/cmake-modules) and [dynamic-badges-action](https://github.com/Schneegans/dynamic-badges-action?tab=readme-ov-file) projects. + + +Developers +------------ +- Ned Thaddues Taylor +- Francis Huw Davies +- Isiah Edward Mikel Rudkin +- Steven Paul Hepplestone -Source file descriptions +Contributers ------------ -src/main.f90 - main file that calls the functions and determines the task of the job -src/inputs.f90 - handles input file and assigned default values to parameters -src/interfaces.f90 - task 1 ARTEMIS job. Calls subroutines to generate interfaces -src/aspect.f90 - task 0 ARTEMIS job. Calls subroutines to edit structure -src/io.F90 - error handling file, help, search and startup printing -src/mod_help.f90 - descriptions of all input tags -src/default_infile.f90 - prints default/example input file of ARTEMIS -src/mod_shifting.f90 - identifies and generates sets of interface shifts -src/mod_swapping.f90 - generates sets of swaps (intermixing) -src/mod_intf_identifier.f90 - identifies interface axis and location for pregen interface -src/mod_lat_compare.f90 - performs lattice matching over a set of Miller planes -src/mod_plane_matching.f90 - performs lattice matching over a single Miller plane - -src/lib/mod_constants.f90 - a set of global constants used in this code -src/lib/mod_misc.f90 - miscellaneous functions and subroutines -src/lib/mod_misc_maths.f90 - maths functions and subroutines -src/lib/mod_misc_linalg.f90 - linear algebra functions and subroutines -src/lib/mod_rw_geom.f90 - read and write structure (geometry) files -src/lib/mod_edit_geom.f90 - tools to edit lattice and basis (geometry editing) -src/lib/mod_sym.f90 - tools to apply and determine symmetries between bases -src/lib/mod_tools_infile.f90 - tools to read input files - - - -Other files +- Conor Jason Price +- Tsz Hin Chan +- Joe Pitfield +- Edward Allery Baker +- Shane Graham Davies + +Advisors ------------ -README.md - a readme file with a brief description of the code and files -Makefile - the makefile used for compiling the code -LICENSE - license of ARTEMIS code -CHANGE.LOG - changelog for ARTEMIS -artemis.ascii - ARTEMIS logo in ascii form -artemis_logo.pdf - ARTEMIS logo -docs/manual.pdf - pdf of ARTEMIS manual/user guide -docs/manual.tex - tex file of ARTEMIS manual -tools/compress.sh - script to compress ARTEMIS directory -examples/generate_interface/param.in - example input file -examples/generate_interface/POSCAR_Si - silicon 8 atom unit cell -examples/generate_interface/POSCAR_Ge - germanium 8 atom unit cell -examples/generate_interface/DINTERFACES - directory containing example output interface structures -examples/pregenerated_interface/param.in - example input file -examples/pregenerated_interface/POSCAR - CaCu3Ti4O12|CuO interface structure -examples/pregenerated_interface/DINTERFACES - directory containing example output interface structures -examples/identify_terminations/param.in - example input file -examples/identify_terminations/POSCAR - silicon 2 atom primitive cell -examples/identify_terminations/DTERMINATIONS - directory containing example output slab structures +- Elizabeth L. Martin + + + +## References + +If you use this code, please cite our paper: +```text +@article{Taylor2020ARTEMISAbInitio, + title = {ARTEMIS: Ab initio restructuring tool enabling the modelling of interface structures}, + volume = {257}, + ISSN = {0010-4655}, + url = {http://dx.doi.org/10.1016/j.cpc.2020.107515}, + DOI = {10.1016/j.cpc.2020.107515}, + journal = {Computer Physics Communications}, + publisher = {Elsevier BV}, + author = {Taylor, Ned Thaddeus and Davies, Francis Huw and Rudkin, Isiah Edward Mikel and Price, Conor Jason and Chan, Tsz Hin and Hepplestone, Steven Paul}, + year = {2020}, + month = dec, + pages = {107515} +} +``` + +This README has been copied from the [RAFFLE repository](https://github.com/ExeQuantCode/RAFFLE), with permission from the creator (Ned Taylor). \ No newline at end of file From c15fa49db370ec4ca8207c8a78611d9d9b2c4eb5 Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 15:06:45 +0100 Subject: [PATCH 093/137] Remove code coverage section --- README.md | 6 ------ 1 file changed, 6 deletions(-) diff --git a/README.md b/README.md index 229313c..419d9e0 100644 --- a/README.md +++ b/README.md @@ -210,12 +210,6 @@ License ------------ This work is licensed under a [GPL v3 license]([https://opensource.org/license/mit/](https://www.gnu.org/licenses/gpl-3.0.en.html)). -Code Coverage -------------- - -Automated reporting on unit test code coverage in the README is achieved through utilising the [cmake-modules](https://github.com/rpavlik/cmake-modules) and [dynamic-badges-action](https://github.com/Schneegans/dynamic-badges-action?tab=readme-ov-file) projects. - - Developers ------------ - Ned Thaddues Taylor From 008d260af4763d91c5ecf17f4c8c2d997f12b07f Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 24 Apr 2025 15:38:25 +0100 Subject: [PATCH 094/137] Add install documentation --- docs/source/about.rst | 14 ++++ docs/source/index.rst | 4 +- docs/source/install.rst | 170 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 186 insertions(+), 2 deletions(-) create mode 100644 docs/source/about.rst create mode 100644 docs/source/install.rst diff --git a/docs/source/about.rst b/docs/source/about.rst new file mode 100644 index 0000000..4e6abce --- /dev/null +++ b/docs/source/about.rst @@ -0,0 +1,14 @@ +.. _about: + +===== +About +===== + + +ARTEMIS (Ab Initio Restructuring Tool Enabling Modelling of Interface Structures) is a package for generating lattice matched interfaces between material. +ARTEMIS interfaces with the `Atomic Simulation Environment (ASE) `_. + +ARTEMIS is both a Fortran and a Python library, with the option of a Fortran executable. +The code heavily relies on features of recent Fortran releases, so there is no backwards compatibility with Fortran95. + +The library enables users to provide two crystal structures, from which it generates a set of lattice matched interfaces within user-defined tolerances. \ No newline at end of file diff --git a/docs/source/index.rst b/docs/source/index.rst index 29f25c5..5dd7c5d 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -53,8 +53,8 @@ An example about install - tutorials/index - Python API +.. tutorials/index +.. Python API .. Indices and tables .. ================== diff --git a/docs/source/install.rst b/docs/source/install.rst new file mode 100644 index 0000000..f58595a --- /dev/null +++ b/docs/source/install.rst @@ -0,0 +1,170 @@ +.. _install: + +============ +Installation +============ + +The Python library is not yet directly available from PyPi (this will be made available with the first Python library full release). +For now, local pip installation is required. + +First, use the following commands to download the ARTEMIS repository: +.. code-block:: bash + git clone https://github.com/ExeQuantCode/artemis.git + cd artemis + +Depending on what language will be used in, installation will vary from this point. + + +Global requirements +=================== + +All installation methods require the following dependency: + +- Fortran compiler (gfortran>=13.1, not compatible with intel compilers) + +Python +====== + +Requirements +------------ + +- python (>=3.11) +- `pip `_ +- `f90wrap `_ (>=0.2.14) +- `numpy `_ (>=1.26) +- `meson `_ (>=1.6) +- `cython `_ (>=3.0) +- `sckit-build-core `_ (>=0.11) +- `cmake `_ (>=3.17) +- `ninja `_ (>=1.10) or `GNU Make `_ +- `ASE `_ (>=3.23) + + +Installation using pip +----------------------- + + +For Python, the easiest installation is through pip: + +.. code-block:: bash + pip install . + +Depending on your setup, this will install the Python package and all its dependencies in different places. +To find where this has been installed, you can run: + +.. code-block:: bash + + pip show artemis + +This will show you the location of the installed package, in addition to other information about the package. + +Installation using cmake +------------------------ + +Another option is installing it through cmake, which involves: +.. code-block:: bash + mkdir build + cd build + cmake .. + make install + +Then, the path to the install directory (`${HOME}/.local/artemis`) needs to be added to the include path. +NOTE: this method requires that the user manually installs the `ase`, `numpy` and `f90wrap` modules for Python. + +Fortran +======= + +Requirements +------------ + +- `cmake `_ (>=3.17) or `fpm `_ (>=0.9.0) +- `GNU Make `_ (if using cmake) + + +As mentioned, the Fortran library provides the same functionality as the Python package, but in Fortran instead. + +To install the Fortran library or executable, the recommended method is to use the Fortran package manager (fpm). +Cmake is also supported. + +Installation using fpm +---------------------- + +To install the Fortran library and the executable using fpm, navigate to the root directory of the repository and run: + +.. code-block:: bash + + fpm build --profile release + fpm install + +This can also be set up as a dependency in your own fpm project by adding the following to your ``fpm.toml`` file: + +.. code-block:: toml + + [dependencies] + raffle = { git = "https://github.com/ExeQuantCode/RAFFLE" } + + +Installation using cmake +------------------------ + +To install the Fortran library using cmake, navigate to the root directory of the repository and run: + +.. code-block:: bash + + mkdir build + cd build + cmake -DBUILD_PYTHON=Off -DBUILD_EXECUTABLE=Off .. + make + make install + +This will build the Fortran library and install it in the default location (``~/.local/artemis``). + +To install the standalone executable, run: + +.. code-block:: bash + + mkdir build + cd build + cmake -DBUILD_PYTHON=Off -DBUILD_EXECUTABLE=On .. + make + make install + +This will build the Fortran library and install it in the default location (``~/.local/artemis``). + + +Installing on MacOS (Homebrew) +============================== + +RAFFLE is developed on Linux and MacOS, and should work on both. +However, there are likely some additional steps required to install RAFFLE on MacOS. +This is because **it is not recommended to rely on the Mac system Python, or Fortran and C compilers**. + +The recommended way to install Python, gfortran and gcc on MacOS is to use `Homebrew `_. +First, install Homebrew by following the guide on their website. + +Once Homebrew is installed, you can install the required dependencies by running: + +.. code-block:: bash + + brew install python + brew install gcc + brew install gfortran + export CC=$(brew --prefix gfortran) + export FC=$(brew --prefix gcc) + +Confirm a successful Python installation by running: + +.. code-block:: bash + + python --version + whereis python + +This should show the correct Python version (3.11 or later) and path. + +Next, if you are using ``pip``, then the following command is found to result in the least issues: + +.. code-block:: bash + + python -m pip install --upgrade . + +This ensures that the correct Python version is being called, and that the correct version of ``pip`` is being used. From 5f6e391c7577a1014ec7b0457cf41ba41f2bca33 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 24 Apr 2025 15:48:56 +0100 Subject: [PATCH 095/137] Fix typo --- docs/source/install.rst | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/source/install.rst b/docs/source/install.rst index f58595a..2d75ee4 100644 --- a/docs/source/install.rst +++ b/docs/source/install.rst @@ -47,6 +47,7 @@ Installation using pip For Python, the easiest installation is through pip: .. code-block:: bash + pip install . Depending on your setup, this will install the Python package and all its dependencies in different places. From bf365c2ba1330bb34169eb884b1571b5f48e6542 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Fri, 25 Apr 2025 06:02:50 +0100 Subject: [PATCH 096/137] Remove printing --- src/fortran/lib/mod_geom_utils.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 329e6fb..1adbce8 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -1024,7 +1024,7 @@ subroutine primitive_lat(basis) !!--------------------------------------------------------------- !! makes all lattice vectors unity !!--------------------------------------------------------------- - call reducer(basis,ltmp = .true.) + call reducer(basis) lat = basis%lat plat = lat do i=1,3 From 77bba65b991c153c38bfc3953d2bc3731ec5a6f0 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Fri, 25 Apr 2025 06:42:04 +0100 Subject: [PATCH 097/137] Fix lattice matching zero area --- src/fortran/lib/mod_plane_matching.f90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/fortran/lib/mod_plane_matching.f90 b/src/fortran/lib/mod_plane_matching.f90 index 8870bbe..41d4d9e 100644 --- a/src/fortran/lib/mod_plane_matching.f90 +++ b/src/fortran/lib/mod_plane_matching.f90 @@ -6,7 +6,7 @@ module plane_matching use artemis__constants, only: real32, INF, pi use misc_linalg, only: cross,modu,get_angle,get_area,find_tf,& - reduce_vec_gcd,gcd, inverse_2x2, find_tf_2x2 + reduce_vec_gcd,gcd, inverse_2x2, find_tf_2x2, uvec use artemis__misc_types, only: tol_type implicit none !! importance of vector, angle, and area @@ -567,7 +567,7 @@ subroutine cell_match(& real(real32) :: reference_mag,considered_mag real(real32) :: reference_angle,considered_angle type(tol_type) :: tol - real(real32), dimension(3) :: lat1_veca,lat1_vecb,lat2_veca,lat2_vecb + real(real32), dimension(3) :: lat1_veca,lat1_vecb,lat2_veca,lat2_vecb, unit_vec real(real32), dimension(tol%maxfit) :: MAIN_LOOP_LIST_TOLERANCES !real(real32), dimension(:) :: MAIN_LOOP_LIST_TOLERANCES integer, dimension(2,6) :: tmpmat @@ -656,9 +656,9 @@ subroutine cell_match(& if (l.eq.0 .and. m.eq.0) cycle vecmakeloop2 pmloop2: do j=1,-1,-2 nvec1=nvec1+1 - numstore_1(nvec1,:) = (/ i*l, j*m /) + numstore_1(nvec1,:) = [ i*l, j*m ] latstore_1(nvec1,:) = real(i*l,real32) * lat1_veca + real(j*m,real32) * lat1_vecb - if(abs(modu(latstore_1(nvec1,:))).gt.tol%maxlen)then + if(abs(modu([latstore_1(nvec1,:)])).gt.tol%maxlen)then nvec1=nvec1-1 cycle pmloop1 end if @@ -710,6 +710,7 @@ subroutine cell_match(& total_list_count = 0 MAINLOOP1: do l=1,nvec1 tmpmat(1,:2) = numstore_1(l,:2) + unit_vec = uvec(real(numstore_1(l,:2), real32)) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -736,10 +737,11 @@ subroutine cell_match(& !!! lower lattice vector 2 loop !!!------------------------------------------------------------------------ MAINLOOP2: do m=1,nvec1 + if(all(abs(unit_vec-uvec(real(numstore_1(m,:2), real32))).lt.1.E-6_real32)) cycle MAINLOOP2 tmpmat(2,:2) = numstore_1(m,:2) if(all(latstore_1(l,:).eq.latstore_1(m,:))) cycle MAINLOOP2 if(get_area([latstore_1(l,:)],[latstore_1(m,:)]).gt.tol%maxarea) cycle MAINLOOP2 - if(all(cross([latstore_1(l,:)],[latstore_1(m,:)]).eq.0._real32)) cycle MAINLOOP2 + if(all(cross([latstore_1(l,:)],[latstore_1(m,:)]).lt.1.E-6_real32)) cycle MAINLOOP2 reference_angle = get_angle([latstore_1(l,:)],[latstore_1(m,:)]) if (abs(reference_angle) .lt. tiny) cycle MAINLOOP2 From 4a836a0dba04ba388932e3bb148fbb5e272764c1 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Fri, 25 Apr 2025 06:43:40 +0100 Subject: [PATCH 098/137] Fix lattice matching zero area --- src/fortran/lib/mod_plane_matching.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fortran/lib/mod_plane_matching.f90 b/src/fortran/lib/mod_plane_matching.f90 index 41d4d9e..3e6e66d 100644 --- a/src/fortran/lib/mod_plane_matching.f90 +++ b/src/fortran/lib/mod_plane_matching.f90 @@ -738,6 +738,7 @@ subroutine cell_match(& !!!------------------------------------------------------------------------ MAINLOOP2: do m=1,nvec1 if(all(abs(unit_vec-uvec(real(numstore_1(m,:2), real32))).lt.1.E-6_real32)) cycle MAINLOOP2 + if(all(abs(unit_vec+uvec(real(numstore_1(m,:2), real32))).lt.1.E-6_real32)) cycle MAINLOOP2 tmpmat(2,:2) = numstore_1(m,:2) if(all(latstore_1(l,:).eq.latstore_1(m,:))) cycle MAINLOOP2 if(get_area([latstore_1(l,:)],[latstore_1(m,:)]).gt.tol%maxarea) cycle MAINLOOP2 From 85986d93996cca92c1b24a28b9a3bd935efbfc33 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Fri, 25 Apr 2025 09:18:51 +0100 Subject: [PATCH 099/137] Fix file printing --- app/main.f90 | 17 ++++++++--------- src/fortran/lib/mod_generator.f90 | 4 +++- src/fortran/lib/mod_misc_types.f90 | 6 ++++++ 3 files changed, 17 insertions(+), 10 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index faa6e5b..02248e4 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -11,7 +11,7 @@ program artemis_executable integer :: i, j, unit - integer, dimension(:), allocatable :: match_idx_list, idx_list(:) + integer, dimension(:), allocatable :: match_and_term_idx_list, idx_list(:) character(len=256) :: filepath, filename type(artemis_generator_type) :: generator type(basis_type), allocatable, dimension(:) :: structures @@ -191,20 +191,19 @@ program artemis_executable else call generator%restart(struc1_bas) end if - allocate(match_idx_list(0)) + allocate(match_and_term_idx_list(0)) do i = 1, generator%num_structures write(filepath, '(A,"/",A,I0.2)') & trim(adjustl(dirname)), & trim(adjustl(subdir_prefix)), & - generator%structure_data(i)%match_idx - if(all(generator%structure_data(1:i-1:1)%match_idx.ne.generator%structure_data(i)%match_idx))then + generator%structure_data(i)%match_and_term_idx + if(all(generator%structure_data(1:i-1:1)%match_and_term_idx.ne.generator%structure_data(i)%match_and_term_idx))then call system("mkdir -p " // trim(filepath)) call generator%write_match_and_term_data(i, & directory = trim(filepath), & filename = "struc_data.txt" & ) - else - match_idx_list = [ match_idx_list, generator%structure_data(i)%match_idx ] + match_and_term_idx_list = [ match_and_term_idx_list, generator%structure_data(i)%match_and_term_idx ] end if if(generator%structure_data(i)%shift_idx.gt.0)then write(filepath, '(A,"/",A,"/",A,I0.2)') & @@ -227,14 +226,14 @@ program artemis_executable end do ! get all indices with the same match_idx ! write the shift data associated with all of them - do i = 1, size(match_idx_list) + do i = 1, size(match_and_term_idx_list) idx_list = pack([(j, j=1, generator%num_structures)], & - generator%structure_data(:)%match_idx .eq. match_idx_list(i) ) + generator%structure_data(:)%match_and_term_idx .eq. match_and_term_idx_list(i) ) if(size(idx_list).eq.0) cycle write(filepath, '(A,"/",A,I0.2,"/",A)') & trim(dirname), & trim(subdir_prefix), & - generator%structure_data(idx_list(1))%match_idx, & + generator%structure_data(idx_list(1))%match_and_term_idx, & trim(shiftdir) call generator%write_shift_data(idx_list, & directory = trim(filepath), & diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 747a6a0..52848ac 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -2089,6 +2089,7 @@ subroutine generate_interfaces( & ! this%use_pricel_lw, this%use_pricel_up) struc_data = struc_data_type( & match_idx = ifit, & + match_and_term_idx = iunique, & from_pricel_lw = this%use_pricel_lw, & from_pricel_up = this%use_pricel_up, & term_lw_idx = [iterm_lw,max(surface_lw_(2),iterm_lw)], & @@ -2388,6 +2389,7 @@ subroutine write_match_and_term_data(this, idx, directory, filename) write(unit,'("Lower material primitive cell used: ",L1)') struc_data%from_pricel_lw write(unit,'("Upper material primitive cell used: ",L1)') struc_data%from_pricel_up write(unit,*) + write(unit,'("Match and termination identifier: ",I0)') struc_data%match_and_term_idx write(unit,'("Lattice match: ",I0)') struc_data%match_idx write(unit,'((1X,3(3X,A1),3X,3(3X,A1)),3(/,2X,3(I3," "),3X,3(I3," ")))') & "a", "b", "c", "a", "b", "c", & @@ -2455,7 +2457,7 @@ subroutine write_shift_data(this, idx_list, directory, filename) '("# shift_num shift (a,b,c) units=(direct,direct,Å)")') do i = 1, size(idx_list), 1 write(unit,'(2X,I0.2,15X,"(",2(" ",F9.6,", ")," ",F9.6," )")') & - idx_list(i), this%structure_data(idx_list(i))%shift + i, this%structure_data(idx_list(i))%shift end do close(unit) diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 16ec443..6ae8848 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -17,6 +17,7 @@ module artemis__misc_types type struc_data_type integer :: match_idx = 0 + integer :: match_and_term_idx = 0 integer :: shift_idx = 0 integer :: swap_idx = 0 logical :: from_pricel_lw = .false. @@ -42,6 +43,7 @@ module artemis__misc_types interface struc_data_type module function init_struc_data_type( & match_idx, & + match_and_term_idx, & from_pricel_lw, from_pricel_up, & term_lw_idx, term_up_idx, & term_lw_bounds, term_up_bounds, & @@ -53,6 +55,7 @@ module function init_struc_data_type( & swap_idx, swap_density, approx_eff_swap_conc & ) result(output) integer, intent(in) :: match_idx + integer, intent(in) :: match_and_term_idx logical, intent(in) :: from_pricel_lw, from_pricel_up integer, dimension(2), intent(in) :: term_lw_idx, term_up_idx real(real32), dimension(4), intent(in) :: term_lw_bounds, term_up_bounds @@ -120,6 +123,7 @@ end function init_struc_data_type !############################################################################### module function init_struc_data_type( & match_idx, & + match_and_term_idx, & from_pricel_lw, from_pricel_up, & term_lw_idx, term_up_idx, & term_lw_bounds, term_up_bounds, & @@ -132,6 +136,7 @@ module function init_struc_data_type( & ) result(output) implicit none integer, intent(in) :: match_idx + integer, intent(in) :: match_and_term_idx logical, intent(in) :: from_pricel_lw, from_pricel_up integer, dimension(2), intent(in) :: term_lw_idx, term_up_idx real(real32), dimension(4), intent(in) :: term_lw_bounds, term_up_bounds @@ -148,6 +153,7 @@ module function init_struc_data_type( & type(struc_data_type) :: output output%match_idx = match_idx + output%match_and_term_idx = match_and_term_idx output%from_pricel_lw = from_pricel_lw output%from_pricel_up = from_pricel_up output%term_lw_idx = term_lw_idx From aded5d73165aaebc3e0109f7a5f530daba437536 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 07:52:03 +0100 Subject: [PATCH 100/137] Improve lattice match handling --- src/fortran/lib/mod_geom_utils.f90 | 1 + src/fortran/lib/mod_lat_compare.f90 | 4 ++-- src/fortran/lib/mod_plane_matching.f90 | 10 ++++------ 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 1adbce8..bf03020 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -1396,6 +1396,7 @@ function planecutter(lat, plane) result(tfmat) lat_ = lat invlat = inverse(lat_) reclat = transpose(invlat) + if(all(plane_.le.0._real32)) plane_ = -plane_ plane_ = reduce_vec_gcd(plane_) order = [ 1, 2, 3 ] diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index a41d13a..fb6323b 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -936,7 +936,7 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- ivtmp1=0 itmp1=0 - if(any(miller_lw.gt.0))then + if(any(miller_lw.ne.0))then allocate(miller1(1,size(miller_lw))) miller1(1,:3)=miller_lw(:3) else @@ -974,7 +974,7 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- itmp1 = 0 ivtmp1 = 0 - if(any(miller_up.gt.0))then + if(any(miller_up.ne.0))then allocate(miller2(1,size(miller_up))) miller2(1,:3)=miller_up(:3) else diff --git a/src/fortran/lib/mod_plane_matching.f90 b/src/fortran/lib/mod_plane_matching.f90 index 3e6e66d..b7444c9 100644 --- a/src/fortran/lib/mod_plane_matching.f90 +++ b/src/fortran/lib/mod_plane_matching.f90 @@ -273,10 +273,10 @@ function is_unique(miller,sym) result(outval) end do signloop1 symloop1: do i=1,size(sym,dim=3) - vec_out=matmul(vec_in,sym(:3,:3,i)) + vec_out = matmul(vec_in,sym(:3,:3,i)) if(all(abs(vec_out-vec_in).lt.tol)) cycle symloop1 - vec_tmp1(:)=abs(vec_in(:))-abs(vec_out(:)) - vec_tmp2(:)=vec_in(:)-vec_out(:) + vec_tmp1(:) = abs(vec_in(:))-abs(vec_out(:)) + vec_tmp2(:) = vec_in(:)-vec_out(:) symloop2: do j=1,3 if(vec_tmp1(j).gt.tol.or.& (abs(vec_tmp1(j)).lt.tol.and.vec_tmp2(j).lt.-tol))then @@ -288,8 +288,6 @@ function is_unique(miller,sym) result(outval) end do symloop2 end do symloop1 - - end function is_unique !!!############################################################################# @@ -690,7 +688,7 @@ subroutine cell_match(& latstore_2(nvec2,:) = real(i*l,real32) * lat2_veca + real(j*m,real32) * lat2_vecb if(modu(latstore_2(nvec2,:)).gt.tol%maxlen)then nvec2=nvec2-1 - cycle vecmakeloop3 + cycle pmloop3 end if end do pmloop4 end do vecmakeloop4 From a27fc83dc7b0e013c63c735926b246aabd5cd1cf Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 08:48:34 +0100 Subject: [PATCH 101/137] Update symmetry operation generation --- src/fortran/lib/mod_sym.f90 | 429 +++++++++++++++++++++------ src/fortran/lib/mod_terminations.f90 | 8 +- 2 files changed, 349 insertions(+), 88 deletions(-) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 850f6db..849391d 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -20,7 +20,7 @@ module artemis__sym use artemis__constants, only: real32, pi use artemis__misc, only: sort2D - use misc_linalg, only: modu,inverse_3x3,det,gcd,gen_group,cross + use misc_linalg, only: modu,inverse_3x3,det,gcd,gen_group,cross,uvec use artemis__geom_rw, only: basis_type use artemis__geom_utils, only: reducer, primitive_lat implicit none @@ -108,7 +108,6 @@ subroutine sym_setup(grp,lat,predefined,new_start,tol_sym) real(real32), optional, intent(in) :: tol_sym - real(real32) :: tol_sym_ logical :: predefined_, new_start_ @@ -122,7 +121,7 @@ subroutine sym_setup(grp,lat,predefined,new_start,tol_sym) end if end if - predefined_ = .false. + predefined_ = .true. if(present(predefined)) predefined_ = predefined if(predefined_)then call gen_fundam_sym_matrices(grp, lat, tol_sym_) @@ -604,19 +603,25 @@ end subroutine gldfnd !!!############################################################################# -!!!############################################################################# -!!! builds an array of the symmetries that apply to the supplied lattice -!!!############################################################################# +!############################################################################### subroutine gen_fundam_sym_matrices(grp, lat, tol_sym) + !! Generate fundamental symmetry matrices for the 3D space groups implicit none + + ! Arguments type(sym_type), intent(inout) :: grp + !! Instance of the symmetry container real(real32), dimension(3,3), intent(in) :: lat + !! The lattice matrix real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry operations - integer :: i + ! Local variables + integer :: i, count, old_count, jsym real(real32) :: cosPi3,sinPi3,mcosPi3,msinPi3 real(real32), dimension(3,3) :: inversion,invlat,tmat1 real(real32), dimension(3,3,64) :: fundam_mat + real(real32), dimension(3,3,128) :: tmp_store cosPi3 = 0.5_real32 @@ -765,49 +770,61 @@ subroutine gen_fundam_sym_matrices(grp, lat, tol_sym) grp%nsym=0 invlat=inverse_3x3(lat) + old_count = 0 + count = 0 do i = 1, 64, 1 - tmat1=matmul(lat,fundam_mat(:3,:3,i)) - tmat1=matmul(tmat1,(invlat)) - !! ensure that the matrix preserves size of 1 - !! this is likely redundant - if(abs(abs(det(tmat1))-1._real32).gt.tol_sym) cycle - if(all(abs(tmat1-nint(tmat1)).le.tol_sym))then - grp%nsym=grp%nsym+1 - fundam_mat(:,:,grp%nsym)=fundam_mat(:,:,i) + call add_sym(grp, fundam_mat(:3,:3,i), lat, invlat, tol_sym, tmp_store, count) + if(old_count.ne.count) then + same_check1: do jsym = 1, count-1, 1 + if(all(abs(tmp_store(:3,:3,count)-tmp_store(:3,:3,jsym)).lt.tol_sym))then + count = count - 1 + exit same_check1 + end if + end do same_check1 + end if + old_count = count + call add_sym_tf(grp, fundam_mat(:3,:3,i), lat, invlat, tol_sym, tmp_store, count) + if(old_count.ne.count) then + same_check2: do jsym = 1, count-1, 1 + if(all(abs(tmp_store(:3,:3,count)-tmp_store(:3,:3,jsym)).lt.tol_sym))then + count = count - 1 + exit same_check2 + end if + end do same_check2 end if + old_count = count end do - allocate(grp%sym(4,4,grp%nsym)) - grp%sym(:,:,:) = 0._real32 + grp%nsym = count + allocate(grp%sym(4,4,grp%nsym), source = 0._real32) grp%sym(4,4,:) = 1._real32 - grp%sym(:3,:3,:grp%nsym) = fundam_mat(:3,:3,:grp%nsym) + grp%sym(:3,:3,:grp%nsym) = tmp_store(:3,:3,:grp%nsym) grp%nlatsym=grp%nsym - - !! REDUCE THIS SET BY DOING LTL^-1 AND JUST CHECK IF ANY BECOME NON-ZERO - !! IF ONE DOES, SCRAP IT - !! IF ONE DOESN'T, SAVE THE ORIGINAL (NOT THE NEWLY CREATED ONE) - - end subroutine gen_fundam_sym_matrices -!!!############################################################################# +!############################################################################### -!!!############################################################################# -!!! builds an array of the symmetries that apply to the supplied lattice -!!!############################################################################# - subroutine mksym(grp, inlat, tol_sym) +!############################################################################### + subroutine mksym(grp, lat, tol_sym) + !! Generate the symmetry operations for a given lattice implicit none + + ! Arguments type(sym_type), intent(inout) :: grp - real(real32), dimension(3,3), intent(in) :: inlat + !! Instance of the symmetry container + real(real32), dimension(3,3), intent(in) :: lat + !! Lattice matrix real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry operations + ! Local variables integer :: amin,bmin,cmin - integer :: i,j,ia,ib,ic,n,count,irot,nrot,isym,jsym + integer :: i,j,ia,ib,ic,n,count,irot,nrot,isym,jsym, old_count real(real32) :: tht,a,b,c - real(real32), dimension(3,3) :: rotmat,refmat,lat,invlat,tmat1 - real(real32), allocatable, dimension(:,:,:) :: tsym1,tsym2 + real(real32), dimension(3,3) :: rotmat,refmat,invlat,tmat1 + real(real32), allocatable, dimension(:,:,:) :: tsym1,tmp_store logical, dimension(3) :: laxis @@ -818,18 +835,6 @@ subroutine mksym(grp, inlat, tol_sym) end if -!!!----------------------------------------------------------------------------- -!!! set up inverse lattice -!!!----------------------------------------------------------------------------- - lat = inlat - if(grp%lmolec)then - invlat = 0._real32 - lat = 0._real32 - else - invlat = inverse_3x3(lat) - end if - - !!!----------------------------------------------------------------------------- !!! initialise values and symmetry matrix !!!----------------------------------------------------------------------------- @@ -948,69 +953,325 @@ subroutine mksym(grp, inlat, tol_sym) grp%sym(:,:,:grp%nsym)=tsym1(:,:,:grp%nsym) deallocate(tsym1) return + else + invlat = inverse_3x3(lat) end if - !! best so far - ! sym(1:3,1:3,isym)=matmul(transpose(lat),sym(1:3,1:3,isym)) - ! sym(1:3,1:3,isym)=matmul(sym(1:3,1:3,isym),(invlat)) !!!----------------------------------------------------------------------------- !!! checks all made symmetries to see if they apply to the supplied lattice !!!----------------------------------------------------------------------------- - allocate(tsym2(4,4,grp%nsym)) - tsym2 = 0._real32 - tsym2(4,4,:) = 1._real32 + allocate(tmp_store(3,3,grp%nsym)) count = 0 - samecheck: do isym = 1, grp%nsym - tmat1 = matmul((invlat),tsym1(:3,:3,isym)) - tmat1 = matmul(tmat1,(lat)) - do i = 1, 3 - do j = 1, 3 - if(abs(tmat1(i,j)).lt.tol_sym) tmat1(i,j) = 0._real32 - if(abs(1._real32-abs(tmat1(i,j))).lt.tol_sym) & - tmat1(i,j) = sign(1._real32,tmat1(i,j)) - end do - end do - !!----------------------------------------------------------------------- - !! Precautionary measure - if(all(abs(tmat1).lt.tol_sym)) cycle samecheck - if(abs(abs(det(tmat1))-1._real32).gt.tol_sym) cycle samecheck - !!----------------------------------------------------------------------- - if(.not.all(abs(tmat1-nint(tmat1)).lt.tol_sym)) cycle samecheck - do jsym = 1, count, 1 - if(all(abs(tmat1-tsym2(:3,:3,jsym)).lt.tol_sym)) cycle samecheck - end do - count = count + 1 - tsym2(:3,:3,count) = tmat1 - end do samecheck + do i = 1, grp%nsym, 1 + call add_sym_tf(grp, tsym1(:3,:3,i), lat, invlat, tol_sym, tmp_store, count) + if(old_count.ne.count) then + same_check2: do jsym = 1, count-1, 1 + if(all(abs(tmp_store(:3,:3,count)-tmp_store(:3,:3,jsym)).lt.tol_sym))then + count = count - 1 + exit same_check2 + end if + end do same_check2 + end if + old_count = count + end do + grp%nsym = count deallocate(tsym1) - allocate(grp%sym(4,4,grp%nsym)) - grp%sym(:4,:4,:grp%nsym)=tsym2(:4,:4,:grp%nsym) - deallocate(tsym2) + allocate(grp%sym(4,4,grp%nsym), source = 0._real32) + grp%sym(4,4,:) = 1._real32 + grp%sym(:3,:3,:grp%nsym)=tmp_store(:3,:3,:grp%nsym) + deallocate(tmp_store) grp%nlatsym = grp%nsym + + end subroutine mksym +!############################################################################### - return - end subroutine mksym -!!!############################################################################# +!############################################################################### + subroutine generate_all_symmetries(grp, lat, tol_sym) + !! Generate all possible symmetry operations for a given lattice + implicit none + ! Arguments + type(sym_type), intent(inout) :: grp + !! Instance of the symmetry container + real(real32), dimension(3,3), intent(in) :: lat + !! Lattice matrix + real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry operations + + ! Local variables + integer :: i, j, k, count, n + !! Counters + real(real32) :: tht, angle + !! Angle for rotation + real(real32), dimension(3,3) :: invlat + !! Inverse lattice matrix + real(real32), dimension(3,3) :: smat, mirror, ident + !! Symmetry matrices + real(real32), allocatable :: symm_matrices(:,:,:) + !! Symmetry matrices array + real(real32), dimension(3) :: axis + !! Axis of rotation + + + allocate(symm_matrices(3,3,20000)) + count = 0 -!!!############################################################################# -!!! clone ingrp to outgrp -!!!############################################################################# + ident = 0._real32 + ident(1,1) = 1._real32; ident(2,2) = 1._real32; ident(3,3) = 1._real32 + invlat = inverse_3x3(lat) + + ! Off-axis mirrors (diagonal planes) + smat = ident + smat(1,1) = 0._real32; smat(1,2) = 1._real32; + smat(2,1) = 1._real32; smat(2,2) = 0._real32 + smat(3,3) = 1._real32 + call add_sym(grp, smat, lat, invlat, tol_sym, symm_matrices, count) + smat = ident + smat(1,1) = 0._real32; smat(1,2) = -1._real32 + smat(2,1) = -1._real32; smat(2,2) = 0._real32 + smat(3,3) = 1._real32 + call add_sym(grp, smat, lat, invlat, tol_sym, symm_matrices, count) + + ! Rotations around x, y, z axes (common n-fold: 2, 3, 4, 6) + do j = 1, 8 + mirror = ident + if(j.gt.5) then + mirror = -ident + mirror(j-5,j-5) = 1._real32 + elseif(j.gt.2) then + mirror(j-2,j-2) = -1._real32 + elseif(j.eq.2)then + mirror = -ident + end if + + do i = 1, 3 + do n = 1, 10 + if(n.gt.6)then + angle = -2._real32*pi/real(n-4, real32) !=2*pi/(n-4) + else + angle = 2._real32*pi/real(n, real32) !=2*pi/n + end if + smat = rotation_matrix(i, angle) + smat = matmul(smat, mirror) + call add_sym(grp, smat, lat, invlat, tol_sym, symm_matrices, count) + end do + end do + + ! Rotations around body diagonals (e.g. [111], [110]) + do i = 1, 11 + axis = uvec([1._real32, 1._real32, 1._real32]) + if(i.eq.11)then + axis = -axis + elseif(i.gt.7) then + axis = -axis + axis(i-7) = 1._real32 + elseif(i.gt.4)then + axis(i-4) = -1._real32 + elseif(i.gt.1) then + axis(i-1) = 0._real32 + end if + do n = 1, 10 + if(n.gt.6)then + angle = -2._real32*pi/real(n-4, real32) !=2*pi/(n-4) + else + angle = 2._real32*pi/real(n, real32) !=2*pi/n + end if + smat = rotate_about_axis(axis, angle) + smat = matmul(smat, mirror) + call add_sym(grp, smat, lat, invlat, tol_sym, symm_matrices, count) + end do + end do + end do + + ! Trim to valid + grp%nsym = count + allocate(grp%sym(4,4,grp%nsym), source=0._real32) + grp%sym(:3,:3,:) = symm_matrices(:3,:3,1:count) + count = 0 + sym_check: do i = 1, grp%nsym + do j = 1, count, 1 + if(all(abs(grp%sym(:3,:3,i)-symm_matrices(:3,:3,j)).lt.tol_sym)) then + cycle sym_check + end if + end do + count = count + 1 + symm_matrices(1:3,1:3,count) = grp%sym(:3,:3,i) + end do sym_check + grp%nsym = count + deallocate(grp%sym) + allocate(grp%sym(4,4,grp%nsym), source=0._real32) + grp%sym(:3,:3,:) = symm_matrices(:3,:3,1:count) + grp%sym(4,4,:) = 1._real32 + deallocate(symm_matrices) + grp%nlatsym = grp%nsym + + contains + + function rotation_matrix(axis, angle) result(output) + implicit none + integer, intent(in) :: axis + real(real32), intent(in) :: angle + real(real32) :: output(3,3), c, s + c = cos(angle); s = sin(angle) + if (axis == 1) then + output = reshape([1._real32,0._real32,0._real32, 0._real32,c,s, 0._real32,-s,c], [3,3]) + elseif (axis == 2) then + output = reshape([c,0._real32,-s, 0._real32,1._real32,0._real32, s,0._real32,c], [3,3]) + else + output = reshape([c,s,0._real32, -s,c,0._real32, 0._real32,0._real32,1._real32], [3,3]) + end if + end function rotation_matrix + + function rotate_about_axis(ax, angle) result(output) + implicit none + real(real32), intent(in) :: ax(3), angle + real(real32) :: output(3,3), c, s, v + real(real32) :: x, y, z + x = ax(1); y = ax(2); z = ax(3) + c = cos(angle); s = sin(angle); v = 1 - c + output(1,1) = x*x*v + c + output(1,2) = x*y*v - z*s + output(1,3) = x*z*v + y*s + output(2,1) = y*x*v + z*s + output(2,2) = y*y*v + c + output(2,3) = y*z*v - x*s + output(3,1) = z*x*v - y*s + output(3,2) = z*y*v + x*s + output(3,3) = z*z*v + c + end function rotate_about_axis + + end subroutine generate_all_symmetries +!############################################################################### + + +!############################################################################### + subroutine add_sym(grp, mat, lat, invlat, tol_sym, store, count) + !! Add symmetry matrix to the store if valid + implicit none + + ! Arguments + type(sym_type), intent(in) :: grp + !! Instance of symmetry container + real(real32), dimension(3,3), intent(in) :: mat + !! Symmetry matrix + real(real32), dimension(3,3), intent(in) :: lat, invlat + !! Lattice and inverse lattice matrices + real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry check + real(real32), intent(inout) :: store(:,:,:) + !! Store for symmetry matrices + integer, intent(inout) :: count + !! Counter for number of valid symmetries + + if (is_valid_symmetry(grp, mat, tol_sym))then + count = count + 1 + store(:3,:3,count) = mat + end if + end subroutine add_sym +!------------------------------------------------------------------------------- + subroutine add_sym_tf(grp, mat, lat, invlat, tol_sym, store, count) + !! Add the coordinate transformed symmetry matrix to the store if valid + implicit none + + ! Arguments + type(sym_type), intent(in) :: grp + !! Instance of symmetry container + real(real32), dimension(3,3), intent(in) :: mat + !! Symmetry matrix + real(real32), dimension(3,3), intent(in) :: lat, invlat + !! Lattice and inverse lattice matrices + real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry check + real(real32), intent(inout) :: store(:,:,:) + !! Store for symmetry matrices + integer, intent(inout) :: count + !! Counter for number of valid symmetries + + ! Local variables + real(real32) :: t(3,3) + !! Transformed symmetry operation + + ! t = matmul(invlat, matmul(mat, lat)) + t = matmul(lat, matmul(mat, invlat)) + if (is_valid_symmetry(grp, t, tol_sym))then + count = count + 1 + store(:3,:3,count) = t + end if + end subroutine add_sym_tf +!------------------------------------------------------------------------------- + function is_valid_symmetry(grp, mat, tol_sym) result(output) + !! Check if the symmetry matrix is valid + implicit none + + ! Arguments + type(sym_type), intent(in) :: grp + !! Instance of symmetry container + real(real32), dimension(3,3), intent(in) :: mat + !! Symmetry matrix + real(real32), intent(in) :: tol_sym + !! Tolerance for symmetry check + logical :: output + !! Result of the symmetry check + + ! Local variables + integer :: i + !! Loop index + real(real32), dimension(3) :: compare_vec, input_vec + !! Vectors for comparison + + output = & + all(abs(mat - nint(mat)) .lt. tol_sym) .and. & + abs(abs(det(mat)) - 1._real32) .lt. tol_sym + + if(grp%lmolec) then + output = output .and. all(abs(mat) .lt. 1._real32 + tol_sym) + end if + do i = 1, 3 + if(grp%confine%lmirror)then + input_vec = mat(i,:) + else + input_vec = abs(mat(:,i)) + end if + if( ( grp%confine%l .and. grp%confine%laxis(i) ) .or. & + ( & + .not.grp%confine%l .and. & + grp%confine%lmirror .and. & + grp%confine%laxis(i) & + ) & + ) then + compare_vec = 0._real32 + compare_vec(i) = 1._real32 + output = output .and. & + all(abs(input_vec - compare_vec) .lt. tol_sym) + end if + end do + + end function is_valid_symmetry +!############################################################################### + + +!############################################################################### subroutine clone_grp(from, to) + !! Clone a symmetry group implicit none + + ! Arguments type(sym_type), intent(in) :: from + !! Source symmetry group type(sym_type), intent(out) :: to + !! Destination symmetry group if(allocated(from%op)) allocate(to%op(size(from%op))) if(allocated(from%sym)) allocate(to%sym(4,4,size(from%sym,dim=3))) - if(allocated(from%sym_save)) allocate(to%sym_save(4,4,size(from%sym_save,dim=3))) + if(allocated(from%sym_save)) & + allocate(to%sym_save(4,4,size(from%sym_save,dim=3))) to = from end subroutine clone_grp -!!!############################################################################# +!############################################################################### !!!############################################################################# diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 549245a..2648f92 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -24,8 +24,8 @@ module artemis__terminations !! Structure to hold termination information real(real32) :: hmin real(real32) :: hmax - integer :: natom - integer :: nstep + integer :: natom = 0 + integer :: nstep = 0 real(real32), allocatable, dimension(:) :: ladder end type term_type @@ -237,7 +237,7 @@ function get_termination_info( & call sym_setup( & grp_store, & basis%lat, & - predefined=.false., new_start=.true., & + predefined=.true., new_start=.true., & tol_sym=tol_sym & ) @@ -329,7 +329,7 @@ function get_termination_info( & call sym_setup( & grp_store_inv, & basis%lat, & - predefined=.false., new_start=.true., & + predefined=.true., new_start=.true., & tol_sym=tol_sym & ) itmp1 = count(abs(grp_store_inv%sym(3,3,:)+1._real32).lt.tol_sym) From 8e970237c3b022a5701511dd4e394e15de3763e3 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 08:48:46 +0100 Subject: [PATCH 102/137] Remove comments --- src/fortran/lib/mod_lat_compare.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index fb6323b..0b791c1 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -913,12 +913,12 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- !! finds and stores symmetry operations for each lattice !!-------------------------------------------------------------------------- - call sym_setup(grp1,lat1, tol_sym=tol_sym,new_start=.true.)!,predefined=.true.) + call sym_setup(grp1,lat1, tol_sym=tol_sym,new_start=.true.) call check_sym(grp1,structure_lw,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym1(3,3,grp1%nsym)) - call sym_setup(grp2,lat2, tol_sym=tol_sym,new_start=.true.)!,predefined=.true.) + call sym_setup(grp2,lat2, tol_sym=tol_sym,new_start=.true.) call check_sym(grp2,structure_up,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym2(3,3,grp2%nsym)) From 3118838ba4c137f8778365b44dc5f8dceab9a9b3 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 11:38:57 +0100 Subject: [PATCH 103/137] Improve inversion handling --- src/fortran/lib/mod_terminations.f90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 2648f92..60698dd 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -262,14 +262,15 @@ function get_termination_info( & end if end do if(itmp1.eq.0)then - call stop_program("No inversion symmetry found!") - exit_code = max(exit_code, 1) - return + ! call stop_program("No inversion symmetry found!") + ! exit_code = max(exit_code, 1) + ! return + else + do i = 1, grp_store%nsym + if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tol_sym)) & + grp_store%sym(4,:3,itmp1) = grp_store%sym(4,:3,i) + end do end if - do i = 1, grp_store%nsym - if(all(abs(grp_store%sym(:3,:3,i)-inv_mat).lt.tol_sym)) & - grp_store%sym(4,:3,itmp1) = grp_store%sym(4,:3,i) - end do From 98458001e84d7c691980b39090bfecf4b321cb94 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 12:27:27 +0100 Subject: [PATCH 104/137] Tidy up symmetry module --- src/fortran/lib/mod_generator.f90 | 4 +- src/fortran/lib/mod_geom_utils.f90 | 133 ++++++++++- src/fortran/lib/mod_lat_compare.f90 | 4 +- src/fortran/lib/mod_swapping.f90 | 6 +- src/fortran/lib/mod_sym.f90 | 328 ++++++--------------------- src/fortran/lib/mod_terminations.f90 | 16 +- 6 files changed, 217 insertions(+), 274 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 52848ac..dab9025 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -19,9 +19,9 @@ module artemis__generator use artemis__geom_utils, only: planecutter, primitive_lat, ortho_axis,& shift_region, set_vacuum, transformer, shifter, reducer, & get_min_bulk_bond, get_min_bond, get_shortest_bond, bond_type, & - share_strain, MATNORM, basis_stack, compare_stoichiometry - use artemis__sym, only: confine_type, gldfnd,& + share_strain, MATNORM, basis_stack, compare_stoichiometry, & get_primitive_cell + use artemis__sym, only: confine_type, gldfnd use artemis__terminations, only: get_termination_info, term_arr_type, & set_layer_tol, build_slab_supercell, cut_slab_to_height use swapping, only: rand_swapper diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index bf03020..5483be5 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -38,7 +38,8 @@ module artemis__geom_utils use artemis__constants, only: real32 use artemis__geom_rw, only: basis_type,geom_write - use artemis__misc, only: swap + use artemis__sym, only: confine_type, gldfnd, tol_sym_default + use artemis__misc, only: swap, sort2D use misc_linalg, only: cross,outer_product,cross_matrix,uvec,modu,& get_vol,det,inverse,inverse_3x3,LUinv,reduce_vec_gcd,get_vec_multiple,& proj,GramSchmidt,LLL_reduce @@ -1922,6 +1923,136 @@ end function split_bas !!!############################################################################# +!!!############################################################################# +!!! returns the primitive cell from a supercell +!!!############################################################################# + subroutine get_primitive_cell(basis, tol_sym) + implicit none + type(basis_type), intent(inout) :: basis + real(real32), intent(in), optional :: tol_sym + + integer :: is,ia,ja,i,j,k,itmp1 + integer :: ntrans,len + real(real32) :: scale,projection,dtmp1 + real(real32) :: tol_sym_ + type(confine_type) :: confine + real(real32), dimension(3,3) :: dmat1,invlat + real(real32), allocatable, dimension(:,:) :: trans,atom_store + + + + !!----------------------------------------------------------------------- + !! Allocate and initialise + !!----------------------------------------------------------------------- + tol_sym_ = tol_sym_default + if(present(tol_sym)) tol_sym_ = tol_sym + ntrans = 0 + dmat1=0._real32 + allocate(trans(minval(basis%spec(:)%num+2),3)); trans=0._real32 + + + !!----------------------------------------------------------------------- + !! Find the translation vectors in the cell + !!----------------------------------------------------------------------- + call gldfnd(confine,basis,basis,trans,ntrans,tol_sym,.false.) + len=size(basis%spec(1)%atom,dim=2) + + + !!----------------------------------------------------------------------- + !! For each translation, reduce the basis + !!----------------------------------------------------------------------- + if(ntrans.ge.1)then + do i=ntrans+1,ntrans+3 + trans(i,:)=0._real32 + trans(i,i-ntrans)=1._real32 + end do + ! trans=matmul(trans(1:ntrans,1:3),basis%lat) + call sort2D( [ trans(1:ntrans+3,:) ] ,ntrans+3) + !! for each lattice vector, determine the shortest translation ... + !! ... vector that has a non-zero projection along that lattice vector. + do i=1,3 + projection=1.E2_real32 + trans_loop: do j=1,ntrans+3 + dtmp1 = dot_product(trans(j,:),trans(ntrans+i,:)) + if(dtmp1.lt.tol_sym) cycle trans_loop + + do k=1,i-1,1 + if(modu(abs(cross( [ trans(j,:) ], [ dmat1(k,:) ]))).lt.1.E-8_real32) cycle trans_loop + end do + + dtmp1 = modu( [ trans(j,:) ] ) + if(dtmp1.lt.projection)then + projection=dtmp1 + dmat1(i,:) = trans(j,:) + trans(j,:) = 0._real32 + end if + end do trans_loop + end do + !dmat1=trans(1:3,1:3) + scale=det(dmat1) + dmat1=matmul(dmat1,basis%lat) + invlat=inverse_3x3(dmat1) + do is=1,basis%nspec + itmp1=0 + allocate(atom_store(nint(scale*basis%spec(is)%num),len)) + atcheck: do ia=1,basis%spec(is)%num + !!----------------------------------------------------------------- + !! Reduce the basis + !!----------------------------------------------------------------- + basis%spec(is)%atom(ia,1:3)=& + matmul(basis%spec(is)%atom(ia,1:3),basis%lat(1:3,1:3)) + basis%spec(is)%atom(ia,1:3)=& + matmul(transpose(invlat(1:3,1:3)),basis%spec(is)%atom(ia,1:3)) + do j=1,3 + basis%spec(is)%atom(ia,j)=& + basis%spec(is)%atom(ia,j)-floor(basis%spec(is)%atom(ia,j)) + if(basis%spec(is)%atom(ia,j).gt.1._real32-tol_sym) & + basis%spec(is)%atom(ia,j)=0._real32 + end do + !!----------------------------------------------------------------- + !! Check for duplicates in the cell + !!----------------------------------------------------------------- + do ja=1, itmp1 + if(all(abs(basis%spec(is)%atom(ia,1:3)-atom_store(ja,1:3)).lt.& + [ tol_sym,tol_sym,tol_sym ])) cycle atcheck + end do + itmp1=itmp1+1 + atom_store(itmp1,:)=basis%spec(is)%atom(ia,:) + !!----------------------------------------------------------------- + !! Check to ensure correct number of atoms remain after reduction + !!----------------------------------------------------------------- + if(itmp1.gt.size(atom_store,dim=1))then + write(0,*) "ERROR! Primitive cell subroutine retained too & + &many atoms from supercell!", itmp1, size(atom_store,dim=1) + call exit() + end if + !!----------------------------------------------------------------- + end do atcheck + deallocate(basis%spec(is)%atom) + call move_alloc(atom_store,basis%spec(is)%atom) + basis%spec(is)%num=size(basis%spec(is)%atom,dim=1) + !deallocate(atom_store) + end do + !!----------------------------------------------------------------------- + !! Reduce the lattice + !!----------------------------------------------------------------------- + basis%natom=sum(basis%spec(:)%num) + basis%lat=dmat1 + end if + + + !!----------------------------------------------------------------------- + !! Reduce the lattice to symmetry definition + !!----------------------------------------------------------------------- + !! next line necessary as FCC and BCC do not conform to Niggli reduced ... + !! ... cell definitions. + call primitive_lat(basis) + + + + end subroutine get_primitive_cell +!!!############################################################################# + !!!############################################################################# !!! returns the bulk basis and lattice of !!!############################################################################# diff --git a/src/fortran/lib/mod_lat_compare.f90 b/src/fortran/lib/mod_lat_compare.f90 index 0b791c1..6153635 100644 --- a/src/fortran/lib/mod_lat_compare.f90 +++ b/src/fortran/lib/mod_lat_compare.f90 @@ -913,12 +913,12 @@ subroutine lattice_matching( & !!-------------------------------------------------------------------------- !! finds and stores symmetry operations for each lattice !!-------------------------------------------------------------------------- - call sym_setup(grp1,lat1, tol_sym=tol_sym,new_start=.true.) + call grp1%init(lat1, tol_sym=tol_sym,new_start=.true.) call check_sym(grp1,structure_lw,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym1(3,3,grp1%nsym)) - call sym_setup(grp2,lat2, tol_sym=tol_sym,new_start=.true.) + call grp2%init(lat2, tol_sym=tol_sym,new_start=.true.) call check_sym(grp2,structure_up,lsave=.true.,tol_sym=tol_sym) allocate(tmpsym2(3,3,grp2%nsym)) diff --git a/src/fortran/lib/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 index df69b80..81550ff 100644 --- a/src/fortran/lib/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -9,7 +9,7 @@ module swapping use misc_maths, only: gauss use misc_linalg, only: modu use artemis__geom_rw, only: basis_type - use artemis__sym, only: sym_setup,check_sym,sym_type,basis_map_type,basis_map + use artemis__sym, only: check_sym,sym_type,basis_map_type,basis_map use artemis__io_utils, only: err_abort implicit none real(real32) :: tiny=5.E-5_real32 @@ -122,7 +122,7 @@ function rand_swapper(lat,bas,axis,width,nswaps_per_cell,nswap,intf_loc,& !!!----------------------------------------------------------------------------- !!! set up symmetries !!!----------------------------------------------------------------------------- - call sym_setup(grp,lat, tol_sym = tol_sym) + call grp%init(lat, tol_sym = tol_sym) call tmpbas%copy(bas, length = 4) call store_bas%copy(tmpbas, length = 4) @@ -186,7 +186,7 @@ & Error in rand_swapper subroutine in mod_swapper.f90\n& end if 10 deallocate(grp%sym) - call sym_setup(grp,lat,new_start=.true., tol_sym = tol_sym) + call grp%init(lat,new_start=.true., tol_sym = tol_sym) call check_sym(grp,tmpbas, tol_sym=tol_sym)!,lsave=.true.) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index 849391d..f58b671 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -5,25 +5,34 @@ !!!############################################################################# !!!module contains symmetry-related functions and subroutines. !!!module includes the following functions and subroutines: -!!! sym_setup (calls mksym and allocates unallocated symmetry arrays) !!! check_sym (checks supplied symmetries against supplied basis or ... !!! ... checks whether the two supplied bases match after ... !!! ... applying symmetries) !!! gldfnd (output translations that maps two bases) !!! mksym (makes array of symmetries that apply to supplied lattice -!!! clone_grp (clones ingrp to outgrp) -!!! symwrite (output human-readable supplied transformation matrix) !!! basis_map (finds symmetry equivalent atoms in two bases based on ... !!! ... the supplied transformation matrix) -!!! setup_ladder (sets up rungs of the layer ladder) !!!############################################################################# module artemis__sym use artemis__constants, only: real32, pi - use artemis__misc, only: sort2D - use misc_linalg, only: modu,inverse_3x3,det,gcd,gen_group,cross,uvec + use misc_linalg, only: modu, inverse_3x3, det, uvec use artemis__geom_rw, only: basis_type - use artemis__geom_utils, only: reducer, primitive_lat implicit none + + + private + + + public :: tol_sym_default + public :: sym_type + public :: check_sym, gldfnd + + public :: confine_type + + public :: basis_map_type, basis_map + + + real(real32) :: tol_sym_default = 1.E-6_real32 integer, allocatable, dimension(:) :: symops_compare @@ -32,9 +41,6 @@ module artemis__sym end interface get_wyckoff_atoms - private - - type spec_wyck_type integer :: num character(len=5) :: name @@ -77,31 +83,23 @@ module artemis__sym real(real32), allocatable, dimension(:,:,:) :: sym type(confine_type) :: confine real(real32), allocatable, dimension(:,:,:) :: sym_save + contains + procedure, pass(this) :: init => initialise_sym_type + procedure, pass(this) :: copy => copy_sym_type end type sym_type - public :: sym_type - public :: clone_grp - public :: sym_setup,check_sym,gldfnd - - public :: get_primitive_cell - - public :: confine_type - - public :: basis_map_type, basis_map - - -!!!updated 2023/02/14 contains -!!!############################################################################# -!!! calls mksym and allocates symops and wyckoff arrays -!!!############################################################################# - subroutine sym_setup(grp,lat,predefined,new_start,tol_sym) +!############################################################################### + subroutine initialise_sym_type(this,lat,predefined,new_start,tol_sym) + !! Initialises the symmetry container implicit none - type(sym_type), intent(inout) :: grp + + ! Arguments + class(sym_type), intent(inout) :: this real(real32), dimension(3,3), intent(in) :: lat logical, optional, intent(in) :: predefined logical, optional, intent(in) :: new_start @@ -116,30 +114,67 @@ subroutine sym_setup(grp,lat,predefined,new_start,tol_sym) if(present(tol_sym)) tol_sym_ = tol_sym if(present(new_start))then if(new_start)then - if(allocated(grp%op)) deallocate(grp%op) - if(allocated(grp%sym)) deallocate(grp%sym) + if(allocated(this%op)) deallocate(this%op) + if(allocated(this%sym)) deallocate(this%sym) end if end if predefined_ = .true. if(present(predefined)) predefined_ = predefined if(predefined_)then - call gen_fundam_sym_matrices(grp, lat, tol_sym_) + call gen_fundam_sym_matrices(this, lat, tol_sym_) else - call mksym(grp, lat, tol_sym_) + call mksym(this, lat, tol_sym_) end if if(allocated(symops_compare)) deallocate(symops_compare) - grp%nsymop=0 + this%nsymop=0 new_start_ = .true. if(present(new_start)) new_start_ = new_start - if(new_start_.or.grp%end_idx.eq.0)then - grp%end_idx = grp%nsym + if(new_start_.or.this%end_idx.eq.0)then + this%end_idx = this%nsym end if - end subroutine sym_setup -!!!############################################################################# + end subroutine initialise_sym_type +!############################################################################### + + +!############################################################################### + subroutine copy_sym_type(this, source) + !! Copy symmetry container + implicit none + + ! Arguments + class(sym_type), intent(inout) :: this + !! Destination symmetry group + type(sym_type), intent(in) :: source + !! Source symmetry group + + + if(allocated(this%op)) deallocate(this%op) + if(allocated(this%sym)) deallocate(this%sym) + if(allocated(this%sym_save)) deallocate(this%sym_save) + + this%nsym = source%nsym + this%nlatsym = source%nlatsym + this%nsymop = source%nsymop + this%npntop = source%npntop + this%lspace = source%lspace + this%lmolec = source%lmolec + this%start_idx = source%start_idx + this%end_idx = source%end_idx + this%confine = source%confine + + if(allocated(source%op)) & + allocate(this%op, source = source%op) + if(allocated(source%sym)) & + allocate(this%sym, source = source%sym) + if(allocated(source%sym_save)) & + allocate(this%sym_save, source = source%sym_save) + + end subroutine copy_sym_type +!############################################################################### !!!############################################################################# @@ -1250,229 +1285,8 @@ function is_valid_symmetry(grp, mat, tol_sym) result(output) end function is_valid_symmetry !############################################################################### - - -!############################################################################### - subroutine clone_grp(from, to) - !! Clone a symmetry group - implicit none - - ! Arguments - type(sym_type), intent(in) :: from - !! Source symmetry group - type(sym_type), intent(out) :: to - !! Destination symmetry group - - - if(allocated(from%op)) allocate(to%op(size(from%op))) - if(allocated(from%sym)) allocate(to%sym(4,4,size(from%sym,dim=3))) - if(allocated(from%sym_save)) & - allocate(to%sym_save(4,4,size(from%sym_save,dim=3))) - to = from - - end subroutine clone_grp -!############################################################################### -!!!############################################################################# -!!! returns the primitive cell from a supercell -!!!############################################################################# - subroutine get_primitive_cell(basis, tol_sym) - implicit none - type(basis_type), intent(inout) :: basis - real(real32), intent(in), optional :: tol_sym - - integer :: is,ia,ja,i,j,k,itmp1 - integer :: ntrans,len - real(real32) :: scale,proj,dtmp1 - real(real32) :: tol_sym_ - type(confine_type) :: confine - real(real32), dimension(3,3) :: dmat1,invlat - real(real32), allocatable, dimension(:,:) :: trans,atom_store - - - - !!----------------------------------------------------------------------- - !! Allocate and initialise - !!----------------------------------------------------------------------- - tol_sym_ = tol_sym_default - if(present(tol_sym)) tol_sym_ = tol_sym - ntrans = 0 - dmat1=0._real32 - allocate(trans(minval(basis%spec(:)%num+2),3)); trans=0._real32 - - - !!----------------------------------------------------------------------- - !! Find the translation vectors in the cell - !!----------------------------------------------------------------------- - call gldfnd(confine,basis,basis,trans,ntrans,tol_sym,.false.) - len=size(basis%spec(1)%atom,dim=2) - - - !!----------------------------------------------------------------------- - !! For each translation, reduce the basis - !!----------------------------------------------------------------------- - if(ntrans.ge.1)then - do i=ntrans+1,ntrans+3 - trans(i,:)=0._real32 - trans(i,i-ntrans)=1._real32 - end do - ! trans=matmul(trans(1:ntrans,1:3),basis%lat) - call sort2D( [ trans(1:ntrans+3,:) ] ,ntrans+3) - !! for each lattice vector, determine the shortest translation ... - !! ... vector that has a non-zero projection along that lattice vector. - do i=1,3 - proj=1.D2 - trans_loop: do j=1,ntrans+3 - dtmp1 = dot_product(trans(j,:),trans(ntrans+i,:)) - if(dtmp1.lt.tol_sym) cycle trans_loop - - do k=1,i-1,1 - if(modu(abs(cross( [ trans(j,:) ], [ dmat1(k,:) ]))).lt.1.E-8_real32) cycle trans_loop - end do - - dtmp1 = modu( [ trans(j,:) ] ) - if(dtmp1.lt.proj)then - proj=dtmp1 - dmat1(i,:) = trans(j,:) - trans(j,:) = 0._real32 - end if - end do trans_loop - end do - !dmat1=trans(1:3,1:3) - scale=det(dmat1) - dmat1=matmul(dmat1,basis%lat) - invlat=inverse_3x3(dmat1) - do is=1,basis%nspec - itmp1=0 - allocate(atom_store(nint(scale*basis%spec(is)%num),len)) - atcheck: do ia=1,basis%spec(is)%num - !!----------------------------------------------------------------- - !! Reduce the basis - !!----------------------------------------------------------------- - basis%spec(is)%atom(ia,1:3)=& - matmul(basis%spec(is)%atom(ia,1:3),basis%lat(1:3,1:3)) - basis%spec(is)%atom(ia,1:3)=& - matmul(transpose(invlat(1:3,1:3)),basis%spec(is)%atom(ia,1:3)) - do j=1,3 - basis%spec(is)%atom(ia,j)=& - basis%spec(is)%atom(ia,j)-floor(basis%spec(is)%atom(ia,j)) - if(basis%spec(is)%atom(ia,j).gt.1._real32-tol_sym) & - basis%spec(is)%atom(ia,j)=0._real32 - end do - !!----------------------------------------------------------------- - !! Check for duplicates in the cell - !!----------------------------------------------------------------- - do ja=1, itmp1 - if(all(abs(basis%spec(is)%atom(ia,1:3)-atom_store(ja,1:3)).lt.& - [ tol_sym,tol_sym,tol_sym ])) cycle atcheck - end do - itmp1=itmp1+1 - atom_store(itmp1,:)=basis%spec(is)%atom(ia,:) - !!----------------------------------------------------------------- - !! Check to ensure correct number of atoms remain after reduction - !!----------------------------------------------------------------- - if(itmp1.gt.size(atom_store,dim=1))then - write(0,*) "ERROR! Primitive cell subroutine retained too & - &many atoms from supercell!", itmp1, size(atom_store,dim=1) - call exit() - end if - !!----------------------------------------------------------------- - end do atcheck - deallocate(basis%spec(is)%atom) - call move_alloc(atom_store,basis%spec(is)%atom) - basis%spec(is)%num=size(basis%spec(is)%atom,dim=1) - !deallocate(atom_store) - end do - !!----------------------------------------------------------------------- - !! Reduce the lattice - !!----------------------------------------------------------------------- - basis%natom=sum(basis%spec(:)%num) - basis%lat=dmat1 - end if - - - !!----------------------------------------------------------------------- - !! Reduce the lattice to symmetry definition - !!----------------------------------------------------------------------- - !! next line necessary as FCC and BCC do not conform to Niggli reduced ... - !! ... cell definitions. - call primitive_lat(basis) - - - - end subroutine get_primitive_cell -!!!############################################################################# - - -!!!############################################################################# -!!! takes in transformation matrix and outputs its (x,y,z) definition -!!!############################################################################# - subroutine symwrite (sym,symchar) - implicit none - integer :: i,j,nt,nr,div - real(real32), dimension(4,4) :: sym - character(1024) :: symchar - character(2) :: rm,c - character(1), dimension(3) :: xyz - - xyz(1)="x";xyz(2)="y";xyz(3)="z" - symchar="" - do i=1,3 - select case (nint(100*sym(4,i))) - case(0) - case default - div=abs(gcd(nint(100*sym(4,i)),100)) - write(symchar,'(A,I0,"aa",I0)') trim(symchar),nint(100*sym(4,i))/div,100/div - end select - - do j=1,3 - select case (int(sym(j,i))) - case(0) - cycle - case(1) - c="" - case default - write(c,"(I2)") int(sym(j,i)) - end select - symchar=trim(symchar) //"+"//trim(adjustl(c(1:1)))//xyz(j) - end do - if(i.ne.3) symchar=trim(symchar) //"," - end do - - rm="+-" - nt=len_trim(symchar) ; nr=len_trim(symchar) - remove: do - i=index(symchar,trim(adjustl(rm))) - if(i.eq.0) exit remove - symchar = symchar(:i-1) //symchar(i+1:nt) - end do remove - - rm=",+" - nt=len_trim(symchar) ; nr=len_trim(symchar) - remove2: do - i=index(symchar,trim(adjustl(rm))) - if(i.eq.0) exit remove2 - symchar = symchar(:i) //symchar(i+2:nt) - end do remove2 - if(symchar(:1).eq."+") symchar=symchar(2:) - - rm="aa" - nt=len_trim(symchar) ; nr=len_trim(symchar) - remove3: do - i=index(symchar,trim(adjustl(rm))) - if(i.eq.0) exit remove3 - symchar = symchar(:i-1) //"/"//symchar(i+2:nt) - end do remove3 - - - symchar = "("//trim(adjustl(symchar))//")" - write(77,*) trim(adjustl(symchar)) - - end subroutine symwrite -!!!############################################################################# - - !!!############################################################################# !!! returns the wyckoff atoms of a basis (closest to a defined location) !!!############################################################################# diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 60698dd..8cd5d87 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -6,7 +6,7 @@ module artemis__terminations use artemis__io_utils, only: err_abort, stop_program use artemis__io_utils_extd, only: err_abort_print_struc use misc_linalg, only: modu, cross, uvec, det - use artemis__sym, only: sym_type, check_sym, sym_setup, clone_grp + use artemis__sym, only: sym_type, check_sym use artemis__geom_utils, only: shifter, transformer, ortho_axis, set_vacuum implicit none @@ -234,8 +234,7 @@ function get_termination_info( & grp_store%lspace = .true. grp_store%confine%l = .true. grp_store%confine%laxis(axis) = .true. - call sym_setup( & - grp_store, & + call grp_store%init( & basis%lat, & predefined=.true., new_start=.true., & tol_sym=tol_sym & @@ -293,7 +292,7 @@ function get_termination_info( & if(abs(abs(term_arr(i)%hmax-term_arr(i)%hmin) - & abs(term_arr_uniq(j)%hmax-term_arr_uniq(j)%hmin)).gt.tol_sym) & cycle sym_loop1 - call clone_grp(grp_store,grp1) + call grp1%copy(grp_store) call check_sym(grp1,basis=basis_arr(mterm),& iperm=-1,tmpbas2=basis_arr(j),lsave=.true.,tol_sym=tol_sym) if(grp1%nsymop.ne.0)then @@ -327,8 +326,7 @@ function get_termination_info( & grp_store_inv%lspace = .true. grp_store_inv%confine%l = .true. grp_store_inv%confine%laxis(axis) = .true. - call sym_setup( & - grp_store_inv, & + call grp_store_inv%init( & basis%lat, & predefined=.true., new_start=.true., & tol_sym=tol_sym & @@ -374,7 +372,7 @@ function get_termination_info( & do j = 1, i-1, 1 if(success(j).eq.itmp2)then grp_store%end_idx = grp_store%nsym - call clone_grp(grp_store,grp1) + call grp1%copy(grp_store) call check_sym(grp1,basis=basis_arr_reject(j),& iperm=-1,tmpbas2=basis_arr_reject(i),lsave=.true., & tol_sym=tol_sym & @@ -396,7 +394,7 @@ function get_termination_info( & lunique = .true. do k = 1, size(comparison_list) itmp2 = comparison_list(k) - call clone_grp(grp_store_inv,grp1) + call grp1%copy(grp_store_inv) call check_sym(grp1,basis_arr(itmp2),& iperm=-1,lsave=.true.,check_all_sym=.true., & tol_sym=tol_sym & @@ -410,7 +408,7 @@ function get_termination_info( & !! If they are not, then no point comparing. It is a new termination if(.not.ltmp1) cycle - call clone_grp(grp_store_inv,grp1) + call grp1%copy(grp_store_inv) call check_sym(grp1,basis_arr(itmp2),& tmpbas2=basis_arr_reject(i), & iperm=-1, & From 09145264c8fb9f831b67b8a5d1978cc70667af3a Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 12:27:32 +0100 Subject: [PATCH 105/137] Fix license --- src/fortran/lib/mod_io_utils.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/fortran/lib/mod_io_utils.F90 b/src/fortran/lib/mod_io_utils.F90 index 7371312..8518226 100644 --- a/src/fortran/lib/mod_io_utils.F90 +++ b/src/fortran/lib/mod_io_utils.F90 @@ -125,11 +125,10 @@ subroutine print_header(unit) write(unit,'(A)') " Artistic advisors:" write(unit,'(A)') " E. L. Martin" write(unit,*) - write(unit,'(A)') " LICENCE:" + write(unit,'(A)') " LICENSE:" write(unit,'(A)') " This work is licensed under a & - &Creative Commons Attribution-NonCommercial 3.0 & - &Unported (CC BY-NC 3.0) License." - write(unit,'(A)') " https://creativecommons.org/licenses/by-nc/3.0/" + &General Public License 3.0 (GPLv3)" + write(unit,'(A)') " https://www.gnu.org/licenses/gpl-3.0.en.html" write(unit,*) write(unit,'(A)') repeat("#",50) From 69b2c83818e0612a8eaee47233481a63f0530e68 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 13:33:22 +0100 Subject: [PATCH 106/137] Fix python project build --- .github/workflows/publish-to-test-pypi.yml | 236 +++++++++++++++++++++ .gitignore | 7 +- CMakeLists.txt | 8 +- pyproject.toml | 3 +- 4 files changed, 246 insertions(+), 8 deletions(-) create mode 100644 .github/workflows/publish-to-test-pypi.yml diff --git a/.github/workflows/publish-to-test-pypi.yml b/.github/workflows/publish-to-test-pypi.yml new file mode 100644 index 0000000..7ff4ccf --- /dev/null +++ b/.github/workflows/publish-to-test-pypi.yml @@ -0,0 +1,236 @@ +# Workflow developed from Python Package User Guide: +# https://packaging.python.org/en/latest/guides/publishing-package-distribution-releases-using-github-actions-ci-cd-workflows/ + +name: Publish Python 🐍 distribution 📦 to PyPI and TestPyPI + +on: + push: + branches: + - main + tags: + - v* + workflow_dispatch: + +jobs: + check-version-matches: + name: Check if version numbers match the GitHub tag + runs-on: ubuntu-latest + continue-on-error: ${{ github.event_name == 'workflow_dispatch' }} + steps: + - name: Checkout repository + uses: actions/checkout@v4 + + - name: Extract version from fpm.toml + id: fpm_version + run: echo "ARTEMIS_FPM_VERSION=$(awk -F'"' '/^version/ {print $2}' fpm.toml)" >> $GITHUB_ENV + + - name: Extract version from mod_io_utils.F90 + id: fortran_version + run: echo "ARTEMIS_FORTRAN_VERSION=$(awk -F'"' '/character\(len=\*\), parameter \:\:\ artemis__version__/ {print $2}' src/fortran/lib/mod_io_utils.F90)" >> $GITHUB_ENV + + - name: Extract GitHub tag version + id: github_tag + run: echo "TAG_VERSION=${GITHUB_REF#refs/tags/v}" >> "$GITHUB_ENV" + + - name: Verify version consistency + run: | + if [[ "$ARTEMIS_FPM_VERSION" != "$TAG_VERSION" ]]; then + echo "❌ Version mismatch: fpm.toml ($ARTEMIS_FPM_VERSION) does not match GitHub tag ($TAG_VERSION)" + exit 1 + fi + if [[ "$ARTEMIS_FORTRAN_VERSION" != "$TAG_VERSION" ]]; then + echo "❌ Version mismatch: mod_io_utils.F90 ($ARTEMIS_FORTRAN_VERSION) does not match GitHub tag ($TAG_VERSION)" + exit 1 + fi + echo "✅ Version numbers match!" + + build_wheel: + name: Build wheel distribution 📦 + runs-on: ${{ matrix.platform[0] }} + strategy: + fail-fast: false + matrix: + platform: + - [ubuntu-latest, manylinux, x86_64] + - [macos-14, macosx, arm64] + python-version: [ "3.12" ] # cibuildwheel automatically runs on all versions of Python + toolchain: + - {fortran-compiler: gcc, fc-version: 13} + needs: + - check-version-matches + + steps: + - name: checkout repo + uses: actions/checkout@v4 + + - name: Set MACOSX_DEPLOYMENT_TARGET + if: startsWith(matrix.platform[0], 'macos') + run: echo "MACOSX_DEPLOYMENT_TARGET=$(sw_vers -productVersion | cut -d '.' -f 1-2)" >> $GITHUB_ENV + + - name: Check macOS deployment target + if: startsWith(matrix.platform[0], 'macos') + run: echo "Deployment target version is ${{ env.MACOSX_DEPLOYMENT_TARGET }} / ${MACOSX_DEPLOYMENT_TARGET}" + + - name: actions-setup-python ${{ matrix.python-version }} + uses: actions/setup-python@v5 + with: + python-version: ${{ matrix.python-version }} + + - name: actions-setup-cmake + uses: jwlawson/actions-setup-cmake@v2.0.1 + with: + cmake-version: '3.24.x' + + - name: actions-setup-fortran + uses: fortran-lang/setup-fortran@v1 + id: setup-fortran + with: + compiler: ${{ matrix.toolchain.fortran-compiler }} + version: ${{ matrix.toolchain.fc-version }} + + - name: Install OpenMP runtime (Linux only) + if: runner.os == 'Linux' + run: sudo apt-get update && sudo apt-get install -y libgomp1 + + - name: Install OpenMP runtime (macOS only) + if: runner.os == 'macOS' + run: brew install libomp + + - name: Install python dependencies + run: | + python --version + python -m pip install pip-tools --user + python -m pip install build --user + python -m piptools compile -o requirements.txt pyproject.toml --all-build-deps + python -m pip install -r requirements.txt --user + python -m pip install cibuildwheel==2.22.0 --user + + - name: Build a binary wheel distribution + run: python -m cibuildwheel --output-dir wheelhouse + + - name: Store the distribution wheels + uses: actions/upload-artifact@v4 + with: + name: artemis_materials-wheels-${{ matrix.python-version }}-${{ matrix.platform[0] }}-${{ matrix.toolchain.fortran-compiler }}${{ matrix.toolchain.fc-version }} + path: ./wheelhouse/*.whl + + build_sdist: + name: Build wheel distribution 📦 + runs-on: ubuntu-latest + steps: + - name: checkout repo + uses: actions/checkout@v4 + + - name: Build sdist + run: pipx run build --sdist + + - name: Store the source distribution + uses: actions/upload-artifact@v4 + with: + name: artemis_materials-sdist + path: dist/*.tar.gz + + publish-to-pypi: + name: >- + Publish Python 🐍 distribution 📦 to PyPI + if: startsWith(github.ref, 'refs/tags/') # only publish to PyPI on tag pushes + needs: + - build_wheel + - build_sdist + runs-on: ubuntu-latest + environment: + name: pypi + url: https://pypi.org/p/artemis-materials + permissions: + id-token: write # IMPORTANT: mandatory for trusted publishing + + steps: + - name: Download all the dists + uses: actions/download-artifact@v4 + with: + pattern: artemis_materials-* + path: dist + merge-multiple: true + - name: Publish distribution 📦 to PyPI + uses: pypa/gh-action-pypi-publish@release/v1 + + # publish-to-testpypi: + # name: Publish Python 🐍 distribution 📦 to TestPyPI + # if: startsWith(github.ref, 'refs/tags/') # only publish to PyPI on tag pushes + # needs: + # - build_wheel + # - build_sdist + # runs-on: ubuntu-latest + + # environment: + # name: testpypi + # url: https://test.pypi.org/p/artemis-materials + + # permissions: + # id-token: write # IMPORTANT: mandatory for trusted publishing + + # steps: + # - name: Download all the dists + # uses: actions/download-artifact@v4 + # with: + # pattern: artemis_materials-* + # path: dist + # merge-multiple: true + # - name: Publish distribution 📦 to TestPyPI + # uses: pypa/gh-action-pypi-publish@release/v1 + # with: + # verbose: true + # repository-url: https://test.pypi.org/legacy/ + + github-release: + name: >- + Sign the Python 🐍 distribution 📦 with Sigstore + and upload them to GitHub Release + needs: + - publish-to-pypi + runs-on: ubuntu-latest + + permissions: + contents: write # IMPORTANT: mandatory for making GitHub Releases + id-token: write # IMPORTANT: mandatory for sigstore + + steps: + - name: Check if GitHub release already exists + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + run: | + if gh release view '${{ github.ref_name }}' --repo '${{ github.repository }}' > /dev/null 2>&1; then + echo "Release already exists for tag '${{ github.ref_name }}'. Skipping release creation." + exit 0 + fi + - name: Download all the dists + uses: actions/download-artifact@v4 + with: + pattern: artemis_materials-* + path: dist + merge-multiple: true + - name: Sign the dists with Sigstore + uses: sigstore/gh-action-sigstore-python@v3.0.0 + with: + inputs: >- + ./dist/*.tar.gz + ./dist/*.whl + - name: Create GitHub Release + env: + GITHUB_TOKEN: ${{ github.token }} + run: >- + gh release create + '${{ github.ref_name }}' + --repo '${{ github.repository }}' + --notes "" + - name: Upload artifact signatures to GitHub Release + env: + GITHUB_TOKEN: ${{ github.token }} + # Upload to GitHub Release using the `gh` CLI. + # `dist/` contains the built packages, and the + # sigstore-produced signatures and certificates. + run: >- + gh release upload + '${{ github.ref_name }}' dist/** + --repo '${{ github.repository }}' + diff --git a/.gitignore b/.gitignore index 7eca3c6..a2dd1ee 100644 --- a/.gitignore +++ b/.gitignore @@ -7,4 +7,9 @@ tests/*/*.txt tests/*/*.out tests/*/DINTERFACES tests/*/DTERMINATIONS -build/ \ No newline at end of file +build/ +dist/ +wheelhouse/ +*.egg-info/ +*.egg +*.pyc \ No newline at end of file diff --git a/CMakeLists.txt b/CMakeLists.txt index 3d4d1dc..616f07e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,11 +7,7 @@ set(CMAKE_BUILD_DIR ${CMAKE_CURRENT_BINARY_DIR} CACHE STRING "Select where to build the library." ) set(MODULE_DIR ${CMAKE_BUILD_DIR}/mod) -if (DEFINED SKBUILD_PROJECT_NAME) - set(SKBUILD_PROJECT_NAME ${SKBUILD_PROJECT_NAME}) -else() - set(SKBUILD_PROJECT_NAME "artemis") -endif() +set(SKBUILD_PROJECT_NAME "artemis") # set compiler @@ -23,7 +19,7 @@ set(CMAKE_Fortran_STANDARD 2018) # set the project version file(READ "fpm.toml" ver) -string(REGEX MATCH "version = \"([0-9]+.[0-9]+.[0-9]+)\"" _ ${ver}) +string(REGEX MATCH "version = \"([0-9]+\\.[0-9]+\\.[0-9]+)(-dev[0-9]+)?\"" _ ${ver}) set(PROJECT_VERSION ${CMAKE_MATCH_1}) message(STATUS "Project version: ${PROJECT_VERSION}") diff --git a/pyproject.toml b/pyproject.toml index 280632f..9edc86b 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -26,9 +26,10 @@ ninja.make-fallback = true sdist.reproducible = true # dev purposes only build.verbose = false +wheel.packages = ["src/artemis"] [project] -name = "artemis" +name = "artemis-materials" dynamic = ["version"] dependencies = [ "numpy>=1.26.4,<=2.2", From 4f6fa40762aa17ce4cb057039b448873a11f907c Mon Sep 17 00:00:00 2001 From: Ned Taylor Date: Thu, 1 May 2025 13:56:15 +0100 Subject: [PATCH 107/137] Fix line truncation --- src/fortran/lib/mod_generator.f90 | 8 ++++++-- src/fortran/lib/mod_terminations.f90 | 10 ++++++++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index dab9025..4dc0fcf 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1778,7 +1778,9 @@ subroutine generate_interfaces( & call transformer(supercell_lw,tfmat,t1lw_map) if(.not.compare_stoichiometry(structure_lw,supercell_lw))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') - write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the lower material on match ",I0)') ifit + write(0,'(2X,"& + &The gldfnd subroutine could not reproduce a valid primitive & + &cell for the lower material on match ",I0)') ifit if(verbose_.gt.1)then call err_abort_print_struc(supercell_lw, "broken_primitive.vasp", & "Code exiting due to IPRINT = 1") @@ -1871,7 +1873,9 @@ subroutine generate_interfaces( & ! check the stoichiometry ratios are still maintained if(.not.compare_stoichiometry(structure_up,supercell_up))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') - write(0,'(2X,"The gldfnd subroutine could not reproduce a valid primitive cell for the upper material on match ",I0)') ifit + write(0,'(2X,"& + &The gldfnd subroutine could not reproduce a valid primitive & + &cell for the upper material on match ",I0)') ifit if(verbose_.gt.1)then call err_abort_print_struc(supercell_up, "broken_primitive.vasp", & "Code exiting due to IPRINT = 1") diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index 8cd5d87..c3a1481 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -959,8 +959,14 @@ subroutine cut_slab_to_height( & ladder_adjust = term%arr(term_top_idx)%ladder(j+1) - term%arr(term_btm_idx)%ladder(j) end if end if - rtmp1 = ( icell / real(num_cells,real32) + layer_thickness ) * slab_thickness + & - ( ladder_adjust + term%arr(term_top_idx)%ladder(j) - term%arr(term_btm_idx)%ladder(1) ) * slab_thickness / real(num_cells,real32) + rtmp1 = & + ( & + icell / real(num_cells,real32) + layer_thickness & + ) * slab_thickness + & + ( & + ladder_adjust + term%arr(term_top_idx)%ladder(j) - & + term%arr(term_btm_idx)%ladder(1) & + ) * slab_thickness / real(num_cells,real32) if(rtmp1.ge.thickness)then istep = j num_cells_minus1 = icell From edcbb4fd6ad914bad443793e846a866e078f088e Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Thu, 1 May 2025 14:52:20 +0100 Subject: [PATCH 108/137] Update installation guides --- README.md | 13 ++++++++++--- docs/source/install.rst | 40 ++++++++++++++++++++++++++++++++++++---- 2 files changed, 46 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 419d9e0..fa353c3 100644 --- a/README.md +++ b/README.md @@ -81,10 +81,17 @@ The library is known to not currently work with the intel Fortran compilers. ## Installation -The Python library is not yet directly available from PyPi (this will be made available with the first Python library full release). -For now, local pip installation is required. +For the Python library, the easiest method of installation is to install it directly from pip: -First, use the following commands to download the ARTEMIS repository: +``` +pip install artemis-materials +``` + +Once this is done, ARTEMIS is ready to be used. + +Alternatively, to download development versions or, if, for some reason, the pip method does not work, then ARTEMIS can be installed from the source. +To do so, the source must be obtained from the git repository. +Use the following commands to get started: ``` git clone https://github.com/ExeQuantCode/artemis.git cd artemis diff --git a/docs/source/install.rst b/docs/source/install.rst index 2d75ee4..d27ac7c 100644 --- a/docs/source/install.rst +++ b/docs/source/install.rst @@ -4,10 +4,30 @@ Installation ============ -The Python library is not yet directly available from PyPi (this will be made available with the first Python library full release). -For now, local pip installation is required. +For the Python library, the easiest method of installation is to install it directly from pip: + +.. code-block:: bash + + pip install artemis-materials + +or + +.. code-block:: bash + + pip install artemis-materials + +Once this is done, ARTEMIS is ready to be used. + +Alternatively, to install ARTEMIS from source, follow the instructions below. + + +ARTEMIS can be installed in one of three ways; as a Python package, as a Fortran library, or as a standalone Fortran executable. +All versions rely on the core Fortran code, with the Python package and standalone executable wrapping this code in a Python and Fortran interface, respectively. + +The code is hosted on `GitHub `_. + +This can be done by cloning the repository: -First, use the following commands to download the ARTEMIS repository: .. code-block:: bash git clone https://github.com/ExeQuantCode/artemis.git cd artemis @@ -43,8 +63,20 @@ Requirements Installation using pip ----------------------- +The easiest way to install ARTEMIS is via pip. +The package is directly available via PyPI, so can be installed without downloading the repository. To do so, run: + +.. code-block:: bash + + pip install artemis-materials + +This will install the ARTEMIS package and all its dependencies in the default location. +This is the recommended method of installation, as it is the easiest and most straightforward way to get started with RAFFLE. + +Another option is to install ARTEMIS from the source code, which is recommended if you want to use the latest version of ARTEMIS or if you want to contribute to its development. +To do this, you will need to clone the repository from GitHub. -For Python, the easiest installation is through pip: +Once the library is cloned, navigate to the root directory of the repository and run: .. code-block:: bash From 38d9e8d110095c6f42e7518688ea84713d835ef5 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sat, 3 May 2025 07:02:22 +0100 Subject: [PATCH 109/137] Make python install executable --- pyproject.toml | 5 ++++- src/artemis/cli/__init__.py | 0 src/artemis/cli/main.py | 9 +++++++++ 3 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 src/artemis/cli/__init__.py create mode 100644 src/artemis/cli/main.py diff --git a/pyproject.toml b/pyproject.toml index 9edc86b..abf21a7 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -15,7 +15,7 @@ cmake.build-type = "Release" cmake.source-dir = "." cmake.args = [ "-DBUILD_PYTHON=On", - "-DBUILD_EXECUTABLE=Off", + "-DBUILD_EXECUTABLE=On", "-DREMAKE_F90WRAP=Off", ] sdist.cmake = true @@ -54,6 +54,9 @@ classifiers = [ "Operating System :: OS Independent", ] +[project.scripts] +artemis = 'artemis.cli.main:main' + [project.urls] Homepage = "https://github.com/ExeQuantCode/artemis" Documentation = "https://artemis-materials.readthedocs.io/" diff --git a/src/artemis/cli/__init__.py b/src/artemis/cli/__init__.py new file mode 100644 index 0000000..e69de29 diff --git a/src/artemis/cli/main.py b/src/artemis/cli/main.py new file mode 100644 index 0000000..51bb913 --- /dev/null +++ b/src/artemis/cli/main.py @@ -0,0 +1,9 @@ +import os +import subprocess +import sys + +def main(): + this_dir = os.path.dirname(__file__) + package_root = os.path.abspath(os.path.join(this_dir, '..')) # go up from cli/ + exe_path = os.path.join(package_root, 'bin', 'artemis_executable') + subprocess.run([exe_path] + sys.argv[1:]) \ No newline at end of file From 2f0cfa81ee96a3f1125829a56333517d3fe9b0d9 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sat, 3 May 2025 07:20:23 +0100 Subject: [PATCH 110/137] Fix file overwriting --- app/default_infile.f90 | 197 +++++++++++++++++++++++++---------------- 1 file changed, 119 insertions(+), 78 deletions(-) diff --git a/app/default_infile.f90 b/app/default_infile.f90 index ddf1817..23a37ea 100644 --- a/app/default_infile.f90 +++ b/app/default_infile.f90 @@ -1,96 +1,137 @@ -!!!############################################################################# -!!! module to write example input file -!!!############################################################################# module infile_print + !! This module contains a subroutine to print a default input file implicit none -!!!updated 2022/04/04 + private + + public :: print_default_file + contains -!!!############################################################################# -!!! print example.in -!!!############################################################################# + +!############################################################################### subroutine print_default_file(file) + !! Print a default input file for the program implicit none - integer :: UNIT - character(*), optional :: file - UNIT=0 + ! Arguments + character(*), intent(in), optional :: file + !! The name of the file to print to (default = stdout) + + ! Local variables + integer :: unit, status, i + !! unit number, status, and loop counter + logical :: exist + !! logical variable to check if file exists + character(len=16) :: buffer + !! buffer for user input + + + ! Check if file is present + ! If not, use stdout + unit = 6 if(present(file))then - UNIT=20 - open(unit=UNIT,file=file) + ! check if file exists + inquire(file=file,exist=exist) + i = 0 + file_overwrite_check: do while(exist) + i = i + 1 + if(i.gt. 10) then + write(0,*) "Too many attempts to overwrite file. Exiting." + return + end if + ! file exists, ask if overwrite + if(i.eq.1) write(*,'("File ",A," already exists. ")',advance='no') trim(adjustl(file)) + write(*,'("Overwrite? (y/n) ")',advance='no') + read(*,'(A)',iostat=status) buffer + if(status .ne. 0) return + buffer = trim(adjustl(buffer)) + select case(buffer(1:1)) + case('y','Y') + ! overwrite + write(*,'(" Overwriting file ",A)') trim(adjustl(file)) + exit file_overwrite_check + case('n','N') + ! do not overwrite, exit + write(*,'(" Exiting without overwriting file ",A)') trim(adjustl(file)) + return + case default + ! invalid input, ask again + write(0,'(" Invalid input. Please enter ''y'' or ''n''.")') + end select + end do file_overwrite_check + open(newunit=unit,file=file,action='write') end if - write(UNIT,'("SETTINGS")') - write(UNIT,'(2X,"TASK = 1")') - write(UNIT,'(2X,"RESTART = 0")') - write(UNIT,'(2X,"STRUC1_FILE = POSCAR1 ! lower structure/interface structure")') - write(UNIT,'(2X,"STRUC2_FILE = POSCAR2 ! upper structure (not used if RESTART > 0)")') - write(UNIT,'(2X,"MASTER_DIR = DINTERFACES")') - write(UNIT,'(2X,"SUBDIR_PREFIX = D")') - write(UNIT,'(2X,"IPRINT = 0")') - write(UNIT,'(2X,"CLOCK = ! taken from the time clock by default")') - write(UNIT,'("END SETTINGS")') - write(UNIT,*) - write(UNIT,*) - write(UNIT,'("CELL_EDITS")') - write(UNIT,'(2X,"LSURF_GEN = T")') - write(UNIT,'(2X,"MILLER_PLANE = 1 2 1")') - write(UNIT,'(2X,"SLAB_THICKNESS = 6")') - write(UNIT,'("END CELL_EDITS")') - write(UNIT,*) - write(UNIT,*) - write(UNIT,'("INTERFACES")') - write(UNIT,'(2X,"LGEN_INTERFACES = T ! generate interfaces")') - write(UNIT,'(2X,"IMATCH = 0 ! interface matching method")') - write(UNIT,'(2X,"NINTF = 100 ! max number of interfaces")') - write(UNIT,'(2X,"NMATCH = 5 ! max number of lattice matches")') - write(UNIT,'(2X,"TOL_VEC = 5.D0 ! max vector tolerance (in percent %)")') - write(UNIT,'(2X,"TOL_ANG = 1.D0 ! max angle tolerance (in degrees (°))")') - write(UNIT,'(2X,"TOL_AREA = 10.D0 ! max area tolerance (in percent %)")') - write(UNIT,'(2X,"TOL_MAXFIND = 100 ! max number of good fits to find per plane")') - write(UNIT,'(2X,"TOL_MAXSIZE = 10 ! max increase of any lattice vector")') - write(UNIT,'(2X,"LW_USE_PRICEL = T ! extract and use the primitive cell of lower")') - write(UNIT,'(2X,"UP_USE_PRICEL = T ! extract and use the primitive cell of upper")') - write(UNIT,*) - write(UNIT,'(2X,"NMILLER = 10 ! number of Miller planes to consider")') - write(UNIT,'(2X,"LW_MILLER = ! written as a miller plane, e.g. 0 0 1")') - write(UNIT,'(2X,"UP_MILLER = ! written as a miller plane, e.g. 0 0 1")') - write(UNIT,*) - write(UNIT,'(2X,"LW_SLAB_THICKNESS = 3 ! thickness of lower material")') - write(UNIT,'(2X,"UP_SLAB_THICKNESS = 3 ! thickness of upper material")') - write(UNIT,'(2X,"NTERM = 5 ! max number of terminations per material per match")') - write(UNIT,'(2X,"LW_SURFACE = ! surface to force for interface generation")') - write(UNIT,'(2X,"UP_SURFACE = ! surface to force for interface generation")') - write(UNIT,*) - write(UNIT,'(2X,"SHIFTDIR = DSHIFT ! shift directory name")') - write(UNIT,'(2X,"ISHIFT = 4 ! shifting method")') - write(UNIT,'(2X,"NSHIFT = 5 ! number of shifts to apply")') - write(UNIT,'(2X,"C_SCALE = 1.D0 ! interface-separation scaling factor")') - write(UNIT,*) - write(UNIT,'(2X,"SWAPDIR = DSWAP ! swap directory name")') - write(UNIT,'(2X,"ISWAP = 0 ! swapping method")') - write(UNIT,'(2X,"NSWAP = 5 ! number of swap structures generated per interface")') - write(UNIT,'(2X,"SWAP_DENSITY = 5.D-2 ! intermixing area density")') - write(UNIT,*) - write(UNIT,'(2X,"LSURF_GEN = F ! generate surfaces of a plane")') - write(UNIT,'(2X,"LPRINT_TERMS = F ! prints all found terminations")') - write(UNIT,'(2X,"LPRINT_MATCHES = F ! prints all found lattice matches")') - write(UNIT,'("END INTERFACES")') - write(UNIT,*) - !write(UNIT,*) - !write(UNIT,'("DEFECTS")') - !write(UNIT,'("! NOT CURRENTLY IMPLEMENTED")') - !write(UNIT,'("END DEFECTS")') - - - if(UNIT.ne.0) close(UNIT) + ! Print the default input file + write(unit,'("SETTINGS")') + write(unit,'(2X,"TASK = 1")') + write(unit,'(2X,"RESTART = 0")') + write(unit,'(2X,"STRUC1_FILE = POSCAR1 ! lower structure/interface structure")') + write(unit,'(2X,"STRUC2_FILE = POSCAR2 ! upper structure (not used if RESTART > 0)")') + write(unit,'(2X,"MASTER_DIR = DINTERFACES")') + write(unit,'(2X,"SUBDIR_PREFIX = D")') + write(unit,'(2X,"IPRINT = 0")') + write(unit,'(2X,"CLOCK = ! taken from the time clock by default")') + write(unit,'("END SETTINGS")') + write(unit,*) + write(unit,*) + write(unit,'("CELL_EDITS")') + write(unit,'(2X,"LSURF_GEN = T")') + write(unit,'(2X,"MILLER_PLANE = 1 2 1")') + write(unit,'(2X,"SLAB_THICKNESS = 6")') + write(unit,'("END CELL_EDITS")') + write(unit,*) + write(unit,*) + write(unit,'("INTERFACES")') + write(unit,'(2X,"LGEN_INTERFACES = T ! generate interfaces")') + write(unit,'(2X,"IMATCH = 0 ! interface matching method")') + write(unit,'(2X,"NINTF = 100 ! max number of interfaces")') + write(unit,'(2X,"NMATCH = 5 ! max number of lattice matches")') + write(unit,'(2X,"TOL_VEC = 5.D0 ! max vector tolerance (in percent %)")') + write(unit,'(2X,"TOL_ANG = 1.D0 ! max angle tolerance (in degrees (°))")') + write(unit,'(2X,"TOL_AREA = 10.D0 ! max area tolerance (in percent %)")') + write(unit,'(2X,"TOL_MAXFIND = 100 ! max number of good fits to find per plane")') + write(unit,'(2X,"TOL_MAXSIZE = 10 ! max increase of any lattice vector")') + write(unit,'(2X,"LW_USE_PRICEL = T ! extract and use the primitive cell of lower")') + write(unit,'(2X,"UP_USE_PRICEL = T ! extract and use the primitive cell of upper")') + write(unit,*) + write(unit,'(2X,"NMILLER = 10 ! number of Miller planes to consider")') + write(unit,'(2X,"LW_MILLER = ! written as a miller plane, e.g. 0 0 1")') + write(unit,'(2X,"UP_MILLER = ! written as a miller plane, e.g. 0 0 1")') + write(unit,*) + write(unit,'(2X,"LW_MIN_THICKNESS = 10 ! thickness of lower material (in Angstrom)")') + write(unit,'(2X,"UP_MIN_THICKNESS = 10 ! thickness of upper material (in Angstrom)")') + write(unit,'(2X,"NTERM = 5 ! max number of terminations per material per match")') + write(unit,'(2X,"LW_SURFACE = ! surface to force for interface generation")') + write(unit,'(2X,"UP_SURFACE = ! surface to force for interface generation")') + write(unit,*) + write(unit,'(2X,"SHIFTDIR = DSHIFT ! shift directory name")') + write(unit,'(2X,"ISHIFT = 4 ! shifting method")') + write(unit,'(2X,"NSHIFT = 5 ! number of shifts to apply")') + write(unit,'(2X,"C_SCALE = 1.D0 ! interface-separation scaling factor")') + write(unit,*) + write(unit,'(2X,"SWAPDIR = DSWAP ! swap directory name")') + write(unit,'(2X,"ISWAP = 0 ! swapping method")') + write(unit,'(2X,"NSWAP = 5 ! number of swap structures generated per interface")') + write(unit,'(2X,"SWAP_DENSITY = 5.D-2 ! intermixing area density")') + write(unit,*) + write(unit,'(2X,"LSURF_GEN = F ! generate surfaces of a plane")') + write(unit,'(2X,"LPRINT_TERMS = F ! prints all found terminations")') + write(unit,'(2X,"LPRINT_MATCHES = F ! prints all found lattice matches")') + write(unit,'("END INTERFACES")') + write(unit,*) + !write(unit,*) + !write(unit,'("DEFECTS")') + !write(unit,'("! NOT CURRENTLY IMPLEMENTED")') + !write(unit,'("END DEFECTS")') - end subroutine print_default_file -!!!############################################################################# + if(present(file)) close(unit) + end subroutine print_default_file +!############################################################################### end module infile_print From f9b612f071ffe369635561133b6d619a42694f0f Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sat, 3 May 2025 07:35:39 +0100 Subject: [PATCH 111/137] Handle stoichiometric breaking terminations --- app/inputs.f90 | 30 ++++++++++++++------ app/main.f90 | 3 ++ src/artemis/artemis.py | 8 +++++- src/fortran/lib/mod_generator.f90 | 21 ++++++++++++++ src/fortran/lib/mod_help.f90 | 40 +++++++++++++++++++++++++-- src/wrapper/f90wrap_mod_generator.f90 | 5 ++++ 6 files changed, 95 insertions(+), 12 deletions(-) diff --git a/app/inputs.f90 b/app/inputs.f90 index e449f2b..7018681 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -21,6 +21,8 @@ module inputs use infile_tools use infile_print implicit none + + integer :: max_num_matches, max_num_terms, max_num_planes !! Maximum number of matches, terminations and Miller planes for matching logical :: compensate_normal @@ -63,6 +65,14 @@ module inputs type(tol_type) :: tolerance !! Tolerance settings for lattice matchings + logical :: lw_use_pricel, up_use_pricel + !! Boolean whether to use the primitive cell of the lower and upper + logical :: lw_layered, up_layered + !! Boolean whether the lower and upper structures are layered + logical :: lw_require_stoich, up_require_stoich + !! Boolean whether to require terminations of the lower and upper structures + !! to be stoichiometrically equivalent to their provided structure + integer :: nout,task,task_defect integer :: irestart integer :: lw_num_layers,up_num_layers @@ -73,8 +83,6 @@ module inputs character(200) :: struc1_file,struc2_file,out_filename character(100) :: dirname,shiftdir,swapdir,subdir_prefix logical :: lsurf_gen,lprint_matches,lprint_terms,lgen_interfaces,lprint_shifts - logical :: lw_use_pricel, up_use_pricel - logical :: lw_layered,up_layered logical :: lnorm_lat logical :: ludef_lw_layered,ludef_up_layered,ludef_axis logical :: lpresent_struc2 @@ -87,8 +95,6 @@ module inputs real(real32), dimension(3,3) :: struc1_lat,struc2_lat -!!!updated 2023/03/27 - contains !!!############################################################################# @@ -587,7 +593,7 @@ subroutine read_card_cell_edits(unit,count,skip) character(1024) :: buffer,tagname,store integer, intent(in) :: unit integer, intent(inout) :: count - integer, dimension(14) :: readvar + integer, dimension(15) :: readvar logical, optional, intent(in) :: skip character(len=6), dimension(4) :: & tag_list = ["axis ","loc ","val ","bounds"] @@ -675,11 +681,13 @@ subroutine read_card_cell_edits(unit,count,skip) read(store,*) lw_surf end select case("LNORM_LAT") - call assign(buffer,lnorm_lat, readvar(12)) + call assign(buffer,lnorm_lat, readvar(12)) case("MIN_THICKNESS") - call assign(buffer,lw_thickness, readvar(13)) + call assign(buffer,lw_thickness, readvar(13)) case("USE_PRICEL") - call assign(buffer,lw_use_pricel, readvar(14)) + call assign(buffer,lw_use_pricel, readvar(14)) + case("REQUIRE_STOICH") + call assign(buffer,lw_require_stoich, readvar(15)) case default write(*,'("NOTE: unable to assign variable on line ",I0)') count end select @@ -713,7 +721,7 @@ subroutine read_card_interfaces(unit,count,skip) logical :: ludef_shifts, ludef_lw_layer_sep, ludef_up_layer_sep integer, intent(in) :: unit integer, intent(inout) :: count - integer, dimension(57) :: readvar + integer, dimension(59) :: readvar logical, optional, intent(in) :: skip @@ -902,6 +910,10 @@ subroutine read_card_interfaces(unit,count,skip) call assign(buffer,lw_thickness, readvar(56)) case("UP_MIN_THICKNESS") call assign(buffer,up_thickness, readvar(57)) + case("LW_REQUIRE_STOICH") + call assign(buffer,lw_require_stoich, readvar(58)) + case("UP_REQUIRE_STOICH") + call assign(buffer,up_require_stoich, readvar(59)) case default write(0,'("NOTE: unable to assign variable on line ",I0)') count end select diff --git a/app/main.f90 b/app/main.f90 index 02248e4..1c0c7e7 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -48,6 +48,7 @@ program artemis_executable call generator%set_surface_properties( & miller_lw = lw_mplane, & is_layered_lw = lw_layered, & + require_stoichiometry_lw = lw_require_stoich, & vacuum_gap = vacuum_gap, & layer_separation_cutoff = layer_sep & ) @@ -115,6 +116,8 @@ program artemis_executable call generator%set_surface_properties( & miller_lw = lw_mplane, miller_up = up_mplane, & is_layered_lw = lw_layered, is_layered_up = up_layered, & + require_stoichiometry_lw = lw_require_stoich, & + require_stoichiometry_up = up_require_stoich, & layer_separation_cutoff = [ lw_layer_sep, up_layer_sep ], & vacuum_gap = vacuum_gap & ) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index f925188..97f84d7 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1394,7 +1394,9 @@ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ use_pricel_up=use_pricel_up) def set_surface_properties(self, miller_lw=None, miller_up=None, \ - is_layered_lw=None, is_layered_up=None, layer_separation_cutoff_lw=None, \ + is_layered_lw=None, is_layered_up=None, \ + require_stoichiometry_lw=None, require_stoichiometry_up=None, \ + layer_separation_cutoff_lw=None, \ layer_separation_cutoff_up=None, layer_separation_cutoff=None, \ vacuum_gap=None): """ @@ -1414,6 +1416,8 @@ def set_surface_properties(self, miller_lw=None, miller_up=None, \ miller_up : int array is_layered_lw : bool is_layered_up : bool + require_stoichiometry_lw : bool + require_stoichiometry_up : bool layer_separation_cutoff_lw : float layer_separation_cutoff_up : float layer_separation_cutoff : float array @@ -1423,6 +1427,8 @@ def set_surface_properties(self, miller_lw=None, miller_up=None, \ _artemis.f90wrap_intf_gen__set_surface_properties__binding__agt(this=self._handle, \ miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, \ is_layered_up=is_layered_up, \ + require_stoichiometry_lw=require_stoichiometry_lw, \ + require_stoichiometry_up=require_stoichiometry_up, \ layer_separation_cutoff_lw=layer_separation_cutoff_lw, \ layer_separation_cutoff_up=layer_separation_cutoff_up, \ layer_separation_cutoff=layer_separation_cutoff, vacuum_gap=vacuum_gap) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 4dc0fcf..3a315de 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -42,6 +42,9 @@ module artemis__generator !! Elastic constants for the lower and upper bulk structures logical :: use_pricel_lw = .true., use_pricel_up = .true. !! Use primitive cell for lower and upper bulk structures + logical :: require_stoichiometry_lw = .false., & + require_stoichiometry_up = .false. + !! Boolean whether to require stoichiometry for the lower and upper bulk structures integer, dimension(3) :: miller_lw = [ 0, 0, 0 ], miller_up = [ 0, 0, 0 ] !! Miller indices for the lower and upper bulk structures @@ -608,6 +611,7 @@ subroutine set_surface_properties( & this, & miller_lw, miller_up, & is_layered_lw, is_layered_up, & + require_stoichiometry_lw, require_stoichiometry_up, & layer_separation_cutoff_lw, layer_separation_cutoff_up, & layer_separation_cutoff, & vacuum_gap & @@ -628,6 +632,11 @@ subroutine set_surface_properties( & logical, intent(in), optional :: is_layered_up !! Boolean whether the upper bulk structure is layered + logical, intent(in), optional :: require_stoichiometry_lw + !! Boolean whether to require stoichiometry for the lower bulk structure + logical, intent(in), optional :: require_stoichiometry_up + !! Boolean whether to require stoichiometry for the upper bulk structure + real(real32), intent(in), optional :: layer_separation_cutoff_lw !! Layer separation cutoff for the lower bulk structure real(real32), intent(in), optional :: layer_separation_cutoff_up @@ -655,6 +664,11 @@ subroutine set_surface_properties( & this%ludef_is_layered_up = .true. end if + if(present(require_stoichiometry_lw)) & + this%require_stoichiometry_lw = require_stoichiometry_lw + if(present(require_stoichiometry_up)) & + this%require_stoichiometry_up = require_stoichiometry_up + if(present(vacuum_gap)) this%vacuum_gap = vacuum_gap if(present(layer_separation_cutoff_lw)) & @@ -1776,6 +1790,7 @@ subroutine generate_interfaces( & end if if(all(abs(tfmat(3,:)).lt.1.E-5_real32)) tfmat(3,3) = 1._real32 call transformer(supercell_lw,tfmat,t1lw_map) + ! check the stoichiometry ratios are still maintained if(.not.compare_stoichiometry(structure_lw,supercell_lw))then write(0,'(1X,"ERROR: Internal error in generate_interfaces")') write(0,'(2X,"& @@ -1998,6 +2013,9 @@ &The gldfnd subroutine could not reproduce a valid primitive & &surfaces are required.")') write(*,'(2X,"Skipping this termination...")') cycle lw_term_loop + elseif(this%require_stoichiometry_lw)then + write(*,'(2X,"Skipping this termination...")') + cycle lw_term_loop end if end if if(slab_up%nspec.ne.structure_up%nspec.or.any(& @@ -2010,6 +2028,9 @@ &The gldfnd subroutine could not reproduce a valid primitive & &surfaces are required.")') write(*,'(2X,"Skipping this termination...")') cycle up_term_loop + elseif(this%require_stoichiometry_up)then + write(*,'(2X,"Skipping this termination...")') + cycle up_term_loop end if end if diff --git a/src/fortran/lib/mod_help.f90 b/src/fortran/lib/mod_help.f90 index 4cb9192..6c83912 100644 --- a/src/fortran/lib/mod_help.f90 +++ b/src/fortran/lib/mod_help.f90 @@ -29,7 +29,7 @@ module mod_help ! Cell_edits number of tags - integer, parameter :: ntags_cell_edits=14 + integer, parameter :: ntags_cell_edits=15 ! Cell_edits tags integer, parameter :: iout_file_tag=1 integer, parameter :: ilsurf_gen_CE_tag=2 @@ -45,6 +45,7 @@ module mod_help integer, parameter :: ilnorm_lat_tag=12 integer, parameter :: imin_thick_tag=13 integer, parameter :: iuse_pricel_tag=14 + integer, parameter :: irequire_stoich_tag=15 integer, parameter :: ntags_depr_cell_edits=1 ! Cell_edits deprecated tags @@ -52,7 +53,7 @@ module mod_help ! Interface number of tags - integer, parameter :: ntags_interface=57 + integer, parameter :: ntags_interface=59 ! Interface tags integer, parameter :: inintf_tag=1 integer, parameter :: iimatch_tag=2 @@ -111,6 +112,8 @@ module mod_help integer, parameter :: ilbreak_on_no_term_tag=55 integer, parameter :: ilw_min_thick_tag=56 integer, parameter :: iup_min_thick_tag=57 + integer, parameter :: ilw_require_stoich_tag=58 + integer, parameter :: iup_require_stoich_tag=59 integer, parameter :: ntags_depr_interface=2 ! Cell_edits deprecated tags @@ -344,6 +347,17 @@ function setup_cell_edits_tags() result(tag) 'Defines whether to generate and use the primitive unit cell & &for the crystal' + tag(irequire_stoich_tag)%name = 'REQUIRE_STOICH' + tag(irequire_stoich_tag)%type = 'L' + tag(irequire_stoich_tag)%summary = 'Maintain stoichiometry for terminations' + tag(irequire_stoich_tag)%allowed = 'TRUE or FALSE' + tag(irequire_stoich_tag)%default = 'FALSE' + tag(irequire_stoich_tag)%description = & + 'Defines whether to maintain stoichiometry for the terminations.\n& + &If TRUE, ARTEMIS will only generate terminations that are consistent & + &with the stoichiometry of the bulk crystal.\n& + &If FALSE, ARTEMIS will generate all possible terminations.' + tag(imiller_tag)%name = 'MILLER_PLANE' tag(imiller_tag)%type = 'U' tag(imiller_tag)%summary = 'Crystal Miller plane' @@ -941,6 +955,28 @@ function setup_interface_tags() result(tag) & TRUE = fix the c axis\n& & FALSE = extend/compress c axis to compensate for strain.' + tag(ilw_require_stoich_tag)%name = 'LW_REQUIRE_STOICH' + tag(ilw_require_stoich_tag)%type = 'L' + tag(ilw_require_stoich_tag)%summary = 'Maintain stoichiometry for lower terminations' + tag(ilw_require_stoich_tag)%allowed = 'TRUE or FALSE' + tag(ilw_require_stoich_tag)%default = 'FALSE' + tag(ilw_require_stoich_tag)%description = & + 'Defines whether to maintain stoichiometry for the terminations of the lower structure.\n& + &If TRUE, ARTEMIS will only generate terminations that are consistent & + &with the stoichiometry of the bulk crystal.\n& + &If FALSE, ARTEMIS will generate all possible terminations.' + + tag(iup_require_stoich_tag)%name = 'UP_REQUIRE_STOICH' + tag(iup_require_stoich_tag)%type = 'L' + tag(iup_require_stoich_tag)%summary = 'Maintain stoichiometry for upper terminations' + tag(iup_require_stoich_tag)%allowed = 'TRUE or FALSE' + tag(iup_require_stoich_tag)%default = 'FALSE' + tag(iup_require_stoich_tag)%description = & + 'Defines whether to maintain stoichiometry for the terminations of the upper structure.\n& + &If TRUE, ARTEMIS will only generate terminations that are consistent & + &with the stoichiometry of the bulk crystal.\n& + &If FALSE, ARTEMIS will generate all possible terminations.' + end function setup_interface_tags !!!############################################################################# diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 4421685..160daef 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1285,6 +1285,7 @@ subroutine f90wrap_intf_gen__set_surface_properties__binding__agt( & this, & miller_lw, miller_up, & is_layered_lw, is_layered_up, & + require_stoichiometry_lw, require_stoichiometry_up, & layer_separation_cutoff_lw, layer_separation_cutoff_up, layer_separation_cutoff, & vacuum_gap, n0) use artemis__generator, only: artemis_generator_type @@ -1299,6 +1300,8 @@ subroutine f90wrap_intf_gen__set_surface_properties__binding__agt( & integer, dimension(3), intent(in), optional :: miller_up logical, intent(in), optional :: is_layered_lw logical, intent(in), optional :: is_layered_up + logical, intent(in), optional :: require_stoichiometry_lw + logical, intent(in), optional :: require_stoichiometry_up real(4), intent(in), optional :: layer_separation_cutoff_lw real(4), intent(in), optional :: layer_separation_cutoff_up real(4), dimension(n0), intent(in), optional :: layer_separation_cutoff @@ -1309,6 +1312,8 @@ subroutine f90wrap_intf_gen__set_surface_properties__binding__agt( & call this_ptr%p%set_surface_properties( & miller_lw=miller_lw, miller_up=miller_up, & is_layered_lw=is_layered_lw, is_layered_up=is_layered_up, & + require_stoichiometry_lw=require_stoichiometry_lw, & + require_stoichiometry_up=require_stoichiometry_up, & layer_separation_cutoff_lw=layer_separation_cutoff_lw, & layer_separation_cutoff_up=layer_separation_cutoff_up, & layer_separation_cutoff=layer_separation_cutoff, & From 4a215be071de70af30fb0f0d271dcc513482928c Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 4 May 2025 19:57:52 +0300 Subject: [PATCH 112/137] Remove dev comments --- app/inputs.f90 | 2 -- src/fortran/lib/mod_plane_matching.f90 | 5 ----- 2 files changed, 7 deletions(-) diff --git a/app/inputs.f90 b/app/inputs.f90 index 7018681..d09a9be 100644 --- a/app/inputs.f90 +++ b/app/inputs.f90 @@ -6,7 +6,6 @@ !!! Isiah Edward Mikel Rudkin !!! Code part of the ARTEMIS group !!!############################################################################# -!!! MAYBE HAVE FINDSYM IN HERE IN ORDER TO EDIT TOLSYM? module inputs use artemis__constants, only: real32, pi use artemis__misc, only: flagmaker,file_check @@ -1097,5 +1096,4 @@ subroutine write_settings(dirname) end subroutine write_settings !!!############################################################################ - end module inputs diff --git a/src/fortran/lib/mod_plane_matching.f90 b/src/fortran/lib/mod_plane_matching.f90 index b7444c9..ccf5c21 100644 --- a/src/fortran/lib/mod_plane_matching.f90 +++ b/src/fortran/lib/mod_plane_matching.f90 @@ -567,7 +567,6 @@ subroutine cell_match(& type(tol_type) :: tol real(real32), dimension(3) :: lat1_veca,lat1_vecb,lat2_veca,lat2_vecb, unit_vec real(real32), dimension(tol%maxfit) :: MAIN_LOOP_LIST_TOLERANCES - !real(real32), dimension(:) :: MAIN_LOOP_LIST_TOLERANCES integer, dimension(2,6) :: tmpmat real(real32), dimension(2,2) :: tf,mat1,mat2 real(real32), dimension(2,3) :: considered_vectors @@ -797,9 +796,6 @@ subroutine cell_match(& cycle loop110 else tmpmat(2,3:4) = nint(list_1b(j,:2)) - !write(0,'(A,4X,"[",I3,I3,",",I3,I3,"]",6X,"[",I3,I3,",",I3,I3,"]",4X,I2,2X,I2,2X,F0.3)') & - ! "HERE",numstore_1(l,:2),numstore_1(m,:2),nint(list_1a(i,:2)),nint(list_1b(j,:2)),& - ! total_list_count,len_list_final, considered_angle if(total_list_count.ne.0)then if(.not.is_unique_match( sym1, sym2, & check_set = real(tmpmat,real32),& @@ -812,7 +808,6 @@ subroutine cell_match(& up_list = list_angle_fits(:len_list_final,:4)))& cycle loop110 end if - !write(0,*) "PAST HERE", list_angle_fits(len_list_final,:) len_list_final = len_list_final + 1 list_angle_fits(len_list_final,1:2) = list_1a(i,1:2) From 31cf4f749466be147d881c09b961aaeab1e146ba Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 4 May 2025 19:58:32 +0300 Subject: [PATCH 113/137] Improve documentation --- docs/source/index.rst | 1 + .../tutorials/identify_interface_tutorial.rst | 36 +++++++ docs/source/tutorials/index.rst | 26 +++++ docs/source/tutorials/parameters_tutorial.rst | 100 ++++++++++++++++++ 4 files changed, 163 insertions(+) create mode 100644 docs/source/tutorials/identify_interface_tutorial.rst create mode 100644 docs/source/tutorials/index.rst create mode 100644 docs/source/tutorials/parameters_tutorial.rst diff --git a/docs/source/index.rst b/docs/source/index.rst index 5dd7c5d..c5c0f9c 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -53,6 +53,7 @@ An example about install + tutorials/index .. tutorials/index .. Python API diff --git a/docs/source/tutorials/identify_interface_tutorial.rst b/docs/source/tutorials/identify_interface_tutorial.rst new file mode 100644 index 0000000..941bfab --- /dev/null +++ b/docs/source/tutorials/identify_interface_tutorial.rst @@ -0,0 +1,36 @@ +.. identify_interface: + +================== +Identify interface +================== + +This tutorial demonstrates how to use the ARTEMIS library to return the interface location in an interface structure. + + +The following code snippet shows how to use ARTEMIS to identify the interface location in a structure. + + +.. code-block:: python + + # Import the necessary libraries + from ase.io import read + from artemis.generator import artemis_generator + + # Read the interface structure from a file + atoms = read("interface.xyz") + + # Initialise the ARTEMIS generator + generator = artemis_generator() + + # Get the interface location and axis using ARTEMIS + location, axis = generator.get_interface_location(atoms, return_fractional=True) + print("location", location) + print("axis", axis) + +The interface location is returned as a single value, which is the distance from the origin of the structure to the interface in the direction of the returned axis. +The axis is an integer specifying the direction of the interface in the structure (i.e. 0, 1, or 2 for a, b, or c respectively). + +The `return_fractional` argument specifies whether to return the interface location in fractional coordinates (True) or in Cartesian coordinates (False). +The default value is False. + +This can then be used in conjunction with RAFFLE to reconfigure atoms near to the interface to search for more stable configurations. diff --git a/docs/source/tutorials/index.rst b/docs/source/tutorials/index.rst new file mode 100644 index 0000000..2a80aeb --- /dev/null +++ b/docs/source/tutorials/index.rst @@ -0,0 +1,26 @@ +.. tutorials: + +========= +Tutorials +========= + +The tutorials are designed to help you get started with ARTEMIS. +They cover the parameters and options available in ARTEMIS, as well as the basic usage of the library. + +... note:: + + These tutorials are currently focused on the Python interface. + The command line interface is documented in the :download:`manual <../../manual.pdf>`, in addition to its help and search arguments. + +.. toctree:: + :maxdepth: 2 + :caption: Setup and parameters: + + parameters_tutorial + +.. toctree:: + :maxdepth: 2 + :caption: Post-processing: + + identify_interface_tutorial + diff --git a/docs/source/tutorials/parameters_tutorial.rst b/docs/source/tutorials/parameters_tutorial.rst new file mode 100644 index 0000000..2e93fd7 --- /dev/null +++ b/docs/source/tutorials/parameters_tutorial.rst @@ -0,0 +1,100 @@ +.. parameters: + +================== +Setting parameters +================== + +This tutorial will detail how to initialise an ARTEMIS generator. +It will also explore the parameters associated with the lattice matching and interface alignment methods used by ARTEMIS, in addition to its surface termination identification parameters. + +Initialisation +-------------- +ARTEMIS is initialised by importing the generator object. +The object is the main interface for the user to interact with ARTEMIS. + +.. code-block:: python + + # Initialise ARTEMIS generator + from artemis.generator import artemis_generator + + generator = artemis_generator() + +It is recommended to use the Atomic Simulation Environment (ASE)~\cite{ase-paper} for handling structure data. +Whilst ARTEMIS can handle its own atomic structure object, ASE is more widely used and has a more extensive feature set. + + +Constituent structures +---------------------- + +The first step in using ARTEMIS is to define the constituent structures. +The generator object has a method called ``set_materials`` which takes a list of ASE atoms objects. + +.. code-block:: python + + from ase.build import bulk + + # Define the constituent structures + Si = bulk('Si', 'diamond', a=5.43, cubic=True) + Ge = bulk('Ge', 'diamond', a=5.66, cubic=True) + + generator.set_materials(Si, Ge) + +The above code defines two bulk structures, silicon and germanium, and sets them as the constituent structures for the generator object. +This method can also be used to define the elastic constants of the constituent structures and define whether to identify and use the primitive cell for each structure. +These can be accessed by the following parameters: + +.. code-block:: python + + # Set the elastic constants and primitive cell usage + generator.set_materials( + structure_lw=Si, + structure_up=Ge, + elastic_constants_lw=6, + elastic_constants_up=12, + use_pricel_lw=True, + use_pricel_up=True + ) + +The elastic constants are currently isotropic bulks moduli. +The elastic constants can be calculated using ASE or obtained from the literature, such as the Materials Project~\cite{materials-project}. +The primitive cell usage is a boolean value that indicates whether to use the primitive cell of the structure or not. + + +Surface properties +------------------ + +The next step is to define the surface properties of the interface. +The generator object has a method called ``set_surface_properties`` which takes the Miller indices of the surface planes to be used. +If no Miller indices are provided, the generator will search over the 10 lowest symmetry planes. + +.. code-block:: python + + # Define the surface properties + generator.set_surface_properties( + miller_lw=[1, 1, 0], + miller_up=[1, 1, 0] + ) + +The above code sets the Miller indices of the surface planes to be used for the lower and upper structures. +The Miller indices are a set of three integers that describe the orientation of the surface planes in the crystal lattice. +Additional parameters can be set to define the surface properties, such as: + +.. code-block:: python + + # Set additional surface properties + generator.set_surface_properties( + miller_lw=[1, 1, 0], + miller_up=[1, 1, 0], + is_layered_lw=True, + is_layered_up=True, + require_stoichiometry_lw=True, + require_stoichiometry_up=True, + layer_separation_cutoff_lw=0.5, + layer_separation_cutoff_up=0.5, + ) + +The above code sets the following additional parameters: +- ``is_layered_lw`` and ``is_layered_up``: boolean values that indicate whether the lower and upper structures are to be treated as layered or not. +- ``require_stoichiometry_lw`` and ``require_stoichiometry_up``: boolean values that indicate whether the generated lower and upper slabs should be stoichiometrically equivalent to their respective provided structures. +- ``layer_separation_cutoff_lw`` and ``layer_separation_cutoff_up``: float values that define the cutoff distance for the minimally accepted layer separation (in Angstroms) with which to define distinct planes of atoms. + From 8f92f23867a8cbc5a860830043c34acfbd749ba3 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 4 May 2025 20:03:50 +0300 Subject: [PATCH 114/137] Add details regarding optional parameters --- docs/source/tutorials/parameters_tutorial.rst | 33 +++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/docs/source/tutorials/parameters_tutorial.rst b/docs/source/tutorials/parameters_tutorial.rst index 2e93fd7..787d071 100644 --- a/docs/source/tutorials/parameters_tutorial.rst +++ b/docs/source/tutorials/parameters_tutorial.rst @@ -98,3 +98,36 @@ The above code sets the following additional parameters: - ``require_stoichiometry_lw`` and ``require_stoichiometry_up``: boolean values that indicate whether the generated lower and upper slabs should be stoichiometrically equivalent to their respective provided structures. - ``layer_separation_cutoff_lw`` and ``layer_separation_cutoff_up``: float values that define the cutoff distance for the minimally accepted layer separation (in Angstroms) with which to define distinct planes of atoms. + +The following are optional parameters that can be set for the generator. + +Tolerance parameters +-------------------- + +Tolerances constraining returned structures can be set using the ``set_tolerance`` method. +These tolerances are mostly related to lattice matching. + +.. code-block:: python + + # Set the tolerance parameters + generator.set_tolerance( + vector_mismatch=0.1, + angle_mismatch=0.1, + max_length=0.1, + max_area=0.1, + max_fit=0.1, + max_extension=0.1 + ) + + +Lattice matching parameters +--------------------------- + +The generator object has a method called ``set_match_method`` to set the parameters for the lattice matching method. + + +Interface alignment parameters +------------------------------ + +For interface alignment, the generator can be used to provide a single permutation, or a set of permutations for efficient searching. +The generator object has a method called ``set_shift_method`` which takes the following parameters: From b58fd6b388977c4e8ba80894721b22c2d75ba5d9 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 4 May 2025 20:04:00 +0300 Subject: [PATCH 115/137] Link to RAFFLE --- docs/source/tutorials/identify_interface_tutorial.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/tutorials/identify_interface_tutorial.rst b/docs/source/tutorials/identify_interface_tutorial.rst index 941bfab..0c7d273 100644 --- a/docs/source/tutorials/identify_interface_tutorial.rst +++ b/docs/source/tutorials/identify_interface_tutorial.rst @@ -33,4 +33,4 @@ The axis is an integer specifying the direction of the interface in the structur The `return_fractional` argument specifies whether to return the interface location in fractional coordinates (True) or in Cartesian coordinates (False). The default value is False. -This can then be used in conjunction with RAFFLE to reconfigure atoms near to the interface to search for more stable configurations. +This can then be used in conjunction with `RAFFLE `_ to reconfigure atoms near to the interface to search for more stable configurations. From 25c59ae1a49f3d5c22e6031cda616f611b29c7f3 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:08:35 +0300 Subject: [PATCH 116/137] Improve referencing --- docs/ARTEMIS.bib | 12 ++++++++ docs/source/conf.py | 11 +++++-- docs/source/faq.rst | 30 +++++++++++++++++++ docs/source/index.rst | 2 ++ docs/source/references.bib | 30 +++++++++++++++++++ docs/source/tutorials/index.rst | 4 +-- docs/source/tutorials/parameters_tutorial.rst | 6 ++-- 7 files changed, 89 insertions(+), 6 deletions(-) create mode 100644 docs/ARTEMIS.bib create mode 100644 docs/source/faq.rst diff --git a/docs/ARTEMIS.bib b/docs/ARTEMIS.bib new file mode 100644 index 0000000..5be1b5c --- /dev/null +++ b/docs/ARTEMIS.bib @@ -0,0 +1,12 @@ +@article{Taylor2020ARTEMISAbInitioRestructuring, + title = {{ARTEMIS: Ab initio restructuring tool enabling the modelling of interface structures}}, + year = {2020}, + journal = {Computer Physics Communications}, + author = {Taylor, Ned Thaddeus and Davies, Francis Huw and Rudkin, Isiah Edward Mikel and Price, Conor Jason and Chan, Tsz Hin and Hepplestone, Steven Paul}, + month = {12}, + pages = {107515}, + volume = {257}, + url = {https://linkinghub.elsevier.com/retrieve/pii/S0010465520302423}, + doi = {10.1016/j.cpc.2020.107515}, + issn = {00104655} +} diff --git a/docs/source/conf.py b/docs/source/conf.py index 317da70..7810c16 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -10,7 +10,6 @@ MOCK_MODULES = ["artemis._artemis"] # List any other modules if needed sys.modules.update((mod_name, Mock()) for mod_name in MOCK_MODULES) -# sys.path.insert(0, os.path.abspath(os.path.join('..', '..', 'src', 'raffle'))) # Sets the base path to find your modules sys.path.insert(0, os.path.abspath(os.path.join('..', '..', 'src'))) # Sets the base path to find your modules project = 'ARTEMIS' @@ -31,8 +30,14 @@ 'sphinx.ext.napoleon', 'sphinx.ext.viewcode', 'sphinx_rtd_theme', + 'sphinx.ext.extlinks', ] +extlinks = { + 'doi': ('https://doi.org/%s', 'doi: %s'), + 'git': ('https://github.com/ExeQuantCode/ARTEMIS/-/%s', 'git: %s'), +} + intersphinx_mapping = { 'python': ('https://docs.python.org/3/', None), 'sphinx': ('https://www.sphinx-doc.org/en/master/', None), @@ -75,10 +80,12 @@ "display_github": True, "github_repo": "ARTEMIS", "github_user": "ExeQuantCode", - "github_version": "library", + "github_version": "development", "conf_py_path": "/docs/source/", } +html_extra_path = ['/docs/'] + autoclass_content="both" bibtex_bibfiles = ['references.bib'] diff --git a/docs/source/faq.rst b/docs/source/faq.rst new file mode 100644 index 0000000..1d14e60 --- /dev/null +++ b/docs/source/faq.rst @@ -0,0 +1,30 @@ +.. _faq: + +========================== +Frequently Asked Questions +========================== + + +General +======= + +.. _cite: + +How to cite ARTEMIS? +-------------------- + +If you use ARTEMIS in your research, please cite the following paper: + +.. code-block:: bibtex + + | Ned Thaddeus Taylor, Francis Huw Davies, + | Isiah Edward Mikel Rudkin, Conor Jason Price, + | Tsz Hin Chan, Steven Paul Hepplestone, + | ARTEMIS: Ab initio restructuring tool enabling the modelling of interface structures, + | Comput. Phys. Commun. Vol. 257 107515, 2020. + | doi: 10.1016/j.cpc.2020.107515 + +BibTex (:git:`docs/ARTEMIS.bib`): + +.. literalinclude:: ../ARTEMIS.bib + \ No newline at end of file diff --git a/docs/source/index.rst b/docs/source/index.rst index c5c0f9c..2e9e018 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -21,6 +21,7 @@ An example from ase.io import write from artemis.generator import artemis_generator from mace.calculators import mace_mp + from ase.calculators.singlepoint import SinglePointCalculator generator = artemis_generator() @@ -54,6 +55,7 @@ An example about install tutorials/index + faq .. tutorials/index .. Python API diff --git a/docs/source/references.bib b/docs/source/references.bib index e69de29..f2c31a0 100644 --- a/docs/source/references.bib +++ b/docs/source/references.bib @@ -0,0 +1,30 @@ +@article{ase-paper, + author={Ask Hjorth Larsen and Jens Jørgen Mortensen and Jakob Blomqvist and Ivano E Castelli and Rune Christensen and Marcin +Dułak and Jesper Friis and Michael N Groves and Bjørk Hammer and Cory Hargus and Eric D Hermes and Paul C Jennings and Peter +Bjerre Jensen and James Kermode and John R Kitchin and Esben Leonhard Kolsbjerg and Joseph Kubal and Kristen +Kaasbjerg and Steen Lysgaard and Jón Bergmann Maronsson and Tristan Maxson and Thomas Olsen and Lars Pastewka and Andrew +Peterson and Carsten Rostgaard and Jakob Schiøtz and Ole Schütt and Mikkel Strange and Kristian S Thygesen and Tejs +Vegge and Lasse Vilhelmsen and Michael Walter and Zhenhua Zeng and Karsten W Jacobsen}, + title={The atomic simulation environment—a Python library for working with atoms}, + journal={Journal of Physics: Condensed Matter}, + volume={29}, + number={27}, + pages={273002}, + url={http://stacks.iop.org/0953-8984/29/i=27/a=273002}, + year={2017}, + abstract={The atomic simulation environment (ASE) is a software package written in the Python programming language with the aim of setting up, steering, and analyzing atomistic simulations. In ASE, tasks are fully scripted in Python. The powerful syntax of Python combined with the NumPy array library make it possible to perform very complex simulation tasks. For example, a sequence of calculations may be performed with the use of a simple ‘for-loop’ construction. Calculations of energy, forces, stresses and other quantities are performed through interfaces to many external electronic structure codes or force fields using a uniform interface. On top of this calculator interface, ASE provides modules for performing many standard simulation tasks such as structure optimization, molecular dynamics, handling of constraints and performing nudged elastic band calculations.} +} + +@article{Jain2013CommentaryMaterialsProject, + title = {Commentary: The Materials Project: A materials genome approach to accelerating materials innovation}, + volume = {1}, + ISSN = {2166-532X}, + url = {http://dx.doi.org/10.1063/1.4812323}, + DOI = {10.1063/1.4812323}, + number = {1}, + journal = {APL Materials}, + publisher = {AIP Publishing}, + author = {Jain, Anubhav and Ong, Shyue Ping and Hautier, Geoffroy and Chen, Wei and Richards, William Davidson and Dacek, Stephen and Cholia, Shreyas and Gunter, Dan and Skinner, David and Ceder, Gerbrand and Persson, Kristin A.}, + year = {2013}, + month = jul +} diff --git a/docs/source/tutorials/index.rst b/docs/source/tutorials/index.rst index 2a80aeb..411235e 100644 --- a/docs/source/tutorials/index.rst +++ b/docs/source/tutorials/index.rst @@ -7,10 +7,10 @@ Tutorials The tutorials are designed to help you get started with ARTEMIS. They cover the parameters and options available in ARTEMIS, as well as the basic usage of the library. -... note:: +.. note:: These tutorials are currently focused on the Python interface. - The command line interface is documented in the :download:`manual <../../manual.pdf>`, in addition to its help and search arguments. + The command line interface is documented in the :git:`manual `_, in addition to its help and search arguments. .. toctree:: :maxdepth: 2 diff --git a/docs/source/tutorials/parameters_tutorial.rst b/docs/source/tutorials/parameters_tutorial.rst index 787d071..07edce6 100644 --- a/docs/source/tutorials/parameters_tutorial.rst +++ b/docs/source/tutorials/parameters_tutorial.rst @@ -19,7 +19,7 @@ The object is the main interface for the user to interact with ARTEMIS. generator = artemis_generator() -It is recommended to use the Atomic Simulation Environment (ASE)~\cite{ase-paper} for handling structure data. +It is recommended to use the Atomic Simulation Environment (ASE) :footcite:t:`ase-paper` for handling structure data. Whilst ARTEMIS can handle its own atomic structure object, ASE is more widely used and has a more extensive feature set. @@ -56,7 +56,7 @@ These can be accessed by the following parameters: ) The elastic constants are currently isotropic bulks moduli. -The elastic constants can be calculated using ASE or obtained from the literature, such as the Materials Project~\cite{materials-project}. +The elastic constants can be calculated using ASE or obtained from the literature, such as the Materials Project :footcite:t:`Jain2013CommentaryMaterialsProject`. The primitive cell usage is a boolean value that indicates whether to use the primitive cell of the structure or not. @@ -131,3 +131,5 @@ Interface alignment parameters For interface alignment, the generator can be used to provide a single permutation, or a set of permutations for efficient searching. The generator object has a method called ``set_shift_method`` which takes the following parameters: + +.. footbibliography:: From ce31076a86078369608df2012f9ac9ca2ef50b24 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:11:00 +0300 Subject: [PATCH 117/137] Fix git references --- docs/source/conf.py | 2 +- docs/source/tutorials/index.rst | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index 7810c16..2a458a0 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -35,7 +35,7 @@ extlinks = { 'doi': ('https://doi.org/%s', 'doi: %s'), - 'git': ('https://github.com/ExeQuantCode/ARTEMIS/-/%s', 'git: %s'), + 'git': ('https://github.com/ExeQuantCode/ARTEMIS/raw/HEAD/%s', 'git: %s'), } intersphinx_mapping = { diff --git a/docs/source/tutorials/index.rst b/docs/source/tutorials/index.rst index 411235e..e9477cd 100644 --- a/docs/source/tutorials/index.rst +++ b/docs/source/tutorials/index.rst @@ -10,7 +10,7 @@ They cover the parameters and options available in ARTEMIS, as well as the basic .. note:: These tutorials are currently focused on the Python interface. - The command line interface is documented in the :git:`manual `_, in addition to its help and search arguments. + The command line interface is documented in the :git:`manual `, in addition to its help and search arguments. .. toctree:: :maxdepth: 2 From c16832083e0f5ddc41f10a135b2da4a2664bffee Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:13:09 +0300 Subject: [PATCH 118/137] Fix git references --- docs/source/faq.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/faq.rst b/docs/source/faq.rst index 1d14e60..a2b08ba 100644 --- a/docs/source/faq.rst +++ b/docs/source/faq.rst @@ -24,7 +24,7 @@ If you use ARTEMIS in your research, please cite the following paper: | Comput. Phys. Commun. Vol. 257 107515, 2020. | doi: 10.1016/j.cpc.2020.107515 -BibTex (:git:`docs/ARTEMIS.bib`): +BibTex (:git:`bibliography `): .. literalinclude:: ../ARTEMIS.bib \ No newline at end of file From a9e69ee9fb9d343c26ab3ef1136cc28c27704024 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:16:52 +0300 Subject: [PATCH 119/137] Fix indentation issues and git reference --- docs/source/conf.py | 2 +- docs/source/install.rst | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index 2a458a0..8857b3b 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -35,7 +35,7 @@ extlinks = { 'doi': ('https://doi.org/%s', 'doi: %s'), - 'git': ('https://github.com/ExeQuantCode/ARTEMIS/raw/HEAD/%s', 'git: %s'), + 'git': ('https://github.com/ExeQuantCode/ARTEMIS/blob/HEAD/%s', 'git: %s'), } intersphinx_mapping = { diff --git a/docs/source/install.rst b/docs/source/install.rst index d27ac7c..a22bdf2 100644 --- a/docs/source/install.rst +++ b/docs/source/install.rst @@ -29,6 +29,7 @@ The code is hosted on `GitHub `_. This can be done by cloning the repository: .. code-block:: bash + git clone https://github.com/ExeQuantCode/artemis.git cd artemis @@ -96,6 +97,7 @@ Installation using cmake Another option is installing it through cmake, which involves: .. code-block:: bash + mkdir build cd build cmake .. From 2c42fdfbd665212a84d4e1de148fe57d406c6672 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:27:10 +0300 Subject: [PATCH 120/137] Fix install guide --- docs/source/install.rst | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/docs/source/install.rst b/docs/source/install.rst index a22bdf2..0ee46ea 100644 --- a/docs/source/install.rst +++ b/docs/source/install.rst @@ -10,13 +10,7 @@ For the Python library, the easiest method of installation is to install it dire pip install artemis-materials -or - -.. code-block:: bash - - pip install artemis-materials - -Once this is done, ARTEMIS is ready to be used. +Once this is done, ARTEMIS is ready to be used (both the Python library and the command line interface). Alternatively, to install ARTEMIS from source, follow the instructions below. @@ -88,7 +82,7 @@ To find where this has been installed, you can run: .. code-block:: bash - pip show artemis + pip show artemis-materials This will show you the location of the installed package, in addition to other information about the package. From abd9a0f593e0ddb2b7f397365e5ab974e42018f4 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:27:21 +0300 Subject: [PATCH 121/137] Improve branch reference --- docs/source/conf.py | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index 8857b3b..04dc45b 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -20,6 +20,34 @@ # -- General configuration master_doc = 'index' + +import os + + +on_rtd = os.environ.get('READTHEDOCS') == 'True' + +if on_rtd: + # These are set by RTD + rtd_version = os.environ.get('READTHEDOCS_VERSION') # e.g. 'latest', 'stable', 'v1.0.2', 'feature-xyz' + rtd_repo = os.environ.get('READTHEDOCS_GIT_CLONE_URL') # e.g. 'https://github.com/ExeQuantCode/ARTEMIS.git' + + # Clean it up to a raw GitHub link with HEAD + repo_url = rtd_repo.replace('.git', '').replace('git@github.com:', 'https://github.com/') + branch = rtd_version # usually fine for most use cases + + # Add variables to the HTML context + html_context = { + 'repo_url': repo_url, + 'branch': branch, + } +else: + branch = 'main' + html_context = { + 'repo_url': 'https://github.com/ExeQuantCode/ARTEMIS', + 'branch': branch, # fallback default + } + + extensions = [ 'sphinx.ext.duration', 'sphinx.ext.doctest', @@ -35,7 +63,7 @@ extlinks = { 'doi': ('https://doi.org/%s', 'doi: %s'), - 'git': ('https://github.com/ExeQuantCode/ARTEMIS/blob/HEAD/%s', 'git: %s'), + 'git': ('https://github.com/ExeQuantCode/ARTEMIS/blob/' + branch + '/%s', 'git: %s') } intersphinx_mapping = { From b6ef1a539fc48aff58208f33d6d5ea6ffb66e13d Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:34:22 +0300 Subject: [PATCH 122/137] Improve branch reference --- docs/source/conf.py | 32 ++++++++++++-------------------- 1 file changed, 12 insertions(+), 20 deletions(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index 04dc45b..6584f3d 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -26,26 +26,18 @@ on_rtd = os.environ.get('READTHEDOCS') == 'True' + if on_rtd: - # These are set by RTD - rtd_version = os.environ.get('READTHEDOCS_VERSION') # e.g. 'latest', 'stable', 'v1.0.2', 'feature-xyz' - rtd_repo = os.environ.get('READTHEDOCS_GIT_CLONE_URL') # e.g. 'https://github.com/ExeQuantCode/ARTEMIS.git' - - # Clean it up to a raw GitHub link with HEAD - repo_url = rtd_repo.replace('.git', '').replace('git@github.com:', 'https://github.com/') - branch = rtd_version # usually fine for most use cases - - # Add variables to the HTML context - html_context = { - 'repo_url': repo_url, - 'branch': branch, - } + git_branch = os.environ.get("READTHEDOCS_GIT_IDENTIFIER", "main") else: - branch = 'main' - html_context = { - 'repo_url': 'https://github.com/ExeQuantCode/ARTEMIS', - 'branch': branch, # fallback default - } + git_branch = "main" # or get from git directly with subprocess + +html_context = { + # for example, if your GitHub repo is fixed + "repo_url": "https://github.com/ExeQuantCode/ARTEMIS", +} +# print the branch name +print(f"Branch name: {git_branch}") extensions = [ @@ -63,7 +55,7 @@ extlinks = { 'doi': ('https://doi.org/%s', 'doi: %s'), - 'git': ('https://github.com/ExeQuantCode/ARTEMIS/blob/' + branch + '/%s', 'git: %s') + 'git': ('https://github.com/ExeQuantCode/ARTEMIS/blob/' + git_branch + '/%s', 'git: %s') } intersphinx_mapping = { @@ -108,7 +100,7 @@ "display_github": True, "github_repo": "ARTEMIS", "github_user": "ExeQuantCode", - "github_version": "development", + "github_version": git_branch, "conf_py_path": "/docs/source/", } From 3a83aae036cc3557fc8d614f8df3e5eee2ada346 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 08:52:55 +0300 Subject: [PATCH 123/137] Fix formatting --- docs/source/conf.py | 16 +--------------- docs/source/faq.rst | 2 -- 2 files changed, 1 insertion(+), 17 deletions(-) diff --git a/docs/source/conf.py b/docs/source/conf.py index 6584f3d..aceb673 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -20,26 +20,13 @@ # -- General configuration master_doc = 'index' - -import os - - +# Identify the branch of the documentation on_rtd = os.environ.get('READTHEDOCS') == 'True' - - if on_rtd: git_branch = os.environ.get("READTHEDOCS_GIT_IDENTIFIER", "main") else: git_branch = "main" # or get from git directly with subprocess -html_context = { - # for example, if your GitHub repo is fixed - "repo_url": "https://github.com/ExeQuantCode/ARTEMIS", -} -# print the branch name -print(f"Branch name: {git_branch}") - - extensions = [ 'sphinx.ext.duration', 'sphinx.ext.doctest', @@ -54,7 +41,6 @@ ] extlinks = { - 'doi': ('https://doi.org/%s', 'doi: %s'), 'git': ('https://github.com/ExeQuantCode/ARTEMIS/blob/' + git_branch + '/%s', 'git: %s') } diff --git a/docs/source/faq.rst b/docs/source/faq.rst index a2b08ba..d3c2293 100644 --- a/docs/source/faq.rst +++ b/docs/source/faq.rst @@ -15,8 +15,6 @@ How to cite ARTEMIS? If you use ARTEMIS in your research, please cite the following paper: -.. code-block:: bibtex - | Ned Thaddeus Taylor, Francis Huw Davies, | Isiah Edward Mikel Rudkin, Conor Jason Price, | Tsz Hin Chan, Steven Paul Hepplestone, From 26b839eab8ef36c49e635f7f33fa99c127935f10 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 5 May 2025 09:37:45 +0300 Subject: [PATCH 124/137] Fix references to RAFFLE --- docs/source/install.rst | 8 ++++---- src/fortran/lib/mod_misc_types.f90 | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/docs/source/install.rst b/docs/source/install.rst index 0ee46ea..4b36f5b 100644 --- a/docs/source/install.rst +++ b/docs/source/install.rst @@ -66,7 +66,7 @@ The package is directly available via PyPI, so can be installed without download pip install artemis-materials This will install the ARTEMIS package and all its dependencies in the default location. -This is the recommended method of installation, as it is the easiest and most straightforward way to get started with RAFFLE. +This is the recommended method of installation, as it is the easiest and most straightforward way to get started with ARTEMIS. Another option is to install ARTEMIS from the source code, which is recommended if you want to use the latest version of ARTEMIS or if you want to contribute to its development. To do this, you will need to clone the repository from GitHub. @@ -130,7 +130,7 @@ This can also be set up as a dependency in your own fpm project by adding the fo .. code-block:: toml [dependencies] - raffle = { git = "https://github.com/ExeQuantCode/RAFFLE" } + artemis = { git = "https://github.com/ExeQuantCode/ARTEMIS" } Installation using cmake @@ -164,8 +164,8 @@ This will build the Fortran library and install it in the default location (``~/ Installing on MacOS (Homebrew) ============================== -RAFFLE is developed on Linux and MacOS, and should work on both. -However, there are likely some additional steps required to install RAFFLE on MacOS. +ARTEMIS is developed on Linux and MacOS, and should work on both. +However, there are likely some additional steps required to install ARTEMIS on MacOS. This is because **it is not recommended to rely on the Mac system Python, or Fortran and C compilers**. The recommended way to install Python, gfortran and gcc on MacOS is to use `Homebrew `_. diff --git a/src/fortran/lib/mod_misc_types.f90 b/src/fortran/lib/mod_misc_types.f90 index 6ae8848..c298709 100644 --- a/src/fortran/lib/mod_misc_types.f90 +++ b/src/fortran/lib/mod_misc_types.f90 @@ -296,7 +296,7 @@ function get_structures(this) result(structures) implicit none ! Arguments class(abstract_artemis_generator_type), intent(in) :: this - !! Instance of the raffle generator. + !! Instance of the artemis generator. type(basis_type), dimension(:), allocatable :: structures !! Generated structures. @@ -311,7 +311,7 @@ subroutine set_structures(this, structures) implicit none ! Arguments class(abstract_artemis_generator_type), intent(inout) :: this - !! Instance of the raffle generator. + !! Instance of the artemis generator. type(basis_type), dimension(:), allocatable :: structures !! Generated structures. From f177ef074d858e2372e5532b91b5ed04edf8072e Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 11 May 2025 06:52:49 +0100 Subject: [PATCH 125/137] Fix verbosity printing --- src/fortran/lib/mod_generator.f90 | 27 ++++++++++++++++----------- src/fortran/lib/mod_terminations.f90 | 8 +++++--- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 3a315de..fd03b14 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -756,7 +756,7 @@ end subroutine reset_is_layered_up function get_terminations( & this, identifier, miller, surface, num_layers, thickness, & orthogonalise, normalise, break_on_fail, & - verbose, exit_code & + print_termination_info, verbose, exit_code & ) result(output) !! Generate and prints terminations parallel to the supplied miller plane implicit none @@ -780,6 +780,8 @@ function get_terminations( & !! Boolean whether to normalise the lattice and basis logical, intent(in), optional :: break_on_fail !! Boolean whether to break on failure + logical, intent(in), optional :: print_termination_info + !! Boolean whether to print termination information integer, intent(in), optional :: verbose !! Boolean whether to print verbose output integer, intent(out), optional :: exit_code @@ -819,6 +821,8 @@ function get_terminations( & !! Boolean whether to normalise the lattice logical :: break_on_fail_ !! Boolean whether to break on failure + logical :: print_termination_info_ + !! Boolean whether to print termination information real(real32) :: layer_sep @@ -838,7 +842,10 @@ function get_terminations( & !--------------------------------------------------------------------------- exit_code_ = 0 verbose_ = 0 + print_termination_info_ = .true. if(present(verbose)) verbose_ = verbose + if(present(print_termination_info)) & + print_termination_info_ = print_termination_info !--------------------------------------------------------------------------- @@ -979,7 +986,8 @@ function get_terminations( & ! get the terminations term = get_termination_info( & structure, this%axis, & - verbose = verbose_, tol_sym = this%tol_sym, & + verbose = merge(1,verbose_,print_termination_info_), & + tol_sym = this%tol_sym, & layer_sep = layer_sep, & exit_code = exit_code_ & ) @@ -1007,15 +1015,6 @@ function get_terminations( & height, num_layers_, thickness_, num_cells,& term_start, term_end, term_step & ) - - - !--------------------------------------------------------------------------- - ! Normalise lattice - !--------------------------------------------------------------------------- - if(normalise_)then - call reducer(structure) - structure%lat = MATNORM(structure%lat) - end if !--------------------------------------------------------------------------- @@ -1032,6 +1031,12 @@ function get_terminations( & thickness_, num_cells, num_layers_, height,& prefix, lcycle, orthogonalise_, this%vacuum_gap & ) + ! Normalise lattice + !------------------------------------------------------------------------ + if(normalise_)then + call reducer(output(i)) + output(i)%lat = MATNORM(output(i)%lat) + end if end do end function get_terminations diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index c3a1481..b6490ee 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -69,6 +69,8 @@ function get_termination_info( & integer, intent(inout) :: exit_code ! Local variables + integer :: unit + !! File unit number integer :: i, j, k, is, nterm, mterm, dim, ireject !! Loop indices and dimensions integer :: itmp1, itmp2, init, min_loc @@ -155,9 +157,9 @@ function get_termination_info( & write(0,'(2X,"get_terminations subroutine unable to find a separation & &in the material that is greater than LAYER_SEP")') write(0,'(2X,"Writing material to ''unlayerable.vasp''")') - open(13,file="unlayerable.vasp") - call geom_write(13,basis) - close(13) + open(newunit=unit, file="unlayerable.vasp") + call geom_write(unit, basis) + close(unit) write(0,'(2X,"We suggest reducing LAYER_SEP to less than ",F6.4)') & max_sep write(0,'(2X,"NOTE: If LAYER_SEP < 0.7, the material likely does not & From b0d2e8dd36bb4573a4754de85ff0583c12d7984d Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 11 May 2025 07:30:03 +0100 Subject: [PATCH 126/137] Fix mirror and add new test --- app/main.f90 | 14 +++++++++++--- src/fortran/lib/mod_terminations.f90 | 1 + .../DCHECK/POSCAR_term1 | 13 +++++++++++++ .../POSCAR | 10 ++++++++++ .../param.in | 18 ++++++++++++++++++ 5 files changed, 53 insertions(+), 3 deletions(-) create mode 100644 test/cell_edits_identify_terminations_graphene/DCHECK/POSCAR_term1 create mode 100644 test/cell_edits_identify_terminations_graphene/POSCAR create mode 100644 test/cell_edits_identify_terminations_graphene/param.in diff --git a/app/main.f90 b/app/main.f90 index 1c0c7e7..4854b3d 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -57,7 +57,9 @@ program artemis_executable surface = lw_surf, & num_layers = lw_num_layers, & thickness = lw_thickness, & - orthogonalise = lortho & + orthogonalise = lortho, & + print_termination_info = lprint_terms, & + verbose = verbose & ) filepath = "DTERMINATIONS" call system("mkdir -p " // trim(filepath)) @@ -134,9 +136,12 @@ program artemis_executable else write(*,'(1X,"Finding terminations for lower material.")') structures = generator%get_terminations(1, & + surface = lw_surf, & num_layers = lw_num_layers, & thickness = lw_thickness, & - orthogonalise = lortho & + orthogonalise = lortho, & + print_termination_info = lprint_terms, & + verbose = verbose & ) filepath = "DTERMINATIONS/DLW_TERMS" call system("mkdir -p " // trim(filepath)) @@ -154,9 +159,12 @@ program artemis_executable else write(*,'(1X,"Finding terminations for upper material.")') structures = generator%get_terminations(2, & + surface = up_surf, & num_layers = up_num_layers, & thickness = up_thickness, & - orthogonalise = lortho & + orthogonalise = lortho, & + print_termination_info = lprint_terms, & + verbose = verbose & ) filepath = "DTERMINATIONS/DUP_TERMS" call system("mkdir -p " // trim(filepath)) diff --git a/src/fortran/lib/mod_terminations.f90 b/src/fortran/lib/mod_terminations.f90 index b6490ee..25e15eb 100644 --- a/src/fortran/lib/mod_terminations.f90 +++ b/src/fortran/lib/mod_terminations.f90 @@ -397,6 +397,7 @@ function get_termination_info( & do k = 1, size(comparison_list) itmp2 = comparison_list(k) call grp1%copy(grp_store_inv) + grp1%confine%l = .false. call check_sym(grp1,basis_arr(itmp2),& iperm=-1,lsave=.true.,check_all_sym=.true., & tol_sym=tol_sym & diff --git a/test/cell_edits_identify_terminations_graphene/DCHECK/POSCAR_term1 b/test/cell_edits_identify_terminations_graphene/DCHECK/POSCAR_term1 new file mode 100644 index 0000000..a0e52bf --- /dev/null +++ b/test/cell_edits_identify_terminations_graphene/DCHECK/POSCAR_term1 @@ -0,0 +1,13 @@ +C2 + 1.000000000 + 2.467291117 0.000000000 0.000000000 + 0.000000000 10.000000954 0.000000000 + -0.000000108 0.000000000 18.273471832 +C +5 +Direct + 0.996864974 0.249999985 0.000733164 + 0.496864915 0.249999985 0.117664248 + 0.996864915 0.249999985 0.234595314 + 0.496864945 0.249999985 0.039710194 + 0.996864796 0.249999985 0.156641290 diff --git a/test/cell_edits_identify_terminations_graphene/POSCAR b/test/cell_edits_identify_terminations_graphene/POSCAR new file mode 100644 index 0000000..a6619dc --- /dev/null +++ b/test/cell_edits_identify_terminations_graphene/POSCAR @@ -0,0 +1,10 @@ +C2 +1.0 + 1.2336456308015411 -2.1367369110836258 0.0000000000000000 + 1.2336456308015411 2.1367369110836258 0.0000000000000000 + 0.0000000000000000 0.0000000000000000 10.0 +C +2 +direct + 0.0000000000000000 0.0000000000000000 0.2500000000000000 C0+ + 0.3333333333333330 0.6666666666666661 0.2500000000000000 C0+ diff --git a/test/cell_edits_identify_terminations_graphene/param.in b/test/cell_edits_identify_terminations_graphene/param.in new file mode 100644 index 0000000..89ddaba --- /dev/null +++ b/test/cell_edits_identify_terminations_graphene/param.in @@ -0,0 +1,18 @@ +SETTINGS + TASK = 0 + RESTART = 0 + STRUC1_FILE = POSCAR ! lower structure/interface structure +! STRUC2_FILE = ! upper structure (not used if RESTART > 0) + MASTER_DIR = DINTERFACES + SUBDIR_PREFIX = D + IPRINT = 0 + CLOCK = ! taken from the time clock by default +END SETTINGS + + +CELL_EDITS + LSURF_GEN = T + MILLER_PLANE = 1 0 0 + NUM_LAYERS = 5 + LAYER_SEP = 0.1 +END CELL_EDITS From 503e5a870d25f60f0854643def4660968a3b825b Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 11 May 2025 08:27:17 +0100 Subject: [PATCH 127/137] Fix slab thickness handling --- src/artemis/artemis.py | 34 +++++++++++++++++++-------- src/fortran/lib/mod_generator.f90 | 18 +++++++++----- src/wrapper/f90wrap_mod_generator.f90 | 6 +++-- 3 files changed, 40 insertions(+), 18 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 97f84d7..2bc9bf8 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1353,8 +1353,14 @@ def set_match_method(self, method=None, max_num_matches=None, \ method=method, max_num_matches=max_num_matches, max_num_terms=max_num_terms, \ max_num_planes=max_num_planes, compensate_normal=compensate_normal) - def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ - elastic_constants_up=None, use_pricel_lw=None, use_pricel_up=None): + def set_materials(self, + structure_lw: Atoms | Geom_Rw.basis = None, + structure_up: Atoms | Geom_Rw.basis = None, + elastic_constants_lw=None, + elastic_constants_up=None, + use_pricel_lw=None, + use_pricel_up=None + ): """ set_materials__binding__artemis_gen_type(self, structure_lw, \ structure_up[, elastic_constants_lw, elastic_constants_up, use_pricel_lw, \ @@ -1381,14 +1387,22 @@ def set_materials(self, structure_lw, structure_up, elastic_constants_lw=None, \ """ # check if host is ase.Atoms object or a Fortran derived type basis_type - if isinstance(structure_lw, Atoms): - structure_lw = geom_rw.basis(atoms=structure_lw) + if structure_lw is None: + structure_lw_handle = None + else: + if isinstance(structure_lw, Atoms): + structure_lw = geom_rw.basis(atoms=structure_lw) + structure_lw_handle = structure_lw._handle - if isinstance(structure_up, Atoms): - structure_up = geom_rw.basis(atoms=structure_up) + if structure_up is None: + structure_up_handle = None + else: + if isinstance(structure_up, Atoms): + structure_up = geom_rw.basis(atoms=structure_up) + structure_up_handle = structure_up._handle _artemis.f90wrap_intf_gen__set_materials__binding__agt(this=self._handle, \ - structure_lw=structure_lw._handle, structure_up=structure_up._handle, \ + structure_lw=structure_lw_handle, structure_up=structure_up_handle, \ elastic_constants_lw=elastic_constants_lw, \ elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, \ use_pricel_up=use_pricel_up) @@ -1492,7 +1506,7 @@ def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ # allocate the structures structures = geom_rw.basis_array() #.allocate(n_structs) structures.allocate(n_structs) - _artemis.f90wrap_retrieve_last_generated_structures(n_structs, structures._handle) + _artemis.f90wrap_retrieve_last_generated_structures(structures._handle) structures = structures.toase() if return_exit_code: @@ -1731,7 +1745,7 @@ def structure_lw(self): if tuple(structure_lw_handle) in self._objs: structure_lw = self._objs[tuple(structure_lw_handle)] else: - structure_lw = geom_rw.basis_type.from_handle(structure_lw_handle) + structure_lw = geom_rw.basis.from_handle(structure_lw_handle) self._objs[tuple(structure_lw_handle)] = structure_lw return structure_lw @@ -1757,7 +1771,7 @@ def structure_up(self): if tuple(structure_up_handle) in self._objs: structure_up = self._objs[tuple(structure_up_handle)] else: - structure_up = geom_rw.basis_type.from_handle(structure_up_handle) + structure_up = geom_rw.basis.from_handle(structure_up_handle) self._objs[tuple(structure_up_handle)] = structure_up return structure_up diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index fd03b14..4897491 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -889,11 +889,13 @@ function get_terminations( & ! set thickness if provided by user - thickness_ = 10._real32 + thickness_ = -1._real32 num_layers_ = 0 if(present(num_layers)) num_layers_ = num_layers if(present(thickness)) thickness_ = thickness - if(num_layers_.le.0.and.thickness_.le.0._real32)then + if(num_layers_.eq.0.and.abs(thickness_+1._real32).lt.1.E-6_real32)then + thickness_ = 10._real32 + elseif(num_layers_.le.0.and.thickness_.le.0._real32)then write(err_msg,'(A,I0,A)') & "The number of layers for the material is ", & num_layers_, " and the thickness is ", thickness_, & @@ -1503,22 +1505,26 @@ subroutine generate_interfaces( & if(all(surface_lw_.gt.0)) ludef_surface_lw = .true. if(all(surface_up_.gt.0)) ludef_surface_up = .true. - thickness_lw_ = 10._real32 - thickness_up_ = 10._real32 + thickness_lw_ = -1._real32 + thickness_up_ = -1._real32 num_layers_lw_ = 0 num_layers_up_ = 0 if(present(num_layers_lw)) num_layers_lw_ = num_layers_lw if(present(num_layers_up)) num_layers_up_ = num_layers_up if(present(thickness_lw)) thickness_lw_ = thickness_lw if(present(thickness_up)) thickness_up_ = thickness_up - if(num_layers_lw_.le.0.and.thickness_lw_.le.0._real32)then + if(num_layers_lw_.eq.0.and.abs(thickness_lw_+1._real32).lt.1.E-6_real32)then + thickness_lw_ = 10._real32 + elseif(num_layers_lw_.le.0.and.thickness_lw_.le.0._real32)then write(err_msg,'(A,I0,A)') & "The number of layers for the lower material is ", & num_layers_lw_, " and the thickness is ", thickness_lw_, & " One of these must be greater than 0." call stop_program(trim(err_msg)) end if - if(num_layers_up_.le.0.and.thickness_up_.le.0._real32)then + if(num_layers_up_.eq.0.and.abs(thickness_up_+1._real32).lt.1.E-6_real32)then + thickness_up_ = 10._real32 + elseif(num_layers_up_.le.0.and.thickness_up_.le.0._real32)then write(err_msg,'(A,I0,A)') & "The number of layers for the upper material is ", & num_layers_up_, " and the thickness is ", thickness_up_, & diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 160daef..4ef539d 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1274,8 +1274,10 @@ subroutine f90wrap_intf_gen__set_materials__binding__agt(this, structure_lw, str integer :: n1 !f2py intent(hide), depend(elastic_constants_up) :: n1 = shape(elastic_constants_up,0) this_ptr = transfer(this, this_ptr) - structure_lw_ptr = transfer(structure_lw, structure_lw_ptr) - structure_up_ptr = transfer(structure_up, structure_up_ptr) + if(present(structure_lw)) & + structure_lw_ptr = transfer(structure_lw, structure_lw_ptr) + if(present(structure_up)) & + structure_lw_ptr = transfer(structure_up, structure_up_ptr) call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & use_pricel_up=use_pricel_up) From b3e61cd1c03f13a4c4dc9fb8a360b45ba06a4b37 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Sun, 11 May 2025 08:42:01 +0100 Subject: [PATCH 128/137] Improve printing --- src/fortran/lib/mod_generator.f90 | 3 +- src/fortran/lib/mod_geom_utils.f90 | 50 +++++++++++++++--------------- 2 files changed, 27 insertions(+), 26 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 4897491..0a3e2ef 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -104,6 +104,7 @@ module artemis__generator type(tol_type) :: tolerance !! Tolerance structure real(real32) :: tol_sym = 1.E-6_real32 + !! Tolerance for symmetry operations contains procedure, pass(this) :: get_all_structures_data @@ -1036,7 +1037,7 @@ function get_terminations( & ! Normalise lattice !------------------------------------------------------------------------ if(normalise_)then - call reducer(output(i)) + call reducer(output(i), verbose = verbose_) output(i)%lat = MATNORM(output(i)%lat) end if end do diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 5483be5..3bb304b 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -36,7 +36,7 @@ !!! get_shortest_bond !!!############################################################################# module artemis__geom_utils - use artemis__constants, only: real32 + use artemis__constants, only: real32, pi use artemis__geom_rw, only: basis_type,geom_write use artemis__sym, only: confine_type, gldfnd, tol_sym_default use artemis__misc, only: swap, sort2D @@ -1084,24 +1084,27 @@ end subroutine primitive_lat !!!############################################################################# !!! Uses Buerger's algorithm to reduce cell. !!!############################################################################# - subroutine reducer(basis,tmptype,ltmp) + subroutine reducer(basis, tmptype, verbose) implicit none type(basis_type), intent(inout) :: basis + integer, intent(in), optional :: tmptype + integer, intent(in), optional :: verbose + integer :: cell_type integer :: i,j,k,count,limit real(real32), dimension(3,3) :: newlat,transmat,S,tmp_mat - real(real32) :: tiny,pi,pi2 - logical :: verb,lreduced - integer, optional :: tmptype - logical, optional :: ltmp + + real(real32) :: tiny,pi2 + integer :: verbose_ + logical :: lreduced !!!----------------------------------------------------------------------------- !!! set up inital variable values !!!----------------------------------------------------------------------------- - verb=.false. - if(present(ltmp)) verb=ltmp + verbose_ = 0 + if(present(verbose)) verbose_ = verbose cell_type=2 if(present(tmptype)) cell_type=tmptype S=0._real32 @@ -1109,9 +1112,8 @@ subroutine reducer(basis,tmptype,ltmp) limit=100 lreduced=.false. tiny=1E-5*(get_vol(basis%lat))**(1.E0/3.E0) - pi=4._real32*atan(1._real32) - pi2=2._real32*atan(1._real32) - transmat=0._real32 + pi2 = 2._real32*atan(1._real32) + transmat = 0._real32 do i=1,3 transmat(i,i)=1._real32 end do @@ -1124,9 +1126,9 @@ subroutine reducer(basis,tmptype,ltmp) find_reduced: do while(.not.lreduced) count = count + 1 call mkNiggli_lat(basis%lat,newlat,transmat,S) - lreduced=reduced_check(newlat,cell_type,S) + lreduced = reduced_check(newlat, cell_type, S, verbose_) if(lreduced) exit - if(verb) then + if(verbose.gt.1) then write(*,*) write(*,*) count write(*,*) "###############" @@ -1241,8 +1243,8 @@ subroutine reducer(basis,tmptype,ltmp) transmat=matmul(transpose(tmp_mat),transmat) end if call mkNiggli_lat(basis%lat,newlat,transmat,S) - lreduced=reduced_check(newlat,cell_type,S,"n") - if(verb) then + lreduced = reduced_check(newlat, cell_type, S, verbose) + if(verbose.gt.1) then write(*,*) lreduced write(*,*) (transmat(i,:),i=1,3) end if @@ -1307,20 +1309,19 @@ end subroutine mkNiggli_lat !!! Type II = Sij (i!=j) are all negative or any zero (angles >=90) !!! Cell is reduced if, and only if, all conditions are ... !!! ... satisfied (Niggli 1928) - function reduced_check(lat,cell_type,S,tchar) result(check) + function reduced_check(lat, cell_type, S, verbose) result(check) implicit none - integer :: cell_type + real(real32), dimension(3,3), intent(in) :: lat + real(real32), dimension(3,3), intent(out) :: S + integer, intent(in) :: cell_type + integer :: verbose + real(real32) :: tiny,alpha,beta,gamma,pi2 real(real32), dimension(3) :: a,b,c - real(real32), dimension(3,3) :: lat,S character(1) :: quiet - character(1), optional :: tchar logical :: check - quiet="q" - if(present(tchar)) quiet=tchar - if(quiet.ne."y".and.quiet.ne."q") quiet="n" pi2 = 2._real32*atan(1._real32) check=.false. @@ -1350,7 +1351,7 @@ function reduced_check(lat,cell_type,S,tchar) result(check) S(1,3)-0.5_real32*S(1,1).lt.tiny.and.& S(2,3)-0.5_real32*S(2,2).lt.tiny) then !Type I check=.true. - if(quiet.eq."n") write(0,*) "Found Type I reduced Niggli cell" + if(verbose.gt.0) write(0,*) "Found Type I reduced Niggli cell" elseif(cell_type.eq.2.and.& alpha.ge.pi2-tiny.and.beta.ge.pi2-tiny.and.gamma.ge.pi2-tiny.and.& abs(S(1,2))-0.5_real32*S(1,1).lt.tiny.and.& @@ -1363,12 +1364,11 @@ function reduced_check(lat,cell_type,S,tchar) result(check) if((abs(S(2,3))+abs(S(1,3))+abs(S(1,2)))-0.5_real32*(S(1,1)+S(2,2)).gt.tiny.and.& S(1,1)-(2._real32*abs(S(1,3))+abs(S(1,2))).gt.tiny) return check=.true. - if(quiet.eq."n") write(0,*) "Found Type II reduced Niggli cell" + if(verbose.gt.1) write(0,*) "Found Type II reduced Niggli cell" else check=.false. end if - return end function reduced_check !!!############################################################################# From 98c180b9e867d48496cff5f4ac355cc87228892b Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 12 May 2025 08:25:12 +0100 Subject: [PATCH 129/137] Fix generator members --- src/artemis/artemis.py | 18 ++++++++++++++---- src/wrapper/f90wrap_mod_generator.f90 | 21 +++++++++++++++++++++ 2 files changed, 35 insertions(+), 4 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 2bc9bf8..a533ec4 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1794,6 +1794,10 @@ def elastic_constants_lw(self): """ array_ndim, array_type, array_shape, array_handle = \ _artemis.f90wrap_artemis_gen_type__array__elastic_co4c3f(self._handle) + + if array_handle == 0: + return None + if array_handle in self._arrays: elastic_constants_lw = self._arrays[array_handle] else: @@ -1821,6 +1825,10 @@ def elastic_constants_up(self): """ array_ndim, array_type, array_shape, array_handle = \ _artemis.f90wrap_artemis_gen_type__array__elastic_coedb6(self._handle) + + if array_handle == 0: + return None + if array_handle in self._arrays: elastic_constants_up = self._arrays[array_handle] else: @@ -2052,6 +2060,10 @@ def shifts(self): """ array_ndim, array_type, array_shape, array_handle = \ _artemis.f90wrap_artemis_gen_type__array__shifts(self._handle) + + if array_handle == 0: + return None + if array_handle in self._arrays: shifts = self._arrays[array_handle] else: @@ -2245,7 +2257,7 @@ def require_mirror_swaps(self): """ return \ - _artemis.f90wrap_artemis_gen_type__get__require_mirr41cf(self._handle) + _artemis.f90wrap_artemis_gen_type__get__require_mirror_swaps(self._handle) @require_mirror_swaps.setter def require_mirror_swaps(self, require_mirror_swaps): @@ -2378,7 +2390,7 @@ def layer_separation_cutoff(self): """ array_ndim, array_type, array_shape, array_handle = \ - _artemis.f90wrap_artemis_gen_type__array__layer_sepa90a5(self._handle) + _artemis.f90wrap_artemis_gen_type__array__layer_separation_cutoff(self._handle) if array_handle in self._arrays: layer_separation_cutoff = self._arrays[array_handle] else: @@ -2455,8 +2467,6 @@ def __str__(self): ret.append(repr(self.separation_scale)) ret.append(',\n depth_method : ') ret.append(repr(self.depth_method)) - ret.append(',\n shift_data : ') - ret.append(repr(self.shift_data)) ret.append(',\n swap_method : ') ret.append(repr(self.swap_method)) ret.append(',\n num_swaps : ') diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 4ef539d..0354fbd 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -264,6 +264,27 @@ subroutine f90wrap_artemis_gen_type__array__miller_lw(this, nd, dtype, dshape, d dloc = loc(this_ptr%p%miller_lw) end subroutine f90wrap_artemis_gen_type__array__miller_lw +subroutine f90wrap_artemis_gen_type__array__miller_up(this, nd, dtype, dshape, dloc) + use artemis__generator, only: artemis_generator_type + use, intrinsic :: iso_c_binding, only : c_int + implicit none + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + integer(c_int), intent(in) :: this(2) + type(artemis_generator_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%miller_up) + dloc = loc(this_ptr%p%miller_up) +end subroutine f90wrap_artemis_gen_type__array__miller_up + subroutine f90wrap_artemis_gen_type__get__is_layered_lw(this, f90wrap_is_layered_lw) use artemis__generator, only: artemis_generator_type implicit none From 0490b6721490fc3c154529ec59060e0e3f0f63d1 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 12 May 2025 09:33:54 +0100 Subject: [PATCH 130/137] Fix kernel crashing --- src/artemis/artemis.py | 4 +- src/fortran/lib/mod_generator.f90 | 33 +++++++-- src/fortran/lib/mod_geom_utils.f90 | 99 ++++++++++++++++----------- src/wrapper/f90wrap_mod_generator.f90 | 5 +- 4 files changed, 91 insertions(+), 50 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index a533ec4..365bbe5 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1260,7 +1260,7 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ max_fit=max_fit, max_extension=max_extension, angle_weight=angle_weight, \ area_weight=area_weight) - def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ + def set_shift_method(self, method: int =None, num_shifts: int =None, shifts=None, \ interface_depth=None, separation_scale=None, depth_method=None, \ bondlength_cutoff=None): """ @@ -1290,6 +1290,8 @@ def set_shift_method(self, method=None, num_shifts=None, shifts=None, \ if isinstance(shifts, float) or isinstance(shifts, int): shifts = numpy.array([[shifts]], order='F') # if shifts is a 1D array, convert it to a 2D array, fortran order + elif isinstance(shifts, list): + shifts = numpy.array([shifts], order='F') elif len(shifts.shape) == 1: shifts = numpy.array([shifts], order='F') # if shifts is a 2D array, convert it to a 2D array, fortran order diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 0a3e2ef..2dd2103 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -937,8 +937,12 @@ function get_terminations( & write(err_msg,'(A,I0,A)') & "The surface termination indices have ", size(surface,dim=1), & " components. It should have 1 or 2." - call stop_program(trim(err_msg)) exit_code_ = 1 + call stop_program( & + trim(err_msg), & + exit_code=exit_code_, & + block_stop = present(exit_code) & + ) return end select end if @@ -980,8 +984,12 @@ function get_terminations( & write(err_msg,'(A,I0,A)') & "The transformed structure stoichiometry does not match the & &original structure." - call stop_program(trim(err_msg)) exit_code_ = 1 + call stop_program( & + trim(err_msg), & + exit_code=exit_code_, & + block_stop = present(exit_code) & + ) return end if @@ -1429,16 +1437,26 @@ subroutine generate_interfaces( & ! check if the structures have anything (i.e. atoms) in them if(this%structure_lw%natom.eq.0)then write(err_msg,'(A,I0,A)') & - "ERROR: The lower structure has ", this%structure_lw%natom, & + "The lower structure has ", this%structure_lw%natom, & " atoms. It should have at least 1." - call err_abort(trim(err_msg),fmtd=.true.) + exit_code_ = 1 + call stop_program( & + trim(err_msg), & + exit_code=exit_code_, & + block_stop = present(exit_code) & + ) return end if if(this%structure_up%natom.eq.0)then write(err_msg,'(A,I0,A)') & - "ERROR: The upper structure has ", this%structure_lw%natom, & + "The upper structure has ", this%structure_lw%natom, & " atoms. It should have at least 1." - call err_abort(trim(err_msg),fmtd=.true.) + exit_code_ = 1 + call stop_program( & + trim(err_msg), & + exit_code=exit_code_, & + block_stop = present(exit_code) & + ) return end if call structure_lw%copy(this%structure_lw, length=4) @@ -1498,6 +1516,7 @@ subroutine generate_interfaces( & "The surface vector for the upper material has ", & size(surface_up, dim=1), " components. It should have 1 or 2." call stop_program(trim(err_msg)) + return end select end if @@ -1522,6 +1541,7 @@ subroutine generate_interfaces( & num_layers_lw_, " and the thickness is ", thickness_lw_, & " One of these must be greater than 0." call stop_program(trim(err_msg)) + return end if if(num_layers_up_.eq.0.and.abs(thickness_up_+1._real32).lt.1.E-6_real32)then thickness_up_ = 10._real32 @@ -1531,6 +1551,7 @@ subroutine generate_interfaces( & num_layers_up_, " and the thickness is ", thickness_up_, & " One of these must be greater than 0." call stop_program(trim(err_msg)) + return end if diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 3bb304b..42f0e36 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -1008,18 +1008,30 @@ end function centre_of_mass !!!############################################################################# -!!!############################################################################# -!!! Reorientates lattice to the primitive lattice of its type -!!!############################################################################# -!!! NEED TO SET UP TO WORK FOR THE EXTRA SWAPPINGS OF A, B AND C +!############################################################################### subroutine primitive_lat(basis) + !! Reorientate lattice to the primitive lattice of its type + !! + !! NEED TO SET UP TO WORK FOR THE EXTRA SWAPPINGS OF A, B AND C implicit none + + ! Arguments type(basis_type), intent(inout) :: basis + !! Structure data + + ! Local variables integer :: i,j - real(real32) :: dtmp1 + !! Loop indices + real(real32) :: rtmp1 + !! Temporary variable real(real32), dimension(3) :: scal - real(real32), dimension(3,3) :: lat,plat,tmat1,tmat2 + !! Scaling factors + real(real32), dimension(3,3) :: lat, plat + !! Lattice matrices + real(real32), dimension(3,3) :: tmat1, tmat2 + !! Temporary matrices real(real32), dimension(3,3,4) :: special + !! Special lattice matrices !!--------------------------------------------------------------- @@ -1028,9 +1040,9 @@ subroutine primitive_lat(basis) call reducer(basis) lat = basis%lat plat = lat - do i=1,3 - scal(i)=modu(lat(i,:)) - lat(i,:)=lat(i,:)/scal(i) + do i = 1, 3 + scal(i) = modu(lat(i,:)) + lat(i,:) = lat(i,:) / scal(i) end do @@ -1049,27 +1061,27 @@ subroutine primitive_lat(basis) 0.0_real32, 1._real32, 1._real32,& 1._real32, 0._real32, 1._real32,& 1._real32, 1._real32, 0.0_real32/), shape(lat) ) ) - special(:,:,3) = special(:,:,3)/sqrt(2._real32) + special(:,:,3) = special(:,:,3) / sqrt(2._real32) special(:,:,4) = transpose( reshape( (/& -1._real32, 1._real32, 1._real32,& 1._real32, -1._real32, 1._real32,& 1._real32, 1._real32, -1._real32/), shape(lat) ) ) - special(:,:,4) = special(:,:,4)/sqrt(3._real32) + special(:,:,4) = special(:,:,4) / sqrt(3._real32) !!--------------------------------------------------------------- !! cycles special set to find primitive lattice of supplied lat !!--------------------------------------------------------------- tmat1 = matmul(lat,transpose(lat)) - checkloop: do i=1,4 + checkloop: do i = 1, 4 !tfmat=matmul(lat,inverse_3x3(special(:,:,i))) !tfmat=matmul(tfmat,transpose(tfmat)) tmat2 = matmul(special(:,:,i),transpose(special(:,:,i))) - dtmp1 = tmat2(1,1)/tmat1(1,1) + rtmp1 = tmat2(1,1) / tmat1(1,1) !if(all(abs(tfmat-nint(tfmat)).lt.1.E-8_real32))then - if(all(abs(tmat1*dtmp1-tmat2).lt.1.E-6_real32))then - do j=1,3 - plat(j,:)=scal(j)*special(j,:,i) + if(all(abs(tmat1*rtmp1-tmat2).lt.1.E-6_real32))then + do j = 1, 3 + plat(j,:) = scal(j) * special(j,:,i) end do exit checkloop end if @@ -1078,31 +1090,40 @@ subroutine primitive_lat(basis) basis%lat = plat end subroutine primitive_lat -!!!############################################################################# +!############################################################################### -!!!############################################################################# -!!! Uses Buerger's algorithm to reduce cell. -!!!############################################################################# +!############################################################################### subroutine reducer(basis, tmptype, verbose) + !! Reduce the cell using Buerger's algorithm implicit none + + ! Arguments type(basis_type), intent(inout) :: basis + !! Structure data integer, intent(in), optional :: tmptype + !! Cell type integer, intent(in), optional :: verbose + !! Verbosity level + ! Local variables integer :: cell_type + !! Cell type integer :: i,j,k,count,limit + !! Loop indices real(real32), dimension(3,3) :: newlat,transmat,S,tmp_mat - + !! Lattice matrices real(real32) :: tiny,pi2 + !! Constants integer :: verbose_ + !! Verbosity level logical :: lreduced + !! Boolean whether cell is reduced - -!!!----------------------------------------------------------------------------- -!!! set up inital variable values -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! set up inital variable values + !--------------------------------------------------------------------------- verbose_ = 0 if(present(verbose)) verbose_ = verbose cell_type=2 @@ -1111,24 +1132,24 @@ subroutine reducer(basis, tmptype, verbose) count=0 limit=100 lreduced=.false. - tiny=1E-5*(get_vol(basis%lat))**(1.E0/3.E0) + tiny = 1.E-5_real32 * (get_vol(basis%lat))**(1._real32/3._real32) pi2 = 2._real32*atan(1._real32) transmat = 0._real32 - do i=1,3 - transmat(i,i)=1._real32 + do i = 1, 3 + transmat(i,i) = 1._real32 end do newlat = basis%lat -!!!----------------------------------------------------------------------------- -!!! performs checks on the other main conditions defined by Niggli -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! perform checks on the other main conditions defined by Niggli + !--------------------------------------------------------------------------- find_reduced: do while(.not.lreduced) count = count + 1 call mkNiggli_lat(basis%lat,newlat,transmat,S) lreduced = reduced_check(newlat, cell_type, S, verbose_) if(lreduced) exit - if(verbose.gt.1) then + if(verbose_.gt.1) then write(*,*) write(*,*) count write(*,*) "###############" @@ -1243,16 +1264,16 @@ subroutine reducer(basis, tmptype, verbose) transmat=matmul(transpose(tmp_mat),transmat) end if call mkNiggli_lat(basis%lat,newlat,transmat,S) - lreduced = reduced_check(newlat, cell_type, S, verbose) - if(verbose.gt.1) then + lreduced = reduced_check(newlat, cell_type, S, verbose_) + if(verbose_.gt.1) then write(*,*) lreduced write(*,*) (transmat(i,:),i=1,3) end if -!!!----------------------------------------------------------------------------- -!!! Renormalises the lattice and basis into the new lattice -!!!----------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! Renormalise the lattice and basis into the new lattice + !--------------------------------------------------------------------------- basis%lat = newlat do i = 1, basis%nspec do j = 1, basis%spec(i)%num @@ -1263,10 +1284,8 @@ subroutine reducer(basis, tmptype, verbose) end do end do - - return end subroutine reducer -!!!############################################################################# +!############################################################################### !!!############################################################################# diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 0354fbd..3de96ab 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1035,7 +1035,7 @@ subroutine f90wrap_intf_gen__artemis_gen_type_finalise(this) deallocate(this_ptr%p) end subroutine f90wrap_intf_gen__artemis_gen_type_finalise -subroutine f90wrap_intf_gen__get_all_structures_data__binding_agt(ret_output, this, n0) +subroutine f90wrap_intf_gen__get_all_structures_data__binding_agt(ret_output, this) use artemis__generator, only: artemis_generator_type use artemis__misc_types, only: struc_data_type implicit none @@ -1054,7 +1054,6 @@ subroutine f90wrap_intf_gen__get_all_structures_data__binding_agt(ret_output, th integer, intent(out), dimension(2) :: ret_output type(artemis_generator_type_ptr_type) :: this_ptr integer, intent(in), dimension(2) :: this - integer :: n0 this_ptr = transfer(this, this_ptr) allocate(ret_output_ptr%p) ret_output_ptr%p%items = this_ptr%p%get_all_structures_data() @@ -1298,7 +1297,7 @@ subroutine f90wrap_intf_gen__set_materials__binding__agt(this, structure_lw, str if(present(structure_lw)) & structure_lw_ptr = transfer(structure_lw, structure_lw_ptr) if(present(structure_up)) & - structure_lw_ptr = transfer(structure_up, structure_up_ptr) + structure_up_ptr = transfer(structure_up, structure_up_ptr) call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & use_pricel_up=use_pricel_up) From 265b69ed22f39965aa00a524832a07d2ce618f75 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 12 May 2025 09:36:17 +0100 Subject: [PATCH 131/137] Reduce compilation warnings --- src/fortran/lib/mod_generator.f90 | 7 +- src/fortran/lib/mod_geom_utils.f90 | 21 +++--- src/fortran/lib/mod_help.f90 | 6 +- src/fortran/lib/mod_misc_maths.f90 | 104 +++++++++++++++++------------ src/fortran/lib/mod_shifting.f90 | 6 +- src/fortran/lib/mod_swapping.f90 | 2 +- src/fortran/lib/mod_sym.f90 | 4 +- 7 files changed, 90 insertions(+), 60 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 2dd2103..1a32efd 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1083,8 +1083,11 @@ function get_interface_location( & !! Axis for the interface logical :: return_fractional_ !! Return fractional coordinates + integer :: exit_code_ + !! Exit code for the program axis_ = 0 + exit_code_ = 0 return_fractional_ = .false. if(present(axis)) axis_ = axis if(present(return_fractional)) return_fractional_ = return_fractional @@ -1092,9 +1095,11 @@ function get_interface_location( & output = get_interface(structure, axis_) if(return_fractional_)then - output%loc = output%loc/modu(structure%lat(output%axis,:)) + output%loc = output%loc / modu(structure%lat(output%axis,:)) end if + if(present(exit_code)) exit_code = exit_code_ + end function get_interface_location !############################################################################### diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 42f0e36..81d3d5a 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -1337,22 +1337,21 @@ function reduced_check(lat, cell_type, S, verbose) result(check) real(real32) :: tiny,alpha,beta,gamma,pi2 real(real32), dimension(3) :: a,b,c - character(1) :: quiet logical :: check pi2 = 2._real32*atan(1._real32) - check=.false. - tiny=1E-3 - - a=lat(1,:);b=lat(2,:);c=lat(3,:) - S(1,1)=dot_product(a,a) - S(2,2)=dot_product(b,b) - S(3,3)=dot_product(c,c) - S(2,3)=dot_product(b,c) - S(1,3)=dot_product(a,c) - S(1,2)=dot_product(a,b) + check = .false. + tiny = 1.E-3_real32 + + a = lat(1,:); b = lat(2,:); c = lat(3,:) + S(1,1) = dot_product(a,a) + S(2,2) = dot_product(b,b) + S(3,3) = dot_product(c,c) + S(2,3) = dot_product(b,c) + S(1,3) = dot_product(a,c) + S(1,2) = dot_product(a,b) alpha=acos(S(2,3)/sqrt(S(2,2)*S(3,3))) beta=acos(S(1,3)/sqrt(S(1,1)*S(3,3))) diff --git a/src/fortran/lib/mod_help.f90 b/src/fortran/lib/mod_help.f90 index 6c83912..51e4e97 100644 --- a/src/fortran/lib/mod_help.f90 +++ b/src/fortran/lib/mod_help.f90 @@ -485,7 +485,7 @@ function setup_interface_tags() result(tag) tag(iaxis_tag)%default = '3' tag(iaxis_tag)%description = & 'NOT YET FULLY IMPLEMENTED! Defines the axis along which to print & - interfaces along.\n& + &interfaces along.\n& &NOTE: this does not change the interfaces generated, simply whether & &a generated interface will lie along a, b or c in the generated & &output structure file' @@ -891,9 +891,9 @@ function setup_interface_tags() result(tag) &directory.\n& &Prints surfaces for crystals that have had their Miller planes supplied using the "LW_MILLER" and "UP_MILLER" tags\n& &Inside DTERMINATIONS, populates directory DLW_TERMS with lower & - parent structure surfaces.\n& + &parent structure surfaces.\n& &Inside DTERMINATIONS, populates directory DUP_TERMS with upper & - parent structure surfaces.' + &parent structure surfaces.' tag(ilortho_tag)%name = 'LORTHO' tag(ilortho_tag)%type = 'L' diff --git a/src/fortran/lib/mod_misc_maths.f90 b/src/fortran/lib/mod_misc_maths.f90 index b7b7de8..c968032 100644 --- a/src/fortran/lib/mod_misc_maths.f90 +++ b/src/fortran/lib/mod_misc_maths.f90 @@ -39,45 +39,67 @@ module misc_maths contains -!!!##################################################### -!!! times all elements -!!!##################################################### - function times(in_array) + +!############################################################################### + function times(input) + !! Multiply an array by a scalar value implicit none + + ! Arguments + real(real32), dimension(:),intent(in) :: input + !! Array to be multiplied + + ! Local variables integer :: i + !! Loop index real(real32) :: times - real(real32), dimension(:),intent(in) :: in_array + !! Result of multiplication - times=1.0 - do i=1,size(in_array) - times=times*in_array(i) + times = 1._real32 + do i = 1, size( input, dim = 1 ) + times=times*input(i) end do end function times -!!!#####################################################= +!############################################################################### -!!!##################################################### -!!! evaluates a gausssian at a point -!!!##################################################### +!############################################################################### function gauss(pos,centre,sigma,tol) result(output) - real(real32) :: output,x - real(real32) :: pos,centre,sigma - real(real32) :: udef_tol - real(real32), optional :: tol - if(present(tol))then - udef_tol=tol - else - udef_tol=38._real32 - end if - x=(pos-centre)**2._real32/(2._real32*sigma) - if(abs(x).lt.udef_tol) then - output=exp(-(x)) + !! Evaluate a Gaussian at a point + implicit none + + ! Arguments + real(real32) :: pos + !! Position to evaluate the Gaussian at + real(real32) :: centre + !! Centre of the Gaussian + real(real32) :: sigma + !! Width of the Gaussian + real(real32), intent(in), optional :: tol + !! Tolerance for the Gaussian + + real(real32) :: output + !! Output value of the Gaussian + + ! Local variables + real(real32) :: x + !! Squared distance from the centre + real(real32) :: tol_ + !! Tolerance for the Gaussian + + tol_ = 38._real32 + if(present(tol)) tol_ = tol + + x = ( pos - centre ) ** 2._real32 / ( 2._real32 * sigma ) + if( abs(x) .lt. tol_ ) then + output = exp( -x ) else - output=0._real32 + output = 0._real32 end if + end function gauss -!!!##################################################### +!############################################################################### !!!##################################################### @@ -658,7 +680,7 @@ function gauss_array(distance,in_array,sigma,tol,norm,mask) & result(gauss_func) implicit none integer :: i,n,init_step - real(real32) :: x,sigma,udef_tol,mult + real(real32) :: x,sigma,tol_,mult real(real32), optional :: tol logical, optional :: norm real(real32), dimension(:), intent(in) :: in_array,distance @@ -668,8 +690,8 @@ function gauss_array(distance,in_array,sigma,tol,norm,mask) & logical, dimension(size(distance)), optional, intent(in) :: mask - udef_tol=38._real32 - if(present(tol)) udef_tol=tol + tol_ = 38._real32 + if(present(tol)) tol_ = tol mult=(1._real32/(sqrt(pi*2._real32)*sigma)) if(present(norm))then if(.not.norm) mult=1._real32 @@ -683,13 +705,13 @@ function gauss_array(distance,in_array,sigma,tol,norm,mask) & init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) forward: do i=init_step,size(distance),1 x=0.5_real32*(( distance(i) - in_array(n) )/sigma)**2._real32 - if(x.gt.udef_tol) exit forward + if(x.gt.tol_) exit forward gauss_func(i) = gauss_func(i) + exp(-x) * mult end do forward backward: do i=init_step-1,1,-1 x=0.5_real32*(( distance(i) - in_array(n) )/sigma)**2._real32 - if(x.gt.udef_tol) exit backward + if(x.gt.tol_) exit backward gauss_func(i) = gauss_func(i) + exp(-x) * mult end do backward end do @@ -706,7 +728,7 @@ end function gauss_array function cauchy_array(distance,in_array,gamma,tol,norm) result(c_func) implicit none integer :: i,n,init_step - real(real32) :: x,gamma,udef_tol,mult + real(real32) :: x,gamma,tol_,mult real(real32), optional :: tol logical, optional :: norm real(real32), dimension(:), intent(in) :: in_array,distance @@ -714,8 +736,8 @@ function cauchy_array(distance,in_array,gamma,tol,norm) result(c_func) real(real32) :: pi = 4._real32*atan(1._real32) - udef_tol=1.D16 - if(present(tol)) udef_tol=tol + tol_ = 1.E16_real32 + if(present(tol)) tol_=tol mult=(1._real32/(pi*gamma)) if(present(norm))then if(.not.norm) mult=1._real32 @@ -726,13 +748,13 @@ function cauchy_array(distance,in_array,gamma,tol,norm) result(c_func) init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) forward: do i=init_step,size(distance),1 x = 1._real32 + (( distance(i) - in_array(n) )/gamma)**2._real32 - if(x.gt.udef_tol) exit forward + if(x.gt.tol_) exit forward c_func(i) = c_func(i) + 1._real32/(x) * mult end do forward backward: do i=init_step-1,1,-1 x = 1._real32 + (( distance(i) - in_array(n) )/gamma)**2._real32 - if(x.gt.udef_tol) exit backward + if(x.gt.tol_) exit backward c_func(i) = c_func(i) + 1._real32/x * mult end do backward end do @@ -749,7 +771,7 @@ end function cauchy_array function slater_array(distance,in_array,zeta,tol,norm) result(s_func) implicit none integer :: i,n,init_step - real(real32) :: x,zeta,udef_tol,mult + real(real32) :: x,zeta,tol_,mult real(real32), optional :: tol logical, optional :: norm real(real32), dimension(:), intent(in) :: in_array,distance @@ -757,8 +779,8 @@ function slater_array(distance,in_array,zeta,tol,norm) result(s_func) real(real32) :: pi = 4._real32*atan(1._real32) - udef_tol=38._real32 - if(present(tol)) udef_tol=tol + tol_ = 38._real32 + if(present(tol)) tol_=tol mult=((zeta**3._real32)/pi)**(0.5_real32) if(present(norm))then if(.not.norm) mult=1._real32 @@ -769,13 +791,13 @@ function slater_array(distance,in_array,zeta,tol,norm) result(s_func) init_step=minloc(abs( distance(:) - in_array(n) ),dim=1) forward: do i=init_step,size(distance),1 x = zeta*abs( distance(i) - in_array(n) ) - if(x.gt.udef_tol) exit forward + if(x.gt.tol_) exit forward s_func(i) = s_func(i) + exp(-x) * mult end do forward backward: do i=init_step-1,1,-1 x = zeta*abs( distance(i) - in_array(n) ) - if(x.gt.udef_tol) exit backward + if(x.gt.tol_) exit backward s_func(i) = s_func(i) + exp(-x) * mult end do backward end do diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index 3b831cf..483ef33 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -307,6 +307,7 @@ function findbestfits(bulkbond,avg_min_sep,num_steps,num_c_shifts,num_best_shift end if shiftloop: do i=1,num_best_shifts + placeholder = -1 min_difference = huge(0._real32) LOOP5A: do ia=0,num_steps-1 !loop through shifts in a LOOP5B: do ib=0,num_steps-1 !loop through shifts in b @@ -321,11 +322,14 @@ function findbestfits(bulkbond,avg_min_sep,num_steps,num_c_shifts,num_best_shift placeholder(1) = ia placeholder(2) = ib placeholder(3) = ic - end if end do LOOP5C end do LOOP5B end do LOOP5A + if(any(placeholder.eq.-1)) then + write(0,*) "ERROR: No shifts found for the given interface" + stop + end if avg_min_sep(placeholder(1)+1,placeholder(2)+1,placeholder(3)-c_shift_low+1) = huge(0._real32) end do shiftloop diff --git a/src/fortran/lib/mod_swapping.f90 b/src/fortran/lib/mod_swapping.f90 index 81550ff..efd9713 100644 --- a/src/fortran/lib/mod_swapping.f90 +++ b/src/fortran/lib/mod_swapping.f90 @@ -719,7 +719,7 @@ subroutine rand_swap_depth(bas,swap_bas,& if(verbose.ge.1) & write(0,'(& - I0,"th swap is ",I0,& + &I0,"th swap is ",I0,& &" with ",I0," at distances ",F7.3," and ",F7.3)') & i,swap_list(i,:),& lw_dist_list(swap_list(i,1)),up_dist_list(swap_list(i,2)) diff --git a/src/fortran/lib/mod_sym.f90 b/src/fortran/lib/mod_sym.f90 index f58b671..938dfcc 100644 --- a/src/fortran/lib/mod_sym.f90 +++ b/src/fortran/lib/mod_sym.f90 @@ -1036,9 +1036,9 @@ subroutine generate_all_symmetries(grp, lat, tol_sym) !! Tolerance for symmetry operations ! Local variables - integer :: i, j, k, count, n + integer :: i, j, count, n !! Counters - real(real32) :: tht, angle + real(real32) :: angle !! Angle for rotation real(real32), dimension(3,3) :: invlat !! Inverse lattice matrix From 3f96fce34eb52dcb7013d879b6e1c73f3429ba7b Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 12 May 2025 13:38:40 +0100 Subject: [PATCH 132/137] Rename restart procedure --- app/main.f90 | 2 +- src/artemis/artemis.py | 4 ++-- src/fortran/lib/mod_generator.f90 | 2 +- src/wrapper/f90wrap_mod_generator.f90 | 7 ++++--- 4 files changed, 8 insertions(+), 7 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 4854b3d..85fa155 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -200,7 +200,7 @@ program artemis_executable verbose = verbose & ) else - call generator%restart(struc1_bas) + call generator%regenerate(struc1_bas) end if allocate(match_and_term_idx_list(0)) do i = 1, generator%num_structures diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 365bbe5..d93477e 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1652,7 +1652,7 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ return structures, exit_code return structures - def restart(self, structure, interface_location=None, print_shift_info=None, \ + def regenerate(self, structure, interface_location=None, print_shift_info=None, \ seed=None, verbose=None, return_exit_code=False, calc=None): """ restart__binding__artemis_gen_type(self, basis[, \ @@ -1682,7 +1682,7 @@ def restart(self, structure, interface_location=None, print_shift_info=None, \ if isinstance(structure, Atoms): structure = geom_rw.basis(atoms=structure) - exit_code = _artemis.f90wrap_intf_gen__restart__binding__agt(this=self._handle, \ + exit_code = _artemis.f90wrap_intf_gen__regenerate__binding__agt(this=self._handle, \ structure=structure._handle, interface_location=interface_location, \ print_shift_info=print_shift_info, seed=seed, verbose=verbose) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 1a32efd..24695dc 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -154,7 +154,7 @@ module artemis__generator procedure, pass(this) :: generate => generate_interfaces !! Generate interfaces from two bulk structures - procedure, pass(this) :: restart => generate_interfaces_from_existing + procedure, pass(this) :: regenerate => generate_interfaces_from_existing !! Generate interfaces from existing bulk structures procedure, pass(this) :: generate_perturbations => generate_shifts_and_swaps !! Generate perturbations for the given basis diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 3de96ab..9c2ebe1 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1540,7 +1540,7 @@ subroutine f90wrap_intf_gen__generate__binding__agt( & exit_code=exit_code) end subroutine f90wrap_intf_gen__generate__binding__agt -subroutine f90wrap_intf_gen__restart__binding__agt(this, structure, interface_location, & +subroutine f90wrap_intf_gen__regenerate__binding__agt(this, structure, interface_location, & print_shift_info, seed, verbose, exit_code) use artemis__generator, only: artemis_generator_type use artemis__geom_rw, only: basis_type @@ -1563,9 +1563,10 @@ subroutine f90wrap_intf_gen__restart__binding__agt(this, structure, interface_lo integer, optional, intent(inout) :: exit_code this_ptr = transfer(this, this_ptr) structure_ptr = transfer(structure, structure_ptr) - call this_ptr%p%restart(structure=structure_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & + call this_ptr%p%regenerate(structure=structure_ptr%p, interface_location=interface_location, print_shift_info=print_shift_info, & seed=seed, verbose=verbose, exit_code=exit_code) -end subroutine f90wrap_intf_gen__restart__binding__agt +end subroutine f90wrap_intf_gen__regenerate__binding__agt +!############################################################################### subroutine f90wrap_intf_gen__get_structures__binding__agt(this, ret_structures) use artemis__generator, only: artemis_generator_type From cc1479ab728d864bab4c13ddf852a7efe502ebc6 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 12 May 2025 13:39:00 +0100 Subject: [PATCH 133/137] Improve structure list handling --- src/artemis/artemis.py | 11 ++- src/fortran/lib/mod_generator.f90 | 20 +++++ src/wrapper/f90wrap_mod_generator.f90 | 108 ++++++++++++++++---------- 3 files changed, 99 insertions(+), 40 deletions(-) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index d93477e..1e2e372 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1677,6 +1677,7 @@ def regenerate(self, structure, interface_location=None, print_shift_info=None, """ exit_code = 0 structures = None + num_structures_old = self.num_structures # check if host is ase.Atoms object or a Fortran derived type basis_type if isinstance(structure, Atoms): @@ -1689,11 +1690,19 @@ def regenerate(self, structure, interface_location=None, print_shift_info=None, if ( exit_code != 0 and exit_code != None ) and not return_exit_code: raise RuntimeError(f"Interface generation failed (exit code {exit_code})") - structures = self.get_structures(calc) + num_structures_generated = self.num_structures - num_structures_old + structures = self.get_structures(calc)[-num_structures_generated:] if return_exit_code: return structures, exit_code return structures + def clear_structures(self): + """ + Clear the generated structures from the generator. + + """ + _artemis.f90wrap_intf_gen__clear_structures__binding__agt(this=self._handle) + def get_structures(self, calculator=None): """ Get the generated structures as a list of ASE Atoms objects. diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 24695dc..76f3ca6 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -158,6 +158,9 @@ module artemis__generator !! Generate interfaces from existing bulk structures procedure, pass(this) :: generate_perturbations => generate_shifts_and_swaps !! Generate perturbations for the given basis + + procedure, pass(this) :: clear_structures + !! Clear the structures end type artemis_generator_type contains @@ -337,6 +340,23 @@ end function get_structure_shift !############################################################################### +!############################################################################### + subroutine clear_structures(this) + !! Clear the structures + implicit none + + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type + + if(allocated(this%structure_data)) deallocate(this%structure_data) + if(allocated(this%structures)) deallocate(this%structures) + this%num_structures = 0 + + end subroutine clear_structures +!############################################################################### + + !############################################################################### subroutine set_tolerance( & this, & diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 9c2ebe1..3b639a8 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1,5 +1,8 @@ ! Module artemis__generator defined in file ../fortran/lib/mod_intf_generator.f90 +!############################################################################### +! Members of type artemis_generator_type +!############################################################################### subroutine f90wrap_artemis_gen_type__get__num_structures(this, f90wrap_num_structures) use artemis__generator, only: artemis_generator_type implicit none @@ -397,11 +400,6 @@ subroutine f90wrap_artemis_gen_type__set__ludef_is_laye6e4(this, f90wrap_ludef_i this_ptr%p%ludef_is_layered_up = f90wrap_ludef_is_layered_up end subroutine f90wrap_artemis_gen_type__set__ludef_is_laye6e4 - - - - - subroutine f90wrap_artemis_gen_type__get__shift_method(this, f90wrap_shift_method) use artemis__generator, only: artemis_generator_type implicit none @@ -1008,7 +1006,12 @@ subroutine f90wrap_artemis_gen_type__array__layer_separation_cutoff(this, nd, dt dshape(1:1) = shape(this_ptr%p%layer_separation_cutoff) dloc = loc(this_ptr%p%layer_separation_cutoff) end subroutine f90wrap_artemis_gen_type__array__layer_separation_cutoff +!############################################################################### + +!############################################################################### +! Interface for the generator type +!############################################################################### subroutine f90wrap_intf_gen__artemis_gen_type_initialise(this) use artemis__generator, only: artemis_generator_type implicit none @@ -1034,7 +1037,12 @@ subroutine f90wrap_intf_gen__artemis_gen_type_finalise(this) this_ptr = transfer(this, this_ptr) deallocate(this_ptr%p) end subroutine f90wrap_intf_gen__artemis_gen_type_finalise +!############################################################################### + +!############################################################################### +! Structure data accessors +!############################################################################### subroutine f90wrap_intf_gen__get_all_structures_data__binding_agt(ret_output, this) use artemis__generator, only: artemis_generator_type use artemis__misc_types, only: struc_data_type @@ -1171,7 +1179,12 @@ subroutine f90wrap_intf_gen__get_structure_shift__binding_agt(this, ret_output, this_ptr = transfer(this, this_ptr) ret_output = this_ptr%p%get_structure_shift(idx=idx) end subroutine f90wrap_intf_gen__get_structure_shift__binding_agt +!############################################################################### + +!############################################################################### +! Generation methods and tolerance handlers +!############################################################################### subroutine f90wrap_intf_gen__set_tolerance__bindind_agt(this, vector_mismatch, angle_mismatch, & area_mismatch, max_length, max_area, max_fit, max_extension, angle_weight, area_weight) use artemis__generator, only: artemis_generator_type @@ -1266,7 +1279,12 @@ subroutine f90wrap_intf_gen__set_match_method__binding__agt(this, method, max_nu call this_ptr%p%set_match_method(method=method, max_num_matches=max_num_matches, max_num_terms=max_num_terms, & max_num_planes=max_num_planes, compensate_normal=compensate_normal) end subroutine f90wrap_intf_gen__set_match_method__binding__agt +!############################################################################### + +!############################################################################### +! Material and surface property procedures +!############################################################################### subroutine f90wrap_intf_gen__set_materials__binding__agt(this, structure_lw, structure_up, & elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) use artemis__generator, only: artemis_generator_type @@ -1367,17 +1385,12 @@ subroutine f90wrap_intf_gen__reset_is_layered_up__binding__agt(this) this_ptr = transfer(this, this_ptr) call this_ptr%p%reset_is_layered_up() end subroutine f90wrap_intf_gen__reset_is_layered_up__binding__agt +!############################################################################### - - - - - - - - - +!############################################################################### +! Structural feature identifiers +!############################################################################### subroutine f90wrap_intf_gen__get_terminations__binding__agt( & this, identifier, miller, surface, num_layers, thickness, & orthogonalise, normalise, break_on_fail, & @@ -1464,33 +1477,12 @@ subroutine f90wrap_intf_gen__get_interface_location__binding__agt( & ret_location = intf_info%loc ret_axis = intf_info%axis end subroutine f90wrap_intf_gen__get_interface_location__binding__agt +!############################################################################### - -subroutine f90wrap_retrieve_last_generated_structures(structures) - use artemis__geom_rw, only: basis_type - use artemis__structure_cache, only: retrieve_last_generated_structures - implicit none - - 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 - integer, intent(inout), dimension(2) :: structures - type(basis_type_xnum_array_ptr_type) :: structures_ptr - - structures_ptr = transfer(structures, structures_ptr) - structures_ptr%p%items = retrieve_last_generated_structures() - structures = transfer(structures_ptr, structures) -end subroutine f90wrap_retrieve_last_generated_structures - - - - - +!############################################################################### +! Interface generate procedures +!############################################################################### subroutine f90wrap_intf_gen__generate__binding__agt( & this, surface_lw, surface_up, & thickness_lw, thickness_up, & @@ -1568,6 +1560,10 @@ subroutine f90wrap_intf_gen__regenerate__binding__agt(this, structure, interface end subroutine f90wrap_intf_gen__regenerate__binding__agt !############################################################################### + +!############################################################################### +! Handle the structures array +!############################################################################### subroutine f90wrap_intf_gen__get_structures__binding__agt(this, ret_structures) use artemis__generator, only: artemis_generator_type use artemis__geom_rw, only: basis_type @@ -1594,6 +1590,40 @@ subroutine f90wrap_intf_gen__get_structures__binding__agt(this, ret_structures) ret_structures = transfer(ret_structures_ptr,ret_structures) end subroutine f90wrap_intf_gen__get_structures__binding__agt +subroutine f90wrap_intf_gen__clear_structures__binding__agt(this) + use artemis__generator, only: artemis_generator_type + implicit none + + type artemis_generator_type_ptr_type + type(artemis_generator_type), pointer :: p => NULL() + end type artemis_generator_type_ptr_type + type(artemis_generator_type_ptr_type) :: this_ptr + integer, intent(in), dimension(2) :: this + this_ptr = transfer(this, this_ptr) + call this_ptr%p%clear_structures() +end subroutine f90wrap_intf_gen__clear_structures__binding__agt + +subroutine f90wrap_retrieve_last_generated_structures(structures) + use artemis__geom_rw, only: basis_type + use artemis__structure_cache, only: retrieve_last_generated_structures + implicit none + + 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 + integer, intent(inout), dimension(2) :: structures + type(basis_type_xnum_array_ptr_type) :: structures_ptr + + structures_ptr = transfer(structures, structures_ptr) + structures_ptr%p%items = retrieve_last_generated_structures() + structures = transfer(structures_ptr, structures) +end subroutine f90wrap_retrieve_last_generated_structures +!############################################################################### + !############################################################################### ! generated structures handling From 04bcbbac5ca21d2f0b4b5a7899f59811209b6450 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 12 May 2025 15:17:52 +0100 Subject: [PATCH 134/137] Set up elastic tensor handling --- app/main.f90 | 4 +- src/artemis/artemis.py | 86 ++++++++----- src/fortran/lib/mod_generator.f90 | 133 +++++++++++++------- src/fortran/lib/mod_geom_utils.f90 | 174 ++++++++++++++++++++++---- src/wrapper/f90wrap_mod_generator.f90 | 36 +++--- 5 files changed, 313 insertions(+), 120 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 85fa155..3a13d4d 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -112,8 +112,8 @@ program artemis_executable call generator%set_materials( & structure_lw = struc1_bas, structure_up = struc2_bas, & use_pricel_lw = lw_use_pricel, use_pricel_up = up_use_pricel, & - elastic_constants_lw = [ lw_bulk_modulus ], & - elastic_constants_up = [ up_bulk_modulus ] & + elastic_lw = reshape([ lw_bulk_modulus ], shape=[1,1]), & + elastic_up = reshape([ up_bulk_modulus ], shape=[1,1]) & ) call generator%set_surface_properties( & miller_lw = lw_mplane, miller_up = up_mplane, & diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index 1e2e372..da18fee 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -1358,14 +1358,14 @@ def set_match_method(self, method=None, max_num_matches=None, \ def set_materials(self, structure_lw: Atoms | Geom_Rw.basis = None, structure_up: Atoms | Geom_Rw.basis = None, - elastic_constants_lw=None, - elastic_constants_up=None, + elastic_lw=None, + elastic_up=None, use_pricel_lw=None, use_pricel_up=None ): """ set_materials__binding__artemis_gen_type(self, structure_lw, \ - structure_up[, elastic_constants_lw, elastic_constants_up, use_pricel_lw, \ + structure_up[, elastic_tensor_lw, elastic_tensor_up, use_pricel_lw, \ use_pricel_up]) @@ -1378,8 +1378,8 @@ def set_materials(self, this : Artemis_generator_Type structure_lw : Basis_Type structure_up : Basis_Type - elastic_constants_lw : float array - elastic_constants_up : float array + elastic_lw : float array + elastic_up : float array use_pricel_lw : bool use_pricel_up : bool @@ -1403,10 +1403,38 @@ def set_materials(self, structure_up = geom_rw.basis(atoms=structure_up) structure_up_handle = structure_up._handle + # check if length of elastic is either 1 or 36 or None, else break + if elastic_lw is not None: + if isinstance(elastic_lw, float) or isinstance(elastic_lw, int): + elastic_lw = numpy.array([elastic_lw]) + elif isinstance(elastic_lw, list) or isinstance(elastic_lw, tuple): + elastic_lw = numpy.array(elastic_lw) + if elastic_lw.size != 1 and elastic_lw.size != 36: + raise ValueError("elastic_lw must be either 1 or 36 elements long") + # convert to a 2D array of shape (1,1) or (6,6) + if elastic_lw.size == 1: + elastic_lw = numpy.array([[elastic_lw[0]]], order='F') + else: + elastic_lw = numpy.array(elastic_lw, order='F') + elastic_lw = numpy.reshape(elastic_lw, (6, 6), order='F') + if elastic_up is not None: + if isinstance(elastic_up, float) or isinstance(elastic_up, int): + elastic_up = numpy.array([elastic_up]) + elif isinstance(elastic_up, list) or isinstance(elastic_up, tuple): + elastic_up = numpy.array(elastic_up) + if elastic_up.size != 1 and elastic_up.size != 36: + raise ValueError("elastic_up must be either 1 or 36 elements long") + # convert to a 2D array of shape (1,1) or (6,6) + if elastic_up.size == 1: + elastic_up = numpy.array([[elastic_up[0]]], order='F') + else: + elastic_up = numpy.array(elastic_up, order='F') + elastic_up = numpy.reshape(elastic_up, (6, 6), order='F') + _artemis.f90wrap_intf_gen__set_materials__binding__agt(this=self._handle, \ structure_lw=structure_lw_handle, structure_up=structure_up_handle, \ - elastic_constants_lw=elastic_constants_lw, \ - elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, \ + elastic_lw=elastic_lw, \ + elastic_up=elastic_up, use_pricel_lw=use_pricel_lw, \ use_pricel_up=use_pricel_up) def set_surface_properties(self, miller_lw=None, miller_up=None, \ @@ -1793,9 +1821,9 @@ def structure_up(self, structure_up): structure_up) @property - def elastic_constants_lw(self): + def elastic_tensor_lw(self): """ - Element elastic_constants_lw ftype=real(real32) pytype=float + Element elastic_tensor_lw ftype=real(real32) pytype=float Defined at \ @@ -1810,23 +1838,23 @@ def elastic_constants_lw(self): return None if array_handle in self._arrays: - elastic_constants_lw = self._arrays[array_handle] + elastic_tensor_lw = self._arrays[array_handle] else: - elastic_constants_lw = \ + elastic_tensor_lw = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, _artemis.f90wrap_artemis_gen_type__array__elastic_co4c3f) - self._arrays[array_handle] = elastic_constants_lw - return elastic_constants_lw + self._arrays[array_handle] = elastic_tensor_lw + return elastic_tensor_lw - @elastic_constants_lw.setter - def elastic_constants_lw(self, elastic_constants_lw): - self.elastic_constants_lw[...] = elastic_constants_lw + @elastic_tensor_lw.setter + def elastic_tensor_lw(self, elastic_tensor_lw): + self.elastic_tensor_lw[...] = elastic_tensor_lw @property - def elastic_constants_up(self): + def elastic_tensor_up(self): """ - Element elastic_constants_up ftype=real(real32) pytype=float + Element elastic_tensor_up ftype=real(real32) pytype=float Defined at \ @@ -1841,18 +1869,18 @@ def elastic_constants_up(self): return None if array_handle in self._arrays: - elastic_constants_up = self._arrays[array_handle] + elastic_tensor_up = self._arrays[array_handle] else: - elastic_constants_up = \ + elastic_tensor_up = \ f90wrap.runtime.get_array(f90wrap.runtime.sizeof_fortran_t, self._handle, _artemis.f90wrap_artemis_gen_type__array__elastic_coedb6) - self._arrays[array_handle] = elastic_constants_up - return elastic_constants_up + self._arrays[array_handle] = elastic_tensor_up + return elastic_tensor_up - @elastic_constants_up.setter - def elastic_constants_up(self, elastic_constants_up): - self.elastic_constants_up[...] = elastic_constants_up + @elastic_tensor_up.setter + def elastic_tensor_up(self, elastic_tensor_up): + self.elastic_tensor_up[...] = elastic_tensor_up @property def use_pricel_lw(self): @@ -2446,10 +2474,10 @@ def __str__(self): ret.append(repr(self.structure_lw)) ret.append(',\n structure_up : ') ret.append(repr(self.structure_up)) - ret.append(',\n elastic_constants_lw : ') - ret.append(repr(self.elastic_constants_lw)) - ret.append(',\n elastic_constants_up : ') - ret.append(repr(self.elastic_constants_up)) + ret.append(',\n elastic_tensor_lw : ') + ret.append(repr(self.elastic_tensor_lw)) + ret.append(',\n elastic_tensor_up : ') + ret.append(repr(self.elastic_tensor_up)) ret.append(',\n use_pricel_lw : ') ret.append(repr(self.use_pricel_lw)) ret.append(',\n use_pricel_up : ') diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 76f3ca6..5114b43 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -19,8 +19,8 @@ module artemis__generator use artemis__geom_utils, only: planecutter, primitive_lat, ortho_axis,& shift_region, set_vacuum, transformer, shifter, reducer, & get_min_bulk_bond, get_min_bond, get_shortest_bond, bond_type, & - share_strain, MATNORM, basis_stack, compare_stoichiometry, & - get_primitive_cell + share_strain_scalar, share_strain_tensor, MATNORM, & + basis_stack, compare_stoichiometry, get_primitive_cell use artemis__sym, only: confine_type, gldfnd use artemis__terminations, only: get_termination_info, term_arr_type, & set_layer_tol, build_slab_supercell, cut_slab_to_height @@ -38,7 +38,7 @@ module artemis__generator !! Interface generator type type(basis_type) :: structure_lw, structure_up !! Lower and upper bulk structures - real(real32), dimension(:), allocatable :: elastic_constants_lw, elastic_constants_up + real(real32), dimension(:,:), allocatable :: elastic_tensor_lw, elastic_tensor_up !! Elastic constants for the lower and upper bulk structures logical :: use_pricel_lw = .true., use_pricel_up = .true. !! Use primitive cell for lower and upper bulk structures @@ -321,39 +321,39 @@ end function get_all_structures_shift !############################################################################### - function get_structure_shift(this, idx) result(output) - !! Get the shifts for a specific structure - implicit none + function get_structure_shift(this, idx) result(output) + !! Get the shifts for a specific structure + implicit none - ! Arguments - class(artemis_generator_type), intent(in) :: this - !! Instance of artemis generator type - integer, intent(in) :: idx - !! Index of the structure + ! Arguments + class(artemis_generator_type), intent(in) :: this + !! Instance of artemis generator type + integer, intent(in) :: idx + !! Index of the structure - real(real32), dimension(3) :: output - !! Shift data + real(real32), dimension(3) :: output + !! Shift data - output = this%structure_data(idx)%shift + output = this%structure_data(idx)%shift - end function get_structure_shift + end function get_structure_shift !############################################################################### !############################################################################### - subroutine clear_structures(this) - !! Clear the structures - implicit none + subroutine clear_structures(this) + !! Clear the structures + implicit none - ! Arguments - class(artemis_generator_type), intent(inout) :: this - !! Instance of artemis generator type + ! Arguments + class(artemis_generator_type), intent(inout) :: this + !! Instance of artemis generator type - if(allocated(this%structure_data)) deallocate(this%structure_data) - if(allocated(this%structures)) deallocate(this%structures) - this%num_structures = 0 + if(allocated(this%structure_data)) deallocate(this%structure_data) + if(allocated(this%structures)) deallocate(this%structures) + this%num_structures = 0 - end subroutine clear_structures + end subroutine clear_structures !############################################################################### @@ -576,7 +576,7 @@ end subroutine set_match_method !############################################################################### subroutine set_materials( & this, structure_lw, structure_up, & - elastic_constants_lw, elastic_constants_up, & + elastic_lw, elastic_up, & use_pricel_lw, use_pricel_up & ) !! Set the materials for the interface generator @@ -589,14 +589,18 @@ subroutine set_materials( & !! Lower bulk structure type(basis_type), intent(in), optional :: structure_up !! Upper bulk structure - real(real32), dimension(:), intent(in), optional :: elastic_constants_lw + real(real32), dimension(:,:), intent(in), optional :: elastic_lw !! Elastic constants for the lower bulk structure - real(real32), dimension(:), intent(in), optional :: elastic_constants_up + real(real32), dimension(:,:), intent(in), optional :: elastic_up !! Elastic constants for the upper bulk structure logical, intent(in), optional :: use_pricel_lw !! Use primitive cell for lower bulk structure logical, intent(in), optional :: use_pricel_up + ! Local variables + character(len=256) :: err_msg + !! Error message + if(present(structure_lw))then if(structure_lw%natom.gt.0) call this%structure_lw%copy(structure_lw, length=4) @@ -608,15 +612,39 @@ subroutine set_materials( & !--------------------------------------------------------------------------- ! Handle the elastic constants !--------------------------------------------------------------------------- - if(present(elastic_constants_lw))then - if(allocated(this%elastic_constants_lw)) deallocate(this%elastic_constants_lw) - allocate(this%elastic_constants_lw(size(elastic_constants_lw))) - this%elastic_constants_lw = elastic_constants_lw + if(present(elastic_lw))then + if(allocated(this%elastic_tensor_lw)) deallocate(this%elastic_tensor_lw) + select case(size(elastic_lw,dim=1)) + case(1) + allocate(this%elastic_tensor_lw(1,1)) + this%elastic_tensor_lw(1,1) = elastic_lw(1,1) + case(6) + allocate(this%elastic_tensor_lw(6,6)) + this%elastic_tensor_lw(:,:) = elastic_lw + case default + write(err_msg,'(A)') & + "The elastic tensor for the lower bulk structure has incorrect & + &shape. It should have shape (1,1) or (6,6)." + call stop_program(trim(err_msg)) + return + end select end if - if(present(elastic_constants_up))then - if(allocated(this%elastic_constants_up)) deallocate(this%elastic_constants_up) - allocate(this%elastic_constants_up(size(elastic_constants_up))) - this%elastic_constants_up = elastic_constants_up + if(present(elastic_up))then + if(allocated(this%elastic_tensor_up)) deallocate(this%elastic_tensor_up) + select case(size(elastic_up,dim=1)) + case(1) + allocate(this%elastic_tensor_up(1,1)) + this%elastic_tensor_up(1,1) = elastic_up(1,1) + case(6) + allocate(this%elastic_tensor_up(6,6)) + this%elastic_tensor_up(:,:) = elastic_up + case default + write(err_msg,'(A)') & + "The elastic tensor for the upper bulk structure has incorrect & + &shape. It should have shape (1,1) or (6,6)." + call stop_program(trim(err_msg)) + return + end select end if if(present(use_pricel_lw)) this%use_pricel_lw = use_pricel_lw @@ -2096,19 +2124,32 @@ &The gldfnd subroutine could not reproduce a valid primitive & !------------------------------------------------------------------ ! Use the bulk moduli to determine the strain sharing !------------------------------------------------------------------ - if(allocated(this%elastic_constants_lw).and. & - allocated(this%elastic_constants_up))then - select case(size(this%elastic_constants_lw)) + if(allocated(this%elastic_tensor_lw).and. & + allocated(this%elastic_tensor_up))then + if( all(shape(this%elastic_tensor_lw) .ne. & + shape(this%elastic_tensor_up)) )then + write(err_msg,'(A)') & + "Inconsistent representation of elastic constants." + call stop_program(trim(err_msg)) + return + end if + select case(size(this%elastic_tensor_lw)) case(1) - if( abs(this%elastic_constants_lw(1)).gt.0.E0 .and. & - abs(this%elastic_constants_up(1)).gt.0.E0 & + if( abs(this%elastic_tensor_lw(1,1)).gt.0.E0 .and. & + abs(this%elastic_tensor_up(1,1)).gt.0.E0 & )then - call share_strain(slab_lw%lat,slab_up%lat,& - this%elastic_constants_lw(1), & - this%elastic_constants_up(1), & + call share_strain_scalar(slab_lw,slab_up,& + this%elastic_tensor_lw(1,1), & + this%elastic_tensor_up(1,1), & lcompensate = this%compensate_normal & ) end if + case(6) + call share_strain_tensor(slab_lw,slab_up,& + this%elastic_tensor_lw, & + this%elastic_tensor_up, & + lcompensate = this%compensate_normal & + ) case default write(err_msg,'("Elastic constants not yet set up to handle & &the full tensor.")') @@ -2116,8 +2157,8 @@ &The gldfnd subroutine could not reproduce a valid primitive & exit_code_ = 1 return end select - elseif(allocated(this%elastic_constants_lw).neqv. & - allocated(this%elastic_constants_up))then + elseif(allocated(this%elastic_tensor_lw).neqv. & + allocated(this%elastic_tensor_up))then write(err_msg,'(A)') & "Elastic constants not set up for both materials." call stop_program(trim(err_msg)) diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index 81d3d5a..a92867c 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -884,8 +884,6 @@ subroutine transformer(basis, tfmat, map) call move_alloc(new_map,map) end if - - end subroutine transformer !!!############################################################################# @@ -2595,49 +2593,171 @@ end function get_shortest_bond !!!############################################################################# -!!!############################################################################# -!!! shares strain between two lattices -!!!############################################################################# - subroutine share_strain(lat1,lat2,bulk_mod1,bulk_mod2,axis,lcompensate) +!############################################################################### + subroutine share_strain_scalar( & + basis1, basis2, & + bulk_mod1, bulk_mod2, & + axis, lcompensate & + ) + !! Share strain between two lattices implicit none - integer :: i - integer :: iaxis - real(real32) :: area1,area2,delta1,delta2 - integer, dimension(3) :: abc=(/1,2,3/) - real(real32), dimension(3) :: strain - - real(real32), intent(in) :: bulk_mod1,bulk_mod2 - real(real32), dimension(3,3), intent(inout) :: lat1,lat2 + ! Arguments + type(basis_type), intent(inout) :: basis1, basis2 + !! Structures + real(real32), intent(in) :: bulk_mod1, bulk_mod2 + !! Bulk modulus of the two structures integer, optional, intent(in) :: axis + !! Axis along which to share strain logical, optional, intent(in) :: lcompensate + !! Boolean whether to compensate for the strain in the axis direction - iaxis=3 - if(present(axis)) iaxis=axis + ! Local variables + integer :: i + !! Loop index + integer :: axis_ + !! Axis index + real(real32) :: area1, area2, delta1, delta2 + !! Area of the two lattices + integer, dimension(3) :: abc = [ 1, 2, 3 ] + !! Array to hold the axis indices + real(real32), dimension(3) :: strain + !! Strain vector + + + axis_ = 3 + if(present(axis)) axis_ = axis - abc=cshift(abc,3-iaxis) - area1 = modu(cross(lat1(abc(1),:),lat1(abc(2),:))) - area2 = modu(cross(lat2(abc(1),:),lat2(abc(2),:))) + abc=cshift(abc,3-axis_) + area1 = modu(cross(basis1%lat(abc(1),:),basis1%lat(abc(2),:))) + area2 = modu(cross(basis2%lat(abc(1),:),basis2%lat(abc(2),:))) delta1 = - (1._real32 - area2/area1)/(1._real32 + (area2/area1)*(bulk_mod1/bulk_mod2)) delta2 = - (1._real32 - area1/area2)/(1._real32 + (area1/area2)*(bulk_mod2/bulk_mod1)) write(0,*) "areas", area1,area2 write(0,*) "deltas", delta1,delta2 write(0,*) "modulus", bulk_mod1,bulk_mod2 do i=1,3 - if(i.eq.iaxis) cycle - strain(:) = lat1(i,:)-lat2(i,:) - lat1(i,:) = lat1(i,:) * (1._real32 + delta1) - lat2(i,:) = lat1(i,:) + if(i.eq.axis_) cycle + strain(:) = basis1%lat(i,:)-basis2%lat(i,:) + basis1%lat(i,:) = basis1%lat(i,:) * (1._real32 + delta1) + basis2%lat(i,:) = basis1%lat(i,:) end do if(present(lcompensate))then if(lcompensate)then - lat1(abc(3),:) = lat1(abc(3),:) * (1._real32 - delta1/(1._real32 + delta1)) - lat2(abc(3),:) = lat2(abc(3),:) * (1._real32 - delta2/(1._real32 + delta2)) + basis1%lat(abc(3),:) = basis1%lat(abc(3),:) * (1._real32 - delta1/(1._real32 + delta1)) + basis2%lat(abc(3),:) = basis2%lat(abc(3),:) * (1._real32 - delta2/(1._real32 + delta2)) end if end if - end subroutine share_strain -!!!############################################################################# + end subroutine share_strain_scalar +!############################################################################### + + +!############################################################################### + subroutine share_strain_tensor( & + basis1, basis2, & + elastic_tensor1, elastic_tensor2, & + axis, lcompensate & + ) + !! Share strain between two lattices + implicit none + + ! Arguments + type(basis_type), intent(inout) :: basis1, basis2 + !! Structures + real(real32), dimension(6,6), intent(in) :: elastic_tensor1, elastic_tensor2 + !! Elastic tensors of the two structures + integer, optional, intent(in) :: axis + !! Axis along which to compensate strain + logical, optional, intent(in) :: lcompensate + !! Boolean whether to compensate for the strain in the axis direction + + ! Local variables + integer :: i, j, a1, a2, a3, axis_ + real(real32) :: s, s_opt, e_total, e_total_min + logical :: lcompensate_ + integer, dimension(3) :: abc = [1, 2, 3] + real(real32), dimension(3,3) :: def_mat, F + real(real32), dimension(2,2) :: A, B, Finv + real(real32), dimension(3,3) :: strain_tensor, ident + real(real32), dimension(6) :: strain1_voigt, strain2_voigt + real(real32) :: e1, e2, total_area + + ! Initialise optional arguments + axis_ = 3 + lcompensate_ = .false. + if (present(axis)) axis_ = axis + if (present(lcompensate)) lcompensate_ = lcompensate + + ! Align axes so interface is in a1-a2 plane + abc = cshift(abc, 3 - axis_) + a1 = abc(1); a2 = abc(2); a3 = abc(3) + + ! Get in-plane lattice vectors + A = basis1%lat([a1,a2], [a1,a2]) + B = basis2%lat([a1,a2], [a1,a2]) + + ! Compute deformation gradient from basis1 to basis2 + Finv = inverse(A) + F = 0._real32 + F(1:2,1:2) = matmul(B, Finv) + F(3,3) = 1._real32 + + ! Compute symmetric strain tensor: ε = 0.5 * (FᵀF - I) + def_mat = matmul(transpose(F), F) + ident = 0._real32 + ident(1,1) = 1._real32; ident(2,2) = 1._real32; ident(3,3) = 1._real32 + strain_tensor = 0.5_real32 * (def_mat - ident) + + ! Total interface strain (applied to both): convert to Voigt + strain1_voigt = 0._real32 + strain2_voigt = 0._real32 + strain1_voigt(1) = strain_tensor(a1,a1) + strain1_voigt(2) = strain_tensor(a2,a2) + strain1_voigt(6) = 2._real32 * strain_tensor(a1,a2) + strain2_voigt = strain1_voigt ! same total strain + + ! Optimise strain split between materials + e_total_min = huge(0._real32) + do i = 0, 100 + s = real(i,real32) / 100._real32 + strain1_voigt = s * strain1_voigt + strain2_voigt = (1._real32 - s) * strain2_voigt + e1 = 0.5_real32 * dot_product(strain1_voigt, matmul(elastic_tensor1, strain1_voigt)) + e2 = 0.5_real32 * dot_product(strain2_voigt, matmul(elastic_tensor2, strain2_voigt)) + e_total = e1 + e2 + if (e_total .lt. e_total_min) then + e_total_min = e_total + s_opt = s + end if + end do + + ! Apply optimal strain split + strain1_voigt = s_opt * strain1_voigt + strain2_voigt = (1._real32 - s_opt) * strain2_voigt + + ! Apply to lattices + do i = 1, 2 + basis1%lat(abc(i),:) = basis1%lat(abc(i),:) * (1._real32 + strain1_voigt(i)) + basis2%lat(abc(i),:) = basis2%lat(abc(i),:) * (1._real32 + strain2_voigt(i)) + end do + ! Apply shear via angle (if any) + basis1%lat(a1,:) = basis1%lat(a1,:) + 0.5_real32 * strain1_voigt(6) * basis1%lat(a2,:) + basis2%lat(a2,:) = basis2%lat(a2,:) + 0.5_real32 * strain2_voigt(6) * basis2%lat(a1,:) + + ! Out-of-plane compensation + if (lcompensate_) then + basis1%lat(a3,:) = basis1%lat(a3,:) * (1._real32 - strain1_voigt(1) - strain1_voigt(2)) + basis2%lat(a3,:) = basis2%lat(a3,:) * (1._real32 - strain2_voigt(1) - strain2_voigt(2)) + end if + + ! Print + write(*,'(A,F6.2,A,F6.2,A)') " Strain % shared: ", s_opt*100._real32, "% / ", (1._real32 - s_opt)*100._real32, "%" + write(*,'(A,F10.6)') " Total strain energy: ", e_total_min + + + end subroutine share_strain_tensor +!############################################################################### end module artemis__geom_utils diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 3b639a8..34c29b3 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -140,7 +140,7 @@ subroutine f90wrap_artemis_gen_type__set__structure_up(this, f90wrap_structure_u this_ptr%p%structure_up = structure_up_ptr%p end subroutine f90wrap_artemis_gen_type__set__structure_up -subroutine f90wrap_artemis_gen_type__array__elastic_co4c3f(this, nd, dtype, dshape, dloc) +subroutine f90wrap_artemis_gen_type__array__elastic_tensor_lw(this, nd, dtype, dshape, dloc) use artemis__generator, only: artemis_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none @@ -157,15 +157,15 @@ subroutine f90wrap_artemis_gen_type__array__elastic_co4c3f(this, nd, dtype, dsha nd = 1 dtype = 11 this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%elastic_constants_lw)) then - dshape(1:1) = shape(this_ptr%p%elastic_constants_lw) - dloc = loc(this_ptr%p%elastic_constants_lw) + if (allocated(this_ptr%p%elastic_tensor_lw)) then + dshape(1:2) = shape(this_ptr%p%elastic_tensor_lw) + dloc = loc(this_ptr%p%elastic_tensor_lw) else dloc = 0 end if -end subroutine f90wrap_artemis_gen_type__array__elastic_co4c3f +end subroutine f90wrap_artemis_gen_type__array__elastic_tensor_lw -subroutine f90wrap_artemis_gen_type__array__elastic_coedb6(this, nd, dtype, dshape, dloc) +subroutine f90wrap_artemis_gen_type__array__elastic_tensor_up(this, nd, dtype, dshape, dloc) use artemis__generator, only: artemis_generator_type use, intrinsic :: iso_c_binding, only : c_int implicit none @@ -182,13 +182,13 @@ subroutine f90wrap_artemis_gen_type__array__elastic_coedb6(this, nd, dtype, dsha nd = 1 dtype = 11 this_ptr = transfer(this, this_ptr) - if (allocated(this_ptr%p%elastic_constants_up)) then - dshape(1:1) = shape(this_ptr%p%elastic_constants_up) - dloc = loc(this_ptr%p%elastic_constants_up) + if (allocated(this_ptr%p%elastic_tensor_up)) then + dshape(1:2) = shape(this_ptr%p%elastic_tensor_up) + dloc = loc(this_ptr%p%elastic_tensor_up) else dloc = 0 end if -end subroutine f90wrap_artemis_gen_type__array__elastic_coedb6 +end subroutine f90wrap_artemis_gen_type__array__elastic_tensor_up subroutine f90wrap_artemis_gen_type__get__use_pricel_lw(this, f90wrap_use_pricel_lw) use artemis__generator, only: artemis_generator_type @@ -1286,7 +1286,7 @@ end subroutine f90wrap_intf_gen__set_match_method__binding__agt ! Material and surface property procedures !############################################################################### subroutine f90wrap_intf_gen__set_materials__binding__agt(this, structure_lw, structure_up, & - elastic_constants_lw, elastic_constants_up, use_pricel_lw, use_pricel_up, n0, n1) + elastic_lw, elastic_up, use_pricel_lw, use_pricel_up, n0, n1, n2, n3) use artemis__generator, only: artemis_generator_type use artemis__geom_rw, only: basis_type implicit none @@ -1303,21 +1303,25 @@ subroutine f90wrap_intf_gen__set_materials__binding__agt(this, structure_lw, str integer, intent(in), optional, dimension(2) :: structure_lw type(basis_type_ptr_type) :: structure_up_ptr integer, intent(in), optional, dimension(2) :: structure_up - real(4), intent(in), optional, dimension(n0) :: elastic_constants_lw - real(4), intent(in), optional, dimension(n1) :: elastic_constants_up + real(4), intent(in), optional, dimension(n0,n1) :: elastic_lw + real(4), intent(in), optional, dimension(n2,n3) :: elastic_up logical, intent(in), optional :: use_pricel_lw logical, intent(in), optional :: use_pricel_up integer :: n0 - !f2py intent(hide), depend(elastic_constants_lw) :: n0 = shape(elastic_constants_lw,0) + !f2py intent(hide), depend(elastic_lw) :: n0 = shape(elastic_lw,0) integer :: n1 - !f2py intent(hide), depend(elastic_constants_up) :: n1 = shape(elastic_constants_up,0) + !f2py intent(hide), depend(elastic_lw) :: n1 = shape(elastic_lw,1) + integer :: n2 + !f2py intent(hide), depend(elastic_up) :: n2 = shape(elastic_up,0) + integer :: n3 + !f2py intent(hide), depend(elastic_up) :: n3 = shape(elastic_up,1) this_ptr = transfer(this, this_ptr) if(present(structure_lw)) & structure_lw_ptr = transfer(structure_lw, structure_lw_ptr) if(present(structure_up)) & structure_up_ptr = transfer(structure_up, structure_up_ptr) call this_ptr%p%set_materials(structure_lw=structure_lw_ptr%p, structure_up=structure_up_ptr%p, & - elastic_constants_lw=elastic_constants_lw, elastic_constants_up=elastic_constants_up, use_pricel_lw=use_pricel_lw, & + elastic_lw=elastic_lw, elastic_up=elastic_up, use_pricel_lw=use_pricel_lw, & use_pricel_up=use_pricel_up) end subroutine f90wrap_intf_gen__set_materials__binding__agt From 9b564f60112fc5410c99387a8d4db45f3864b952 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 26 May 2025 13:43:53 +0100 Subject: [PATCH 135/137] Fix shifting --- src/fortran/lib/mod_generator.f90 | 16 ++++++------ src/fortran/lib/mod_geom_utils.f90 | 31 ++++++++++++++++++------ src/fortran/lib/mod_shifting.f90 | 39 +++++++++++++++--------------- 3 files changed, 52 insertions(+), 34 deletions(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 5114b43..954765f 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -1231,22 +1231,22 @@ subroutine generate_interfaces_from_existing( & if(.not.allocated(this%structures)) allocate(this%structures(0)) - min_bond1=huge(0._real32) - min_bond2=huge(0._real32) + min_bond1 = huge(0._real32) + min_bond2 = huge(0._real32) if(present(interface_location))then intf%axis = this%axis intf%loc = interface_location else - intf=get_interface(structure,this%axis) - intf%loc=intf%loc/modu(structure%lat(intf%axis,:)) + intf = get_interface(structure,this%axis) + intf%loc = intf%loc/modu(structure%lat(intf%axis,:)) if(verbose_.gt.0) write(*,*) "interface axis:",intf%axis if(verbose_.gt.0) write(*,*) "interface loc:",intf%loc end if - specloop1: do is=1,structure%nspec - atomloop1: do ia=1,structure%spec(is)%num + specloop1: do is = 1, structure%nspec + atomloop1: do ia = 1, structure%spec(is)%num - specloop2: do js=1,structure%nspec - atomloop2: do ja=1,structure%spec(js)%num + specloop2: do js = 1, structure%nspec + atomloop2: do ja = 1, structure%spec(js)%num if(is.eq.js.and.ia.eq.ja) cycle atomloop2 if( & ( structure%spec(is)%atom(ia,intf%axis).gt.intf%loc(1).and.& diff --git a/src/fortran/lib/mod_geom_utils.f90 b/src/fortran/lib/mod_geom_utils.f90 index a92867c..0180bf5 100644 --- a/src/fortran/lib/mod_geom_utils.f90 +++ b/src/fortran/lib/mod_geom_utils.f90 @@ -1866,6 +1866,7 @@ function split_bas(inbas,loc_vec,axis,lall_same_nspec,map1,map2) result(bas_arr) regionloop1: do i=1,nregions bas_arr(i)%natom = 0 bas_arr(i)%nspec = inbas%nspec + bas_arr(i)%lat = inbas%lat write(bas_arr(i)%sysname,'(A,"_region_",I0)') trim(inbas%sysname),i allocate(bas_arr(i)%spec(inbas%nspec)) if(lmap) allocate(map(i)%spec(bas_arr(i)%nspec,maxval(inbas%spec(:)%num),2)) @@ -2324,6 +2325,7 @@ function get_wyckoff(bas,axis) result(wyckoff) type(wyck_spec_type) :: wyckoff integer, intent(in) :: axis type(basis_type), intent(in) :: bas + real(real32), dimension(3) :: tol type l_bulk_type logical, allocatable, dimension(:) :: atom @@ -2337,6 +2339,11 @@ function get_wyckoff(bas,axis) result(wyckoff) !!! Finds upper and lower locations for "slab" and finds atom nearest to the ... !!! ... centre of that region !!!----------------------------------------------------------------------------- + tol = 1.E-1_real32 + do ia = 1, 3 + tol(ia) = tol(ia) / norm2(bas%lat(ia,:)) + end do + minspecloc = minloc(bas%spec(:)%num,mask=bas%spec(:)%num.ne.0,dim=1) minatomloc = minloc(bas%spec(minspecloc)%atom(:,axis),dim=1) nxtatomloc = maxloc(bas%spec(minspecloc)%atom(:,axis),dim=1) @@ -2432,9 +2439,7 @@ function get_wyckoff(bas,axis) result(wyckoff) tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5_real32 ) - if( all( abs(tmp_vec2).lt.1.E-5_real32 ) )then - cycle atom_loop1 - end if + if( all( abs(tmp_vec2).lt.tol ) ) cycle atom_loop1 end do atom_loop2 itmp1 = nxtatomloc @@ -2459,11 +2464,11 @@ function get_wyckoff(bas,axis) result(wyckoff) if(bas%spec(is)%atom(ia,axis).lt.lw_loc2.or.& bas%spec(is)%atom(ia,axis).ge.up_loc2) cycle atom_loop3 tmp_vec1 = bas%spec(is)%atom(ia,:3) + transvec - if( all(bas%spec(is)%atom(:,axis).lt.tmp_vec1(axis)-1.E-5_real32) ) cycle atom_loop3 + if( all(bas%spec(is)%atom(:,axis).lt.tmp_vec1(axis)-tol(axis)) ) cycle atom_loop3 atom_loop4: do ja=1,bas%spec(is)%num tmp_vec2 = tmp_vec1 - bas%spec(is)%atom(ja,:3) tmp_vec2 = tmp_vec2 - ceiling( tmp_vec2 - 0.5_real32 ) - if( all( abs(tmp_vec2).lt.1.E-5_real32 ) )then + if( all( abs(tmp_vec2).lt.tol ) )then cycle atom_loop3 end if end do atom_loop4 @@ -2482,10 +2487,21 @@ function get_wyckoff(bas,axis) result(wyckoff) !!----------------------------------------------------------------------- exit region_loop1 - end do region_loop1 + !--------------------------------------------------------------------------- + ! Apply tolerances to the bulk cell + !--------------------------------------------------------------------------- + do is = 1, bas%nspec + do ia = 1, bas%spec(is)%num + if(bas%spec(is)%atom(ia,axis) + tol(axis).ge.lw_loc.and.& + bas%spec(is)%atom(ia,axis) - tol(axis).lt.up_loc)then + l_bulk_atoms(is)%atom(ia)=.true. + end if + end do + end do + !!!----------------------------------------------------------------------------- !!! Using the bulk definition, loop runs through checking which atom maps ... @@ -2499,6 +2515,7 @@ function get_wyckoff(bas,axis) result(wyckoff) atom_loop5: do ia=1,bas%spec(is)%num if(l_bulk_atoms(is)%atom(ia))then wyckoff%spec(is)%atom(ia) = ia + cycle atom_loop5 end if !write(0,*) is,ia,l_bulk_atoms(is)%atom(ia) tmp_vec2 = bas%spec(is)%atom(ia,:3) @@ -2517,7 +2534,7 @@ function get_wyckoff(bas,axis) result(wyckoff) tmp_vec3 = tmp_vec3 - ceiling(tmp_vec3 - 0.5_real32) !THIS IS WHERE WE NEED TO MAKE IT RIGHT !! FIND THE GCD AND DIVIDE - if(all(abs(tmp_vec3).lt.1.E-5_real32))then + if(all(abs(tmp_vec3).lt.tol))then if(wyckoff%spec(is)%atom(ja).ne.0)then wyckoff%spec(is)%atom(ia) = wyckoff%spec(is)%atom(ja) else diff --git a/src/fortran/lib/mod_shifting.f90 b/src/fortran/lib/mod_shifting.f90 index 483ef33..f324a50 100644 --- a/src/fortran/lib/mod_shifting.f90 +++ b/src/fortran/lib/mod_shifting.f90 @@ -936,14 +936,14 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& iatom = get_centre_atom(& splitbas(i),is,axis,lw=regions(i,1),up=regions(i,2)) if(iatom.eq.0)& - call err_abort("ERROR: Internal error in get_shifts_DON\n& + call err_abort("Internal error in get_shifts_DON\n& & No centre atom found in get_shifts_DON.",.true.) end if if(lbulk)then if(any(map(i)%spec(is,:splitbas(i)%spec(is)%num,:).le.0))then write(0,'("parent species atom")') write(0,'(2X,I2,6X,I2,4X,I4)') i,is,ia - call err_abort("ERROR: Internal error in get_shifts_DON\n& + call err_abort("Internal error in get_shifts_DON\n& & Mapping of bulk missing",.true.) end if end if @@ -1079,7 +1079,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& !!!----------------------------------------------------------------------------- lpresent=.false. if(present(offset))then - if(offset(axis).ge.0._real32)then + if(offset(axis).ge.1.E-6_real32)then max_sep = max(abs(highest_atom(2)),abs(lowest_atom(1)))*modu(bas%lat(axis,:)) lpresent=.true. end if @@ -1108,21 +1108,23 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& nstep(3) = nstep(3) + 1 end do if(present(offset))then - if(verbose_.ge.1) write(*,'(1X,"user-defined offset:",3(3X,F7.3))') offset - add = -1.0 - do i=1,3 - if(offset(i).ge.0._real32)then - nstep(i) = 1 - add(i) = offset(i) - end if - end do + if(offset(axis).ge.1.E-6_real32)then + if(verbose_.ge.1) write(*,'(1X,"user-defined offset:",3(3X,F7.3))') offset + add = -1.0 + do i=1,3 + if(offset(i).ge.0._real32)then + nstep(i) = 1 + add(i) = offset(i) + end if + end do - do i=1,3 - if(add(i).lt.0.0)then - add(i) = 0.0 - end if - end do - add(axis) = add(axis)/modu(bas%lat(axis,:)) + do i=1,3 + if(add(i).lt.0.0)then + add(i) = 0.0 + end if + end do + add(axis) = add(axis)/modu(bas%lat(axis,:)) + end if end if !nthreads=8 @@ -1142,7 +1144,6 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& end if if(any(nstep(:).le.0))then - write(0,*) "ERROR: Internal error in get_shifts_DON" write(0,*) "nstep:",nstep write(0,*) "ngrid:",ngrid call err_abort_print_struc(splitbas(1),"lw_term.vasp",& @@ -1281,7 +1282,7 @@ function get_shifts_DON(bas,axis,intf_loc,nstore,tol_sym,c_scale,offset,& !!! Checks whether any shifts have been identified !!!----------------------------------------------------------------------------- if(all(shift_store.eq.0))then - call err_abort("ERROR: Internal error in get_shifts_DON\n& + call err_abort("Internal error in get_shifts_DON\n& & No shifts found.",.true.) end if From 1910e49ca85569d6e812ef47d1c535b39a10213e Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Mon, 26 May 2025 14:22:23 +0100 Subject: [PATCH 136/137] Fix memory error --- src/fortran/lib/mod_generator.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/fortran/lib/mod_generator.f90 b/src/fortran/lib/mod_generator.f90 index 954765f..d456012 100644 --- a/src/fortran/lib/mod_generator.f90 +++ b/src/fortran/lib/mod_generator.f90 @@ -2443,7 +2443,11 @@ subroutine generate_shifts_and_swaps( & struc_data_shift%shift = toffset this%structures = [ this%structures, tbas ] this%num_structures = size(this%structures, dim = 1) - this%structure_data = [ this%structure_data, struc_data_shift ] + if(.not.allocated(this%structure_data))then + this%structure_data = [ struc_data_shift ] + else + this%structure_data = [ this%structure_data, struc_data_shift ] + end if if(this%num_structures.ge.this%max_num_structures) return From 503d9a699b6d73ce1e67ead65c8d96de4d852955 Mon Sep 17 00:00:00 2001 From: Ned Taylor <71959356+nedtaylor@users.noreply.github.com> Date: Tue, 26 Aug 2025 12:36:57 +0100 Subject: [PATCH 137/137] Improve argument documentation --- docs/source/tutorials/parameters_tutorial.rst | 8 +- src/artemis/artemis.py | 206 +++++++++++++----- src/wrapper/f90wrap_mod_generator.f90 | 4 +- 3 files changed, 162 insertions(+), 56 deletions(-) diff --git a/docs/source/tutorials/parameters_tutorial.rst b/docs/source/tutorials/parameters_tutorial.rst index 07edce6..57b8bc8 100644 --- a/docs/source/tutorials/parameters_tutorial.rst +++ b/docs/source/tutorials/parameters_tutorial.rst @@ -49,8 +49,8 @@ These can be accessed by the following parameters: generator.set_materials( structure_lw=Si, structure_up=Ge, - elastic_constants_lw=6, - elastic_constants_up=12, + elastic_lw=6, + elastic_up=12, use_pricel_lw=True, use_pricel_up=True ) @@ -115,8 +115,8 @@ These tolerances are mostly related to lattice matching. angle_mismatch=0.1, max_length=0.1, max_area=0.1, - max_fit=0.1, - max_extension=0.1 + max_fit=2, + max_extension=2 ) diff --git a/src/artemis/artemis.py b/src/artemis/artemis.py index da18fee..4ec1207 100644 --- a/src/artemis/artemis.py +++ b/src/artemis/artemis.py @@ -4,6 +4,7 @@ import logging import numpy from ase import Atoms +from typing import Tuple class Geom_Rw(f90wrap.runtime.FortranModule): """ @@ -1043,7 +1044,7 @@ def get_all_structures_data(self): # alloc=True) return output - def get_structure_data(self, idx): + def get_structure_data(self, idx: int): """ output = get_structure_data__binding__artemis_generator_type(self, idx) @@ -1111,7 +1112,7 @@ def get_all_structures_mismatch(self): _artemis.f90wrap_intf_gen__get_all_structures_mismatch__binding_agt(this=self._handle) return output - def get_structure_mismatch(self, idx): + def get_structure_mismatch(self, idx: int): """ output = get_structure_mismatch__binding__artemis_generator_type(self, idx) @@ -1157,7 +1158,7 @@ def get_all_structures_transform(self): _artemis.f90wrap_intf_gen__get_all_structures_transform__binding_agt(this=self._handle) return output - def get_structure_transform(self, idx): + def get_structure_transform(self, idx: int): """ output = get_structure_transform__binding__artemis_generator_type(self, idx) @@ -1199,11 +1200,13 @@ def get_all_structures_shift(self): output : float array """ + # get number of structures + num_structures = self.num_structures output = \ - _artemis.f90wrap_intf_gen__get_all_structures_shift__binding_agt(this=self._handle) + _artemis.f90wrap_intf_gen__get_all_structures_shift__binding_agt(this=self._handle, n0=num_structures) return output - def get_structure_shift(self, idx): + def get_structure_shift(self, idx: int): """ output = get_structure_shifts__binding__artemis_generator_type(self, idx) @@ -1227,9 +1230,18 @@ def get_structure_shift(self, idx): idx=idx) return output - def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ - area_mismatch=None, max_length=None, max_area=None, max_fit=None, \ - max_extension=None, angle_weight=None, area_weight=None): + def set_tolerance( + self, + vector_mismatch: float = None, + angle_mismatch: float = None, + area_mismatch: float = None, + max_length: float = None, + max_area: float = None, + max_fit: int = None, + max_extension: int = None, + angle_weight: float = None, + area_weight: float = None + ): """ set_tolerance__binding__artemis_gen_type(self[, vector_mismatch, \ angle_mismatch, area_mismatch, max_length, max_area, max_fit, max_extension, \ @@ -1252,17 +1264,29 @@ def set_tolerance(self, vector_mismatch=None, angle_mismatch=None, \ max_extension : int angle_weight : float area_weight : float - + """ - _artemis.f90wrap_intf_gen__set_tolerance__bindind_agt(this=self._handle, \ + if max_extension is not None and not isinstance(max_extension, int): + raise TypeError("max_extension must be an int") + if max_fit is not None and not isinstance(max_fit, int): + raise TypeError("max_fit must be an int") + + _artemis.f90wrap_intf_gen__set_tolerance__binding_agt(this=self._handle, \ vector_mismatch=vector_mismatch, angle_mismatch=angle_mismatch, \ area_mismatch=area_mismatch, max_length=max_length, max_area=max_area, \ max_fit=max_fit, max_extension=max_extension, angle_weight=angle_weight, \ area_weight=area_weight) - def set_shift_method(self, method: int =None, num_shifts: int =None, shifts=None, \ - interface_depth=None, separation_scale=None, depth_method=None, \ - bondlength_cutoff=None): + def set_shift_method( + self, + method: int = None, + num_shifts: int = None, + shifts: list[float] | numpy.ndarray = None, + interface_depth: float = None, + separation_scale: float = None, + depth_method: int = None, + bondlength_cutoff: float = None + ): """ set_shift_method__binding__artemis_generator_type(self[, method, num_shifts, \ shifts, interface_depth, separation_scale, depth_method, bondlength_cutoff]) @@ -1303,8 +1327,15 @@ def set_shift_method(self, method: int =None, num_shifts: int =None, shifts=None interface_depth=interface_depth, separation_scale=separation_scale, \ depth_method=depth_method, bondlength_cutoff=bondlength_cutoff) - def set_swap_method(self, method=None, num_swaps=None, swap_density=None, \ - swap_depth=None, swap_sigma=None, require_mirror_swaps=None): + def set_swap_method( + self, + method: int = None, + num_swaps: int = None, + swap_density: float = None, + swap_depth: float = None, + swap_sigma: float = None, + require_mirror_swaps: bool = None + ): """ set_swap_method__binding__artemis_generator_type(self[, method, num_swaps, \ swap_density, swap_depth, swap_sigma, require_mirror_swaps]) @@ -1330,8 +1361,14 @@ def set_swap_method(self, method=None, num_swaps=None, swap_density=None, \ swap_depth=swap_depth, swap_sigma=swap_sigma, \ require_mirror_swaps=require_mirror_swaps) - def set_match_method(self, method=None, max_num_matches=None, \ - max_num_terms=None, max_num_planes=None, compensate_normal=None): + def set_match_method( + self, + method: int = None, + max_num_matches: int = None, + max_num_terms: int = None, + max_num_planes: int = None, + compensate_normal: bool = None + ): """ set_match_method__binding__artemis_generator_type(self[, method, \ max_num_matches, max_num_terms, max_num_planes, compensate_normal]) @@ -1355,13 +1392,14 @@ def set_match_method(self, method=None, max_num_matches=None, \ method=method, max_num_matches=max_num_matches, max_num_terms=max_num_terms, \ max_num_planes=max_num_planes, compensate_normal=compensate_normal) - def set_materials(self, - structure_lw: Atoms | Geom_Rw.basis = None, - structure_up: Atoms | Geom_Rw.basis = None, - elastic_lw=None, - elastic_up=None, - use_pricel_lw=None, - use_pricel_up=None + def set_materials( + self, + structure_lw: Atoms | Geom_Rw.basis = None, + structure_up: Atoms | Geom_Rw.basis = None, + elastic_lw: float | list[float] | numpy.ndarray = None, + elastic_up: float | list[float] | numpy.ndarray = None, + use_pricel_lw: bool = None, + use_pricel_up: bool = None ): """ set_materials__binding__artemis_gen_type(self, structure_lw, \ @@ -1437,12 +1475,19 @@ def set_materials(self, elastic_up=elastic_up, use_pricel_lw=use_pricel_lw, \ use_pricel_up=use_pricel_up) - def set_surface_properties(self, miller_lw=None, miller_up=None, \ - is_layered_lw=None, is_layered_up=None, \ - require_stoichiometry_lw=None, require_stoichiometry_up=None, \ - layer_separation_cutoff_lw=None, \ - layer_separation_cutoff_up=None, layer_separation_cutoff=None, \ - vacuum_gap=None): + def set_surface_properties( + self, + miller_lw: list[int] | Tuple[float, float, float] = None, + miller_up: list[int] | Tuple[float, float, float] = None, + is_layered_lw: bool = None, + is_layered_up: bool = None, + require_stoichiometry_lw: bool = None, + require_stoichiometry_up: bool = None, + layer_separation_cutoff_lw: float = None, + layer_separation_cutoff_up: float = None, + layer_separation_cutoff: float = None, + vacuum_gap: float = None + ): """ set_surface_properties__binding__artemis_generator_type(self[, miller_lw, \ miller_up, is_layered_lw, is_layered_up, layer_separation_cutoff_lw, \ @@ -1468,6 +1513,13 @@ def set_surface_properties(self, miller_lw=None, miller_up=None, \ vacuum_gap : float """ + + if miller_lw is not None and len(miller_lw) != 3: + raise ValueError("miller_lw must have exactly three elements") + + if miller_up is not None and len(miller_up) != 3: + raise ValueError("miller_up must have exactly three elements") + _artemis.f90wrap_intf_gen__set_surface_properties__binding__agt(this=self._handle, \ miller_lw=miller_lw, miller_up=miller_up, is_layered_lw=is_layered_lw, \ is_layered_up=is_layered_up, \ @@ -1509,9 +1561,19 @@ def reset_is_layered_up(self): """ _artemis.f90wrap_intf_gen__reset_is_layered_up__binding__agt(this=self._handle) - def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ - thickness=None, orthogonalise=None, normalise=None, break_on_fail=None, - verbose=None, return_exit_code=False, calc=None): + def get_terminations_lw( + self, + miller: list[int] | Tuple[float, float, float] = None, + surface: int = None, + num_layers: int = None, + thickness: float = None, + orthogonalise: bool = None, + normalise: bool = None, + break_on_fail: bool = None, + verbose: int = None, + return_exit_code: bool = False, + calc = None + ): """ Defined at \ @@ -1523,6 +1585,9 @@ def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ exit_code = 0 structures = None + if len(miller) != 3: + raise ValueError("miller must have exactly three elements") + exit_code, n_structs = _artemis.f90wrap_intf_gen__get_terminations__binding__agt(this=self._handle, identifier=1, miller=miller, surface=surface, @@ -1537,15 +1602,25 @@ def get_terminations_lw(self, miller=None, surface=None, num_layers=None, \ structures = geom_rw.basis_array() #.allocate(n_structs) structures.allocate(n_structs) _artemis.f90wrap_retrieve_last_generated_structures(structures._handle) - structures = structures.toase() + structures = structures.toase(calculator=calc) if return_exit_code: return structures, exit_code return structures - def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ - thickness=None, orthogonalise=None, normalise=None, break_on_fail=None, - verbose=None, return_exit_code=False, calc=None): + def get_terminations_up( + self, + miller: list[int] | Tuple[float, float, float] = None, + surface: int = None, + num_layers: int = None, + thickness: float = None, + orthogonalise: bool = None, + normalise: bool = None, + break_on_fail: bool = None, + verbose: int = None, + return_exit_code: bool = False, + calc = None + ): """ Defined at \ @@ -1557,6 +1632,9 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ exit_code = 0 structures = None + if len(miller) != 3: + raise ValueError("miller must have exactly three elements") + exit_code, n_structs = _artemis.f90wrap_intf_gen__get_terminations__binding__agt(this=self._handle, identifier=2, miller=miller, surface=surface, @@ -1571,13 +1649,18 @@ def get_terminations_up(self, miller=None, surface=None, num_layers=None, \ structures = geom_rw.basis_array() #.allocate(n_structs) structures.allocate(n_structs) _artemis.f90wrap_retrieve_last_generated_structures(structures._handle) - structures = structures.toase() + structures = structures.toase(calculator=calc) if return_exit_code: return structures, exit_code return structures - def get_interface_location(self, structure=None, axis=None, return_fractional=False): + def get_interface_location( + self, + structure: Atoms | Geom_Rw.basis, + axis: int = None, + return_fractional: bool = False + ): """ get_interface_location__binding__artemis_gen_type(self, structure, axis) @@ -1617,13 +1700,28 @@ def get_interface_location(self, structure=None, axis=None, return_fractional=Fa return ret_location, ret_axis - def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ - thickness_up=None, num_layers_lw=None, num_layers_up=None, \ - reduce_matches=None, \ - print_lattice_match_info=None, print_termination_info=None, \ - print_shift_info=None, break_on_fail=None, icheck_term_pair=None, \ - interface_idx=None, generate_structures=None, seed=None, verbose=None, \ - return_exit_code=False, calc=None): + def generate( + self, + surface_lw: int = None, + surface_up: int = None, + thickness_lw: float = None, + thickness_up: float = None, + num_layers_lw: int = None, + num_layers_up: int = None, + reduce_matches: bool = None, + print_lattice_match_info: bool = None, + print_termination_info: bool = None, + print_shift_info: bool = None, + break_on_fail: bool = None, + icheck_term_pair: int = None, + interface_idx: int = None, + generate_structures: bool = None, + seed: int = None, + verbose: int = None, + exit_code: int = None, + return_exit_code: bool = False, + calc = None + ): """ generate__binding__artemis_gen_type(self[, surface_lw, \ surface_up, thickness_lw, thickness_up, num_layers_lw, num_layers_up, \ @@ -1639,8 +1737,8 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ Parameters ---------- this : Artemis_generator_Type - surface_lw : int array - surface_up : int array + surface_lw : int + surface_up : int thickness_lw : float thickness_up : float num_layers_lw : int @@ -1680,8 +1778,16 @@ def generate(self, surface_lw=None, surface_up=None, thickness_lw=None, \ return structures, exit_code return structures - def regenerate(self, structure, interface_location=None, print_shift_info=None, \ - seed=None, verbose=None, return_exit_code=False, calc=None): + def regenerate( + self, + structure: Atoms | Geom_Rw.basis, + interface_location: float | None = None, + print_shift_info: bool = None, + seed: int = None, + verbose: int = None, + return_exit_code: bool = False, + calc = None + ): """ restart__binding__artemis_gen_type(self, basis[, \ interface_location, print_shift_info, seed]) diff --git a/src/wrapper/f90wrap_mod_generator.f90 b/src/wrapper/f90wrap_mod_generator.f90 index 34c29b3..dfa470a 100644 --- a/src/wrapper/f90wrap_mod_generator.f90 +++ b/src/wrapper/f90wrap_mod_generator.f90 @@ -1185,7 +1185,7 @@ end subroutine f90wrap_intf_gen__get_structure_shift__binding_agt !############################################################################### ! Generation methods and tolerance handlers !############################################################################### -subroutine f90wrap_intf_gen__set_tolerance__bindind_agt(this, vector_mismatch, angle_mismatch, & +subroutine f90wrap_intf_gen__set_tolerance__binding_agt(this, vector_mismatch, angle_mismatch, & area_mismatch, max_length, max_area, max_fit, max_extension, angle_weight, area_weight) use artemis__generator, only: artemis_generator_type implicit none @@ -1211,7 +1211,7 @@ subroutine f90wrap_intf_gen__set_tolerance__bindind_agt(this, vector_mismatch, a area_mismatch=area_mismatch, max_length=max_length, & max_area=max_area, max_fit=max_fit, max_extension=max_extension, & angle_weight=angle_weight, area_weight=area_weight) -end subroutine f90wrap_intf_gen__set_tolerance__bindind_agt +end subroutine f90wrap_intf_gen__set_tolerance__binding_agt subroutine f90wrap_intf_gen__set_shift_method__binding__agt(this, method, num_shifts, shifts, & interface_depth, separation_scale, depth_method, bondlength_cutoff, n0, n1)