Commit ef0ca40a authored by Daniel Wortmann's avatar Daniel Wortmann

More changes to types

parent 6940229d
......@@ -12,6 +12,8 @@ include("cmake/CompilerConfig.txt")
include("cmake/Generate_Schema.cmake")
add_subdirectory("fleurinput")
include("cmake/Files_and_Targets.txt")
include("cmake/filespecific.cmake")
......@@ -21,7 +23,6 @@ include("cmake/ReportConfig.txt")
#add_subdirectory("inpgen2")
#install(TARGETS fleur inpgen DESTINATION bin)
install(PROGRAMS ${CMAKE_BINARY_DIR}/fleur
CONFIGURATIONS Debug
......
include_directories(include)
add_subdirectory(fleurinput)
set(c_filesInpgen io/xml/inputSchema.h io/xml/dropInputSchema.c)
set(c_filesFleur io/xml/inputSchema.h io/xml/dropInputSchema.c io/xml/xmlInterfaceWrapper.c)
......@@ -56,8 +55,8 @@ set_source_files_properties(${fleur_F77} PROPERTIES Fortran_FORMAT FIXED)
string(REPLACE ";" " " CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${FLEUR_PRECISION_OPTION}")
message("Flags: ${CMAKE_Fortran_FLAGS}")
set(FLEUR_LINK_LIBRARIES "${FLEUR_LINK_LIBRARIES};juDFT")
set(FLEUR_LINK_LIBRARIES "${FLEUR_LINK_LIBRARIES};juDFT;fleurinput")
include_directories("${CMAKE_CURRENT_BINARY_DIR}/fleurinput/modules/fleurinput")
if (${FLEUR_USE_SERIAL})
#Serial executables
add_executable(fleur ${fleur_SRC} ${c_filesFleur})
......
......@@ -14,6 +14,7 @@ CONTAINS
USE m_sort
USE m_types_setup
USE m_types_lapw
USE m_types_kpts
IMPLICIT NONE
......
......@@ -25,7 +25,7 @@ CONTAINS
!
#include"cpp_double.h"
!
USE m_types_setup
USE m_types_fleurinput
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
......
......@@ -4,10 +4,11 @@ project(FLEUR LANGUAGES Fortran)
add_library(fleurinput STATIC
types_coreSpecInput.f90 types_hybrid.f90 types_noco.f90 types_vacuum.f90 fleurinput_read_xml.f90
types_banddos.f90 types_fleurinput_base.f90 types_input.f90 types_oneD.f90 types_wannier.f90
types_cell.f90 types_fleurinput.f90 types_kpts.f90 types_sliceplot.f90 types_sym.f90
types_cell.f90 types_kpts.f90 types_fleurinput.f90 types_sliceplot.f90 types_sym.f90
types_atoms.F90 types_econfig.F90 types_field.F90 types_xcpot.F90 types_enparaXML.f90 types_forcetheo_data.f90
types_xml.f90 calculator.f constants.f90 mpi_bc_tool.F90
)
#Set module directories
include_directories("${CMAKE_CURRENT_BINARY_DIR}/modules/fleurinput")
target_link_libraries(fleurinput juDFT)
set_target_properties(fleurinput PROPERTIES Fortran_MODULE_DIRECTORY modules/fleurinput)
......@@ -15,11 +15,78 @@ MODULE m_mpi_bc_tool
!have the same shape as the one on irank
INTERFACE mpi_bc
MODULE PROCEDURE mpi_bc_int,mpi_bc_int1,mpi_bc_int2,mpi_bc_int3,mpi_bc_int4,mpi_bc_int5
MODULE PROCEDURE mpi_bc_real,mpi_bc_real1,mpi_bc_real2,mpi_bc_real3,mpi_bc_real4,mpi_bc_real5
MODULE PROCEDURE mpi_bc_real33,mpi_bc_real,mpi_bc_real1,mpi_bc_real2,mpi_bc_real3,mpi_bc_real4,mpi_bc_real5
MODULE PROCEDURE mpi_bc_complex,mpi_bc_complex1,mpi_bc_complex2,mpi_bc_complex3,mpi_bc_complex4,mpi_bc_complex5
MODULE PROCEDURE mpi_bc_logical,mpi_bc_logical1,mpi_bc_logical2
END INTERFACE mpi_bc
PUBLIC :: mpi_bc
CONTAINS
SUBROUTINE mpi_bc_logical(i,irank,mpi_comm)
IMPLICIT NONE
LOGICAL,INTENT(INOUT):: i
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(i,1,MPI_LOGICAL,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_logical
SUBROUTINE mpi_bc_logical1(i,irank,mpi_comm)
IMPLICIT NONE
LOGICAL,ALLOCATABLE,INTENT(INOUT) :: i(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(i)
iup=UBOUND(i)
END IF
CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(i)) DEALLOCATE(i)
ALLOCATE(i(ilow(1):iup(1)))
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_LOGICAL,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
#endif
END SUBROUTINE mpi_bc_logical1
SUBROUTINE mpi_bc_logical2(i,irank,mpi_comm)
IMPLICIT NONE
LOGICAL,ALLOCATABLE,INTENT(INOUT) :: i(:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(2),iup(2),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(i)
iup=UBOUND(i)
END IF
CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(i)) DEALLOCATE(i)
ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2)))
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_LOGICAL,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_logical2
SUBROUTINE mpi_bc_int(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,INTENT(INOUT):: i
......@@ -86,6 +153,8 @@ CONTAINS
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int2
SUBROUTINE mpi_bc_int3(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:)
......@@ -168,6 +237,18 @@ CONTAINS
! now the same for reals
!
SUBROUTINE mpi_bc_real33(irank,mpi_comm,r)!Special routine for non-allocatable 3x3 arrays
IMPLICIT NONE
REAL,INTENT(INOUT) :: r(3,3)
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(r,9,MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real33
SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
IMPLICIT NONE
......@@ -182,6 +263,7 @@ CONTAINS
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real
SUBROUTINE mpi_bc_real1(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:)
......
......@@ -149,7 +149,7 @@ MODULE m_types_atoms
call mpi_bc(this%ntypsy,rank,mpi_comm)
call mpi_bc(this%nlhtyp,rank,mpi_comm)
call mpi_bc(this%invsat,rank,mpi_comm)
call mpi_bc(this% l_geo,rank,mpi_comm)
call mpi_bc(this%l_geo,rank,mpi_comm)
call mpi_bc(this%rmt,rank,mpi_comm)
call mpi_bc(this%dx,rank,mpi_comm)
call mpi_bc(this%volmts,rank,mpi_comm)
......@@ -158,13 +158,13 @@ MODULE m_types_atoms
call mpi_bc(this%bmu,rank,mpi_comm)
call mpi_bc(this%pos,rank,mpi_comm)
call mpi_bc(this%taual,rank,mpi_comm)
call mpi_bc(this% namex,rank,mpi_comm)
call mpi_bc(this% icorr,rank,mpi_comm)
call mpi_bc(this% igrd,rank,mpi_comm)
call mpi_bc(this% krla,rank,mpi_comm)
call mpi_bc(this% relcor,rank,mpi_comm)
call mpi_bc(this% relax,rank,mpi_comm)
call mpi_bc(this% nflip,rank,mpi_comm)
!call mpi_bc(this% namex,rank,mpi_comm)
call mpi_bc(this%icorr,rank,mpi_comm)
call mpi_bc(this%igrd,rank,mpi_comm)
call mpi_bc(this%krla,rank,mpi_comm)
call mpi_bc(this%relcor,rank,mpi_comm)
call mpi_bc(this%relax,rank,mpi_comm)
call mpi_bc(this%nflip,rank,mpi_comm)
......
......@@ -32,10 +32,11 @@ MODULE m_types_cell
CONTAINS
PROCEDURE :: init
PROCEDURE :: read_xml=>read_xml_cell
PROCEDURE :: mpi_bc=>mpi_bc_cell
END TYPE t_cell
PUBLIC t_cell
CONTAINS
subroutine mpi_bc(this,mpi_comm,irank)
subroutine mpi_bc_cell(this,mpi_comm,irank)
use m_mpi_bc_tool
class(t_cell),INTENT(INOUT)::this
integer,INTENT(IN):: mpi_comm
......@@ -49,14 +50,14 @@ CONTAINS
call mpi_bc(this%omtil,rank,mpi_comm)
call mpi_bc(this%area,rank,mpi_comm)
call mpi_bc(this%amat,rank,mpi_comm)
call mpi_bc(this%bmat,rank,mpi_comm)
call mpi_bc(this%bbmat,rank,mpi_comm)
call mpi_bc(this%aamat,rank,mpi_comm)
call mpi_bc(rank,mpi_comm,this%amat)
call mpi_bc(rank,mpi_comm,this%bmat)
call mpi_bc(rank,mpi_comm,this%bbmat)
call mpi_bc(rank,mpi_comm,this%aamat)
call mpi_bc(this%z1,rank,mpi_comm)
call mpi_bc(this%vol,rank,mpi_comm)
call mpi_bc(this%volint,rank,mpi_comm)
end subroutine mpi_bc
end subroutine mpi_bc_cell
SUBROUTINE init(cell)
!initialize cell, only input is cell%amat and cell%z1 in case of a film
......
This diff is collapsed.
......@@ -27,7 +27,7 @@ MODULE m_types_fleurinput
CONTAINS
!Subroutine does nothing, only here for copy-paste code...
SUBROUTINE dummy(cell,sym,atoms,input,noco,vacuum,field,&
SUBROUTINE dummy_subroutine_that_should_never_be_used(cell,sym,atoms,input,noco,vacuum,field,&
sliceplot,banddos,hybrid,oneD,coreSpecInput,wann,&
xcpot,forcetheo_data,kpts,enparaXML)
TYPE(t_cell),INTENT(IN)::cell
......@@ -47,6 +47,6 @@ CONTAINS
TYPE(t_forcetheo_data),INTENT(IN)::forcetheo_data
TYPE(t_enparaXML),INTENT(IN)::enparaXML
TYPE(t_kpts),INTENT(IN)::kpts
END SUBROUTINE dummy
END SUBROUTINE
END MODULE m_types_fleurinput
......@@ -23,10 +23,11 @@ CONTAINS
CLASS(t_fleurinput_base),INTENT(OUT):: this
TYPE(t_xml),INTENT(IN) :: xml
END SUBROUTINE read_xml
SUBROUTINE mpi_bc(this,mpi_comm)
SUBROUTINE mpi_bc(this,mpi_comm,irank)
USE m_types_xml
CLASS(t_fleurinput_base),INTENT(INOUT):: this
INTEGER,INTENT(IN) :: mpi_comm
INTEGER,INTENT(IN),OPTIONAL::irank
END SUBROUTINE mpi_bc
END MODULE m_types_fleurinput_base
......
......@@ -103,7 +103,7 @@ CONTAINS
call mpi_bc(this%l_f,rank,mpi_comm)
call mpi_bc(this%eonly,rank,mpi_comm)
call mpi_bc(this%ctail,rank,mpi_comm)
call mpi_bc(this%coretail,rank,mpi_comm)
call mpi_bc(this%coretail_lmax,rank,mpi_comm)
call mpi_bc(this%itmax,rank,mpi_comm)
call mpi_bc(this%minDistance,rank,mpi_comm)
call mpi_bc(this%maxiter,rank,mpi_comm)
......@@ -123,7 +123,6 @@ CONTAINS
call mpi_bc(this%tkb,rank,mpi_comm)
call mpi_bc(this%gauss,rank,mpi_comm)
call mpi_bc(this%l_bmt,rank,mpi_comm)
call mpi_bc(this%scale,rank,mpi_comm)
call mpi_bc(this%kcrel,rank,mpi_comm)
call mpi_bc(this%frcor,rank,mpi_comm)
call mpi_bc(this%lflip,rank,mpi_comm)
......
......@@ -55,7 +55,7 @@ MODULE m_types_sym
END TYPE t_sym
CONTAINS
subroutine mpi_bc(this,mpi_comm,irank)
subroutine mpi_bc_sym(this,mpi_comm,irank)
use m_mpi_bc_tool
class(t_sym),INTENT(INOUT)::this
integer,INTENT(IN):: mpi_comm
......@@ -85,7 +85,7 @@ CONTAINS
call mpi_bc(this%nsym,rank,mpi_comm)
end subroutine mpi_bc
end subroutine mpi_bc_sym
SUBROUTINE read_xml(this,xml)
USE m_types_xml
......
set(fleur_F77 ${fleur_F77}
init/bandstr1.F
init/boxdim.f
init/convn_dim.f
#init/convn_dim.f
init/gtest.f
init/ifft235.f
init/lhcal.f
......
......@@ -519,20 +519,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
DEALLOCATE(kpts%bk,kpts%wtkpt)
ALLOCATE(kpts%bk(3,kpts%nkptf),kpts%wtkpt(kpts%nkptf))
kpts%bk(:,:) = kpts%bkf(:,:)
IF (kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3).NE.kpts%nkptf) THEN
IF(kpts%l_gamma) THEN
kpts%wtkpt = 1.0 / (kpts%nkptf-1)
DO i = 1, kpts%nkptf
IF(ALL(kpts%bk(:,i).EQ.0.0)) THEN
kpts%wtkpt(i) = 0.0
END IF
END DO
ELSE
CALL juDFT_error("nkptf does not match product of nkpt3(i).",calledby="fleur_init")
END IF
ELSE
kpts%wtkpt = 1.0 / kpts%nkptf
END IF
kpts%wtkpt = 1.0 / kpts%nkptf
END IF
......@@ -576,7 +563,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
CALL timestop("stepf")
IF (.NOT.sliceplot%iplot) THEN
IF (mpi%irank.EQ.0) THEN
CALL convn(DIMENSION,atoms,stars)
CALL convn(atoms,stars)
CALL e_field(atoms,DIMENSION,stars,sym,vacuum,cell,input,field%efield)
END IF !(mpi%irank.EQ.0)
END IF
......
......@@ -246,7 +246,7 @@ CONTAINS
CALL timestart("eigen")
vTemp = vTot
CALL timestart("Updating energy parameters")
CALL enpara%update(mpi,atoms,vacuum,input,vToT)
CALL enpara%update(mpi%mpi_comm,atoms,vacuum,input,vToT)
CALL timestop("Updating energy parameters")
CALL eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,DIMENSION,vacuum,input,&
cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inDen,vTemp,vx)
......@@ -408,7 +408,7 @@ CONTAINS
CALL juDFT_end("GW data written. Fleur ends.",mpi%irank)
END IF
CALL enpara%mix(mpi,atoms,vacuum,input,vTot%mt(:,0,:,:),vtot%vacz)
CALL enpara%mix(mpi%mpi_comm,atoms,vacuum,input,vTot%mt(:,0,:,:),vtot%vacz)
field2 = field
! mix input and output densities
......
......@@ -11,6 +11,7 @@
sliceplot,banddos,enpara,xcpot,results,kpts,hybrid,&
oneD,coreSpecInput,wann,l_opti)
USE m_types
USE m_fleurinput_read_xml
USE m_judft
USE m_juDFT_init
USE m_init_wannier_defaults
......@@ -71,6 +72,9 @@
CLASS(t_forcetheo),ALLOCATABLE,INTENT(OUT)::forcetheo
LOGICAL, INTENT(OUT):: l_opti
type(t_enparaXML)::enparaXML
TYPE(t_forcetheo_data)::forcetheo_data
INTEGER, ALLOCATABLE :: xmlElectronStates(:,:)
INTEGER, ALLOCATABLE :: atomTypeSpecies(:)
......@@ -121,7 +125,9 @@
IF (mpi%irank.EQ.0) THEN
CALL fleur_input_read_xml()
CALL fleurinput_read_xml(cell,sym,atoms,input,noco,vacuum,field,&
sliceplot,banddos,hybrid,oneD,coreSpecInput,wann,&
xcpot,forcetheo_data,kpts,enparaXML)
END IF
CALL timestart("postprocessInput")
......
......@@ -225,7 +225,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
! set up parameters for enpara-file
IF ((juDFT_was_argument("-genEnpara")).AND..NOT.l_enpara) THEN
CALL enpara%init(atoms,input%jspins)
CALL enpara%init(atoms%ntype,atoms%nlod,atoms%lmaxd,input%jspins)
enpara%lchange = .TRUE.
enpara%llochg = .TRUE.
......
......@@ -2,6 +2,7 @@ set(fleur_F77 ${fleur_F77}
)
set(fleur_F90 ${fleur_F90}
types/types.F90
types/types_setup.F90
types/types_mat.F90
types/types_xcpot_inbuild.F90
types/types_xcpot_inbuild_nofunction.F90
......@@ -9,6 +10,7 @@ types/types_xcpot_data.F90
types/types_xcpot_libxc.F90
types/types_mpi.F90
types/types_lapw.F90
types/types_enpara.F90
types/types_tlmplm.F90
types/types_misc.F90
types/types_mpimat.F90
......
......@@ -42,7 +42,7 @@ CONTAINS
! bkpt is the k-point given in internal units
!*********************************************************************
USE m_boxdim
USE m_types_setup
USE m_types_fleurinput
IMPLICIT NONE
TYPE(t_cell),INTENT(IN) :: cell
......@@ -125,7 +125,7 @@ CONTAINS
USE m_types_mpi
USE m_sort
USE m_boxdim
USE m_types_setup
USE m_types_fleurinput
USE m_types_kpts
IMPLICIT NONE
......@@ -323,7 +323,7 @@ CONTAINS
CONTAINS
SUBROUTINE priv_lo_basis_setup(lapw,atoms,sym,noco,cell)
USE m_types_setup
USE m_types_fleurinput
IMPLICIT NONE
TYPE(t_lapw),INTENT(INOUT):: lapw
......@@ -362,7 +362,7 @@ CONTAINS
SUBROUTINE lapw_phase_factors(lapw,iintsp,tau,qss,cph)
USE m_constants
USE m_types_setup
USE m_types_fleurinput
IMPLICIT NONE
CLASS(t_lapw),INTENT(in):: lapw
INTEGER,INTENT(IN) :: iintsp
......@@ -383,7 +383,7 @@ CONTAINS
USE m_constants,ONLY: tpi_const,fpi_const
USE m_orthoglo
USE m_ylm
USE m_types_setup
USE m_types_fleurinput
IMPLICIT NONE
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
......
......@@ -8,19 +8,8 @@ MODULE m_types_setup
!*************************************************************
! This module contains definitions for all kind of types
!*************************************************************
USE m_types_cell
USE m_types_sym
USE m_types_banddos
USE m_types_input
USE m_types_sliceplot
USE m_types_oneD
USE m_types_hybrid
USE m_types_noco
use m_types_fleurinput
USE m_types_stars
USE m_types_atoms
USE m_types_sphhar
USE m_types_dimension
USE m_types_vacuum
USE m_types_coreSpecInput
USE m_types_wannier
END MODULE m_types_setup
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment