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
USE m_judft
IMPLICIT NONE
PRIVATE
CHARACTER(len=1),PARAMETER,DIMENSION(0:9):: ch=(/'s','p','d','f','g','h','i','j','k','l'/)
PUBLIC:: find_enpara
CONTAINS
......@@ -16,35 +15,35 @@ CONTAINS
!> 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.
!! 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_mpi
USE m_radsra
USE m_differ
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms
TYPE(t_mpi),INTENT(IN) ::mpi
REAL,INTENT(IN):: vr(:)
IF (nqn>0) e=priv_method1(lo,l,n,jsp,nqn,atoms,mpi,vr)
IF (nqn<0) e=priv_method2(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,e_lo,e_up)
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_mpi
USE m_radsra
USE m_differ
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms
TYPE(t_mpi),INTENT(IN) ::mpi
REAL,INTENT(IN):: vr(:)
......@@ -52,7 +51,7 @@ CONTAINS
INTEGER j,ilo,i
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
LOGICAL start
! ..
......@@ -129,47 +128,28 @@ CONTAINS
rn,d,msh,vrd, e1, f(:,1),f(:,2),ierr)
e = (2.0*e + e1 ) / 3.0
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
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_mpi
USE m_radsra
USE m_differ
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms
TYPE(t_mpi),INTENT(IN) ::mpi
REAL,INTENT(IN):: vr(:)
INTEGER j,ilo,i
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
LOGICAL start
! ..
......@@ -282,25 +262,6 @@ CONTAINS
END IF
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
......@@ -143,13 +143,17 @@ CONTAINS
REAL :: vbar,vz0,rj
INTEGER :: n,jsp,l,ilo,j,ivac
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'/))
l_done = .FALSE.;lo_done=.FALSE.
DO jsp = 1,input%jspins
!$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)
!! First calculate energy paramter from quantum numbers if these are given...
!! l_done stores the index of those energy parameter updated
......@@ -157,7 +161,7 @@ CONTAINS
DO l = 0,3
IF( enpara%qn_el(l,n,jsp).ne.0)THEN
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
enpara%el0(4:,n,jsp) = enpara%el0(3,n,jsp)
l_done(4:,n,jsp) = .TRUE.
......@@ -171,13 +175,28 @@ CONTAINS
l = atoms%llo(ilo,n)
IF( enpara%qn_ello(ilo,n,jsp).NE.0) THEN
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
lo_done(ilo,n,jsp) = .FALSE.
ENDIF
ENDDO
ENDDO ! n
!$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)
IF (enpara%floating) THEN
......@@ -564,4 +583,50 @@ CONTAINS
END DO
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
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