Commit eac502a1 authored by Daniel Wortmann's avatar Daniel Wortmann

Writing of energy paramters no longer in OMP parallel region.Fix for #286

parent 40193d03
...@@ -8,7 +8,6 @@ MODULE m_find_enpara ...@@ -8,7 +8,6 @@ MODULE m_find_enpara
USE m_judft USE m_judft
IMPLICIT NONE IMPLICIT NONE
PRIVATE PRIVATE
CHARACTER(len=1),PARAMETER,DIMENSION(0:9):: ch=(/'s','p','d','f','g','h','i','j','k','l'/)
PUBLIC:: find_enpara PUBLIC:: find_enpara
CONTAINS CONTAINS
...@@ -16,35 +15,35 @@ CONTAINS ...@@ -16,35 +15,35 @@ CONTAINS
!> Function to determine the energy parameter given the quantum number and the potential !> Function to determine the energy parameter given the quantum number and the potential
!! Different schemes are implemented. Nqn (main quantum number) is used as a switch. !! Different schemes are implemented. Nqn (main quantum number) is used as a switch.
!! This code was previously in lodpot.f !! This code was previously in lodpot.f
REAL FUNCTION find_enpara(lo,l,n,jsp,nqn,atoms,mpi,vr)RESULT(e) REAL FUNCTION find_enpara(lo,l,n,jsp,nqn,atoms,mpi,vr,e_lo,e_up)RESULT(e)
USE m_types_setup USE m_types_setup
USE m_types_mpi USE m_types_mpi
USE m_radsra USE m_radsra
USE m_differ USE m_differ
USE m_xmlOutput
USE m_constants USE m_constants
IMPLICIT NONE IMPLICIT NONE
LOGICAL,INTENT(IN):: lo LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms TYPE(t_atoms),INTENT(IN)::atoms
TYPE(t_mpi),INTENT(IN) ::mpi TYPE(t_mpi),INTENT(IN) ::mpi
REAL,INTENT(IN):: vr(:) REAL,INTENT(IN):: vr(:)
IF (nqn>0) e=priv_method1(lo,l,n,jsp,nqn,atoms,mpi,vr) IF (nqn>0) e=priv_method1(lo,l,n,jsp,nqn,atoms,mpi,vr,e_lo,e_up)
IF (nqn<0) e=priv_method2(lo,l,n,jsp,nqn,atoms,mpi,vr) IF (nqn<0) e=priv_method2(lo,l,n,jsp,nqn,atoms,mpi,vr,e_lo,e_up)
END FUNCTION find_enpara END FUNCTION find_enpara
REAL FUNCTION priv_method1(lo,l,n,jsp,nqn,atoms,mpi,vr)RESULT(e) REAL FUNCTION priv_method1(lo,l,n,jsp,nqn,atoms,mpi,vr,e_lo,e_up)RESULT(e)
USE m_types_setup USE m_types_setup
USE m_types_mpi USE m_types_mpi
USE m_radsra USE m_radsra
USE m_differ USE m_differ
USE m_xmlOutput
USE m_constants USE m_constants
IMPLICIT NONE IMPLICIT NONE
LOGICAL,INTENT(IN):: lo LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms TYPE(t_atoms),INTENT(IN)::atoms
TYPE(t_mpi),INTENT(IN) ::mpi TYPE(t_mpi),INTENT(IN) ::mpi
REAL,INTENT(IN):: vr(:) REAL,INTENT(IN):: vr(:)
...@@ -52,7 +51,7 @@ CONTAINS ...@@ -52,7 +51,7 @@ CONTAINS
INTEGER j,ilo,i INTEGER j,ilo,i
INTEGER nodeu,node,ierr,msh INTEGER nodeu,node,ierr,msh
REAL e_up,e_lo,lnd,e1 REAL lnd,e1
REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c
LOGICAL start LOGICAL start
! .. ! ..
...@@ -131,45 +130,26 @@ CONTAINS ...@@ -131,45 +130,26 @@ CONTAINS
ENDIF ENDIF
IF (mpi%irank == 0) THEN
attributes = ''
WRITE(attributes(1),'(i0)') n
WRITE(attributes(2),'(i0)') jsp
WRITE(attributes(3),'(i0,a1)') nqn, ch(l)
WRITE(attributes(4),'(f8.2)') e_lo
WRITE(attributes(5),'(f8.2)') e_up
WRITE(attributes(6),'(f16.10)') e
IF (lo) THEN
CALL writeXMLElementForm('loAtomicEP',(/'atomType ','spin ','branch ',&
'branchLowest ','branchHighest','value '/),&
attributes,RESHAPE((/10,4,6,12,13,5,6,1,3,8,8,16/),(/6,2/)))
ELSE
CALL writeXMLElementForm('atomicEP',(/'atomType ','spin ','branch ',&
'branchLowest ','branchHighest','value '/),&
attributes,RESHAPE((/12,4,6,12,13,5,6,1,3,8,8,16/),(/6,2/)))
ENDIF
WRITE(6,'(a6,i5,i2,a1,a12,f6.2,a3,f6.2,a13,f8.4)') ' Atom',n,nqn,ch(l),' branch from',&
e_lo, ' to',e_up,' htr. ; e_l =',e
ENDIF
END FUNCTION priv_method1 END FUNCTION priv_method1
REAL FUNCTION priv_method2(lo,l,n,jsp,nqn,atoms,mpi,vr)RESULT(e) REAL FUNCTION priv_method2(lo,l,n,jsp,nqn,atoms,mpi,vr,e_lo,e_up)RESULT(e)
USE m_types_setup USE m_types_setup
USE m_types_mpi USE m_types_mpi
USE m_radsra USE m_radsra
USE m_differ USE m_differ
USE m_xmlOutput
USE m_constants USE m_constants
IMPLICIT NONE IMPLICIT NONE
LOGICAL,INTENT(IN):: lo LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms TYPE(t_atoms),INTENT(IN)::atoms
TYPE(t_mpi),INTENT(IN) ::mpi TYPE(t_mpi),INTENT(IN) ::mpi
REAL,INTENT(IN):: vr(:) REAL,INTENT(IN):: vr(:)
INTEGER j,ilo,i INTEGER j,ilo,i
INTEGER nodeu,node,ierr,msh INTEGER nodeu,node,ierr,msh
REAL e_up,e_lo,lnd,e_up_temp,e_lo_temp,large_e_step REAL lnd,e_up_temp,e_lo_temp,large_e_step
REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c
LOGICAL start LOGICAL start
! .. ! ..
...@@ -282,25 +262,6 @@ CONTAINS ...@@ -282,25 +262,6 @@ CONTAINS
END IF END IF
END DO END DO
IF (mpi%irank == 0) THEN
attributes = ''
WRITE(attributes(1),'(i0)') n
WRITE(attributes(2),'(i0)') jsp
WRITE(attributes(3),'(i0,a1)') ABS(nqn), ch(l)
WRITE(attributes(4),'(f16.10)') ldmt
WRITE(attributes(5),'(f16.10)') e
IF (lo) THEN
CALL writeXMLElementForm('heloAtomicEP',(/'atomType ','spin ','branch ',&
'logDerivMT ','value '/),&
attributes(1:5),reshape((/8,4,6,12,5+17,6,1,3,16,16/),(/5,2/)))
ELSE
CALL writeXMLElementForm('heAtomicEP',(/'atomType ','spin ','branch ',&
'logDerivMT ','value '/),&
attributes(1:5),reshape((/10,4,6,12,5+17,6,1,3,16,16/),(/5,2/)))
ENDIF
WRITE (6,'(a7,i3,i2,a1,a12,f7.2,a4,f7.2,a5)') " Atom ",n,nqn,ch(l)," branch, D = ",&
ldmt, " at ",e," htr."
ENDIF
END FUNCTION priv_method2 END FUNCTION priv_method2
END MODULE m_find_enpara END MODULE m_find_enpara
...@@ -143,13 +143,17 @@ CONTAINS ...@@ -143,13 +143,17 @@ CONTAINS
REAL :: vbar,vz0,rj REAL :: vbar,vz0,rj
INTEGER :: n,jsp,l,ilo,j,ivac INTEGER :: n,jsp,l,ilo,j,ivac
CHARACTER(LEN=20) :: attributes(5) CHARACTER(LEN=20) :: attributes(5)
REAL :: e_lo(0:3,atoms%ntype)!Store info on branches to do IO after OMP
REAL :: e_up(0:3,atoms%ntype)
REAL :: elo_lo(atoms%nlod,atoms%ntype)
REAL :: elo_up(atoms%nlod,atoms%ntype)
IF (mpi%irank == 0) CALL openXMLElement('energyParameters',(/'units'/),(/'Htr'/)) IF (mpi%irank == 0) CALL openXMLElement('energyParameters',(/'units'/),(/'Htr'/))
l_done = .FALSE.;lo_done=.FALSE. l_done = .FALSE.;lo_done=.FALSE.
DO jsp = 1,input%jspins DO jsp = 1,input%jspins
!$OMP PARALLEL DO DEFAULT(none) & !$OMP PARALLEL DO DEFAULT(none) &
!$OMP SHARED(atoms,enpara,jsp,l_done,mpi,v,lo_done) & !$OMP SHARED(atoms,enpara,jsp,l_done,mpi,v,lo_done,e_lo,e_up,elo_lo,elo_up) &
!$OMP PRIVATE(n,l,ilo) !$OMP PRIVATE(n,l,ilo)
!! First calculate energy paramter from quantum numbers if these are given... !! First calculate energy paramter from quantum numbers if these are given...
!! l_done stores the index of those energy parameter updated !! l_done stores the index of those energy parameter updated
...@@ -157,7 +161,7 @@ CONTAINS ...@@ -157,7 +161,7 @@ CONTAINS
DO l = 0,3 DO l = 0,3
IF( enpara%qn_el(l,n,jsp).ne.0)THEN IF( enpara%qn_el(l,n,jsp).ne.0)THEN
l_done(l,n,jsp) = .TRUE. l_done(l,n,jsp) = .TRUE.
enpara%el0(l,n,jsp)=find_enpara(.FALSE.,l,n,jsp,enpara%qn_el(l,n,jsp),atoms,mpi,v%mt(:,0,n,jsp)) enpara%el0(l,n,jsp)=find_enpara(.FALSE.,l,n,jsp,enpara%qn_el(l,n,jsp),atoms,mpi,v%mt(:,0,n,jsp),e_lo(l,n),e_up(l,n))
IF( l .EQ. 3 ) THEN IF( l .EQ. 3 ) THEN
enpara%el0(4:,n,jsp) = enpara%el0(3,n,jsp) enpara%el0(4:,n,jsp) = enpara%el0(3,n,jsp)
l_done(4:,n,jsp) = .TRUE. l_done(4:,n,jsp) = .TRUE.
...@@ -171,13 +175,28 @@ CONTAINS ...@@ -171,13 +175,28 @@ CONTAINS
l = atoms%llo(ilo,n) l = atoms%llo(ilo,n)
IF( enpara%qn_ello(ilo,n,jsp).NE.0) THEN IF( enpara%qn_ello(ilo,n,jsp).NE.0) THEN
lo_done(ilo,n,jsp) = .TRUE. lo_done(ilo,n,jsp) = .TRUE.
enpara%ello0(ilo,n,jsp)=find_enpara(.TRUE.,l,n,jsp,enpara%qn_ello(ilo,n,jsp),atoms,mpi,v%mt(:,0,n,jsp)) enpara%ello0(ilo,n,jsp)=find_enpara(.TRUE.,l,n,jsp,enpara%qn_ello(ilo,n,jsp),atoms,mpi,v%mt(:,0,n,jsp),elo_lo(ilo,n),elo_up(ilo,n))
ELSE ELSE
lo_done(ilo,n,jsp) = .FALSE. lo_done(ilo,n,jsp) = .FALSE.
ENDIF ENDIF
ENDDO ENDDO
ENDDO ! n ENDDO ! n
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
IF (mpi%irank==0) THEN
WRITE(6,*)
WRITE(6,*) "Updated energy parameters for spin:",jsp
!Same loop for IO
DO n = 1, atoms%ntype
DO l = 0,3
IF( l_done(l,n,jsp)) CALL priv_write(.FALSE.,l,n,jsp,enpara%qn_el(l,n,jsp),e_lo(l,n),e_up(l,n),enpara%el0(l,n,jsp))
ENDDO ! l
! Now for the lo's
DO ilo = 1, atoms%nlo(n)
l = atoms%llo(ilo,n)
IF( lo_done(ilo,n,jsp)) CALL priv_write(.TRUE.,l,n,jsp,enpara%qn_ello(ilo,n,jsp),elo_lo(l,n),elo_up(l,n),enpara%ello0(ilo,n,jsp))
END DO
END DO
ENDIF
!! Now check for floating energy parameters (not for those with l_done=T) !! Now check for floating energy parameters (not for those with l_done=T)
IF (enpara%floating) THEN IF (enpara%floating) THEN
...@@ -564,4 +583,50 @@ CONTAINS ...@@ -564,4 +583,50 @@ CONTAINS
END DO END DO
END SUBROUTINE calcOutParams END SUBROUTINE calcOutParams
SUBROUTINE priv_write(lo,l,n,jsp,nqn,e_lo,e_up,e)
!subroutine to write energy parameters to output
USE m_xmlOutput
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,jsp,nqn
REAL,INTENT(IN) :: e_lo,e_up,e
CHARACTER(LEN=20) :: attributes(6)
CHARACTER(len=:),ALLOCATABLE:: label
CHARACTER(len=1),PARAMETER,DIMENSION(0:9):: ch=(/'s','p','d','f','g','h','i','j','k','l'/)
attributes = ''
WRITE(attributes(1),'(i0)') n
WRITE(attributes(2),'(i0)') jsp
WRITE(attributes(3),'(i0,a1)') abs(nqn), ch(l)
WRITE(attributes(4),'(f8.2)') e_lo
WRITE(attributes(5),'(f8.2)') e_up
WRITE(attributes(6),'(f16.10)') e
IF (nqn>0) THEN
IF (lo) THEN
label='loAtomicEP'
ELSE
label='atomicEP'
ENDIF
ELSE
IF (lo) THEN
label='heloAtomicEP'
ELSE
label='heAtomicEP'
ENDIF
END IF
CALL writeXMLElementForm(label,(/'atomType ','spin ','branch ',&
'branchLowest ','branchHighest','value '/),&
attributes,RESHAPE((/10,4,6,12,13,5,6,1,3,8,8,16/),(/6,2/)))
IF (lo) THEN
WRITE(6,'(a6,i5,i2,a1,a12,f6.2,a3,f6.2,a13,f8.4)') ' Atom',n,nqn,ch(l),' branch from',&
e_lo, ' to',e_up,' htr. ; e_l(lo) =',e
ELSE
WRITE(6,'(a6,i5,i2,a1,a12,f6.2,a3,f6.2,a13,f8.4)') ' Atom',n,nqn,ch(l),' branch from',&
e_lo, ' to',e_up,' htr. ; e_l =',e
END IF
END SUBROUTINE priv_write
END MODULE m_types_enpara END MODULE m_types_enpara
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