Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

rfinetune + jj2lsj_2022 update #105

Open
wants to merge 5 commits into
base: master
Choose a base branch
from
Open

rfinetune + jj2lsj_2022 update #105

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
61e1397
First version of RFINETUNE
Yanting126 Apr 17, 2023
44934dc
Adds transformation output for rfinetune
gaigalas Apr 17, 2023
1642d85
small formatting fix
gaigalas Apr 17, 2023
5db76d8
binary output format of .T files
jongrumer Apr 21, 2023
b7b850a
installation fix
jongrumer Apr 21, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions src/appl/jj2lsj90/jj2lsj2K.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ PROGRAM jj2lsj2K
! VILNIUS May 2017 *
! *
! Modified by G. Gaigalas and C. Cychen 2021 *
! Modified by G. Gaigalas 2022 *
! *
!***********************************************************************
!-----------------------------------------------
Expand All @@ -39,11 +40,13 @@ PROGRAM jj2lsj2K
print *, "jj2lsj: Transformation of ASFs from a jj-coupled CSF basis"
print *, " into an LS-coupled CSF basis (Fortran 95 version)"
print *, " (C) Copyright by G. Gaigalas and Ch. F. Fischer,"
print *, " (2021)."
print *, " (2022)."
print *, " Input files: name.c, name.(c)m"
print *, " (optional) name.lsj.T"
print *, " Ouput files: name.lsj.lbl,"
print *, " (optional) name.lsj.c, name.lsj.j,"
print *, " name.uni.lsj.lbl, name.uni.lsj.sum"
print *, " name.uni.lsj.lbl, name.uni.lsj.sum,"
print *, " name.lsj.T"
print *, " "
!
! Set up the table of logarithms of factorials
Expand Down
152 changes: 131 additions & 21 deletions src/appl/jj2lsj90/jj2lsj_code.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -168,7 +168,8 @@ MODULE jj2lsj_code
!
!***********************************************************************
! *
SUBROUTINE asf2ls(iw1,ithresh,levmax,IBLKNUM,levels,NCFMIN,NCFMAX)
SUBROUTINE asf2ls(iw1,ithresh,levmax,IBLKNUM,levels,NCFMIN, &
NCFMAX,ioutT)
! *
! Expands an atomic state functions from the same block, *
! which is represented in a jj-coupling CSF basis into a basis *
Expand All @@ -178,6 +179,7 @@ SUBROUTINE asf2ls(iw1,ithresh,levmax,IBLKNUM,levels,NCFMIN,NCFMAX)
! *
! Written by G. Gaigalas, *
! NIST last update: May 2011 *
! Modified by G. Gaigalas 2022 *
! *
!***********************************************************************
!-----------------------------------------------
Expand All @@ -201,31 +203,53 @@ SUBROUTINE asf2ls(iw1,ithresh,levmax,IBLKNUM,levels,NCFMIN,NCFMAX)
!-----------------------------------------------
! D u m m y A r g u m e n t s
!-----------------------------------------------
integer, intent(in) :: iw1, levmax,IBLKNUM
integer, intent(in) :: iw1, levmax,IBLKNUM,ioutT
integer, intent(in) :: NCFMIN, NCFMAX
integer, dimension(:), intent(in) :: ithresh
integer, dimension(Blocks_number,Vectors_number), intent(in) :: levels
!-----------------------------------------------
! L o c a l V a r i a b l e s
!-----------------------------------------------
integer :: jj_number, lev, level, LS_number
integer :: LOC, IMINCOMP
CHARACTER(LEN=18) :: String
integer :: jj_number, lev, level, LS_number, ijj, iLS
integer :: LOC, IMINCOMP, IDUM
real(DOUBLE) :: wa_transformation
real(DOUBLE), dimension(Vectors_number) :: wa
real(DOUBLE), dimension(Vectors_number) :: wb
!-----------------------------------------------
wb = zero
if(ioutT == 1) write(59) ' * Block Number=',IBLKNUM
if(ioutT == 2) then
read(59) String, IDUM
if(String(1:18) /= ' * Block Number=' .or. &
IDUM /= IBLKNUM) then
print*, "Error in transformation file *.lsj.T"
end if
end if
do LS_number = 1, asf_set_LS%csf_set_LS%nocsf
if ((asf_set_LS%csf_set_LS%csf(LS_number)%parity == "+" &
.and. ISPAR(iw1) == 1) .or. &
(asf_set_LS%csf_set_LS%csf(LS_number)%parity == "-" &
if(((LS_number/2000)*2000) == LS_number) &
print*, "LS_number=",LS_number
if ((asf_set_LS%csf_set_LS%csf(LS_number)%parity == "+" &
.and. ISPAR(iw1) == 1) .or. &
(asf_set_LS%csf_set_LS%csf(LS_number)%parity == "-" &
.and. ISPAR(iw1) == -1)) then
wa = zero
do jj_number = NCFMIN, NCFMAX
if(ithresh(jj_number) == 1 .and. &
(asf_set_LS%csf_set_LS%csf(LS_number)%totalJ == &
if(ithresh(jj_number) == 1 .and. &
(asf_set_LS%csf_set_LS%csf(LS_number)%totalJ == &
ITJPO(jj_number)-1)) then
wa_transformation = traLSjj(jj_number,LS_number)
if(ioutT <= 1) &
wa_transformation = traLSjj(jj_number,LS_number)
if(ioutT == 1) write(59) &
jj_number-NCFMIN+1,LS_number,wa_transformation
if(ioutT == 2) then
read(59) ijj, iLS, wa_transformation
if(ijj /= jj_number-NCFMIN+1 .or. &
iLS /= LS_number ) then
print*, "Error in jj2lsj transformation file"
stop
end if
end if
do lev = 1,levmax
level = levels(IBLKNUM,lev)
LOC = (level-1)*NCF
Expand Down Expand Up @@ -1099,8 +1123,8 @@ END SUBROUTINE gettermLS
!
!***********************************************************************
! *
SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
UNIQUE)
SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
UNIQUE,ioutT)
! *
! The input from the screen. *
! *
Expand All @@ -1109,6 +1133,7 @@ SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
! *
! Written by G. Gaigalas, *
! NIST last update: Dec 2015 *
! Modified by G. Gaigalas 2022 *
! *
!***********************************************************************
!-----------------------------------------------
Expand All @@ -1119,23 +1144,26 @@ SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
USE PRNT_C, ONLY: NVEC
USE IOUNIT_C, ONLY: ISTDI, ISTDE
USE CONS_C, ONLY: EPS, ZERO
USE BLK_C, ONLY: NEVINBLK, NBLOCK
USE BLK_C, ONLY: NEVINBLK, NCFINBLK, NBLOCK, TWO_J
USE m_C, ONLY: NCORE
USE def_C, ONLY: Z, NELEC
IMPLICIT NONE
!-----------------------------------------------
! D u m m y A r g u m e n t s
!-----------------------------------------------
integer, intent(out) :: ioutC,ioutj,UNIQUE
integer, intent(out) :: ioutC,ioutj,UNIQUE,ioutT
real(DOUBLE), intent(out) :: THRESH
integer, dimension(Blocks_number), intent(out) :: number_of_levels
integer, dimension(Blocks_number,Vectors_number), intent(out) :: levels
!-----------------------------------------------
! L o c a l V a r i a b l e s
!-----------------------------------------------
integer :: I, II, ISUM, K, NCI, ierr
integer :: NELECDUM, NCFTOTDUM, NWDUM, NBLOCKDUM
integer :: JBDUM, NCFINBLKDUM, NEVINBLKDUM, IATJPDUM
integer :: I, II, ISUM, K, NCI, ierr, JB
integer :: IBlock, number_of_levels_tmp
logical :: yes, fail, GETYN
CHARACTER(LEN=6) :: G92MIX
character(len=24) :: NAME
character(len=256) :: record, util_csl_file
integer, dimension(Blocks_number) :: posi
Expand Down Expand Up @@ -1184,6 +1212,7 @@ SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
THRESH = 0.001D00
ioutC = 0
ioutj = 0
ioutT = 0
DO I = 1, NBLOCK
number_of_levels(I) = NEVINBLK(I)
IF(NEVINBLK(I) /= 0) THEN
Expand Down Expand Up @@ -1253,7 +1282,7 @@ SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
WRITE (ISTDE,'(A,F8.5)') ' should be smaller than:',MINCOMP*0.01
READ *, EPSNEW
ELSE
WRITE (ISTDE,*) " THe maximum of omitted composition can be 100%"
WRITE (ISTDE,*) " The maximum of omitted composition can be 100%"
GO TO 3
END IF
WRITE (ISTDE,*) 'What is the value below which an eigenvector composition'
Expand All @@ -1275,6 +1304,25 @@ SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
ioutj = 0
END IF
END IF
IF(MINCOMP == ZERO) THEN
WRITE (ISTDE,*) &
"Do you need the transformation output file *.lsj.T? (y/n)"
YES = GETYN ()
IF (YES) THEN
ioutT = 1
ELSE
WRITE (ISTDE,*) &
"Will you use the transformation file *.lsj.T? (y/n)"
YES = GETYN ()
IF (YES) THEN
ioutT = 2
ELSE
ioutT = 0
END IF
END IF
ELSE
ioutT = 0
END IF
ENDIF
!
WRITE (ISTDE,*)
Expand Down Expand Up @@ -1335,6 +1383,60 @@ SUBROUTINE inscreen(THRESH,levels,number_of_levels,ioutC,ioutj, &
WRITE (58,'(2X,A6,A,F5.1,A,I3,A,I7)' ) &
NAME(1:K-1),' Z = ',Z ,' NEL = ',NELEC,' NCFG ='! ,asf_set_LS%csf_set_LS%nocsf
ENDIF
!
! Opening the files *.lsj.T and
!
IF(ioutT == 1) THEN
util_csl_file = NAME(1:K-1)//'.lsj'//'.T'
OPEN(59,FILE=util_csl_file,FORM='unformatted',STATUS='NEW', &
IOSTAT=IERR)
if (ierr /= 0) then
print *, 'Error when opening ',util_csl_file
stop
end if
write (59) 'jj2lsj'
write (59) NELEC, NCF, NW, NBLOCK
DO JB = 1, NBLOCK
IATJPDUM = TWO_J(JB) +1
write (59) JB, NCFINBLK(JB), NEVINBLK(JB), IATJPDUM
END DO
ELSE IF(ioutT == 2) THEN
util_csl_file = NAME(1:K-1)//'.lsj'//'.T'
OPEN(59,FILE=util_csl_file,FORM='unformatted',STATUS='OLD', &
IOSTAT=IERR)
IF (IERR /= 0) THEN
print *, 'Error when opening ',util_csl_file
stop
END IF
READ (59, IOSTAT=IERR) G92MIX
IF (IERR/=0 .OR. G92MIX/='jj2lsj') THEN
WRITE (ISTDE, *) 'Not a jj2lsj Transformation File;'
close(59)
stop
ENDIF
READ (59) NELECDUM, NCFTOTDUM, NWDUM, NBLOCKDUM
if(NELECDUM /= NELEC .or. NCFTOTDUM /= NCF .or. NWDUM /= NW &
.or. NBLOCKDUM /= NBLOCK) then
print*, NELEC, NCF, NW, NBLOCK
print*, NELECDUM, NCFTOTDUM, NWDUM, NBLOCKDUM
print*, "Wrong transformation file *.lsj.T"
close(59)
stop
end if
DO JB = 1, NBLOCKDUM
IATJPDUM = TWO_J(JB) +1
read (59) JBDUM, NCFINBLKDUM, NEVINBLKDUM, IATJPDUM
if(JBDUM /= JB .or. NCFINBLKDUM /= NCFINBLK(JB) .or. &
NEVINBLKDUM /= NEVINBLK(JB) .or. &
IATJPDUM /= TWO_J(JB) +1) then
print*, JB,NCFINBLK(JB), NEVINBLK(JB), TWO_J(JB) +1
print*, JBDUM, NCFINBLKDUM, NEVINBLKDUM, IATJPDUM
print*, "Wrong transformation file *.lsj.T"
close(59)
stop
end if
END DO
ENDIF
END SUBROUTINE inscreen
!
!***********************************************************************
Expand Down Expand Up @@ -1451,6 +1553,7 @@ SUBROUTINE jj2lsj
! Written by G. Gaigalas, *
! NIST last update: Dec 2015 *
! Modified by G. Gaigalas, May 2021 *
! Modified by G. Gaigalas 2022 *
! *
!***********************************************************************
!-----------------------------------------------
Expand All @@ -1474,7 +1577,7 @@ SUBROUTINE jj2lsj
! L o c a l V a r i a b l e s
!-----------------------------------------------
!GG NIST
integer :: i, j, jj, ii, string_l, IBLKNUM,ioutC,ioutj,UNIQUE
integer :: i, j, jj, ii, string_l,IBLKNUM,ioutC,ioutj,UNIQUE,ioutT
integer :: level, nocsf_min, lev, string_length
integer :: nocsf_max, sum_nocsf_min, Before_J
!GG NIST
Expand All @@ -1497,7 +1600,8 @@ SUBROUTINE jj2lsj
character(LEN=164), dimension(1:Vectors_number) :: string_CSF
!-----------------------------------------------
Ssms = ZERO; g_j = ZERO; g_JLS = ZERO; Before_J = 0
call inscreen(THRESH,levels,number_of_levels,ioutC,ioutj,UNIQUE)
call inscreen(THRESH,levels,number_of_levels,ioutC,ioutj,UNIQUE, &
ioutT)
allocate(ithresh(NCF))
do IBLKNUM = 1, NBLOCK
if(IBLKNUM == 1) THEN
Expand All @@ -1518,6 +1622,7 @@ SUBROUTINE jj2lsj
end do
if(dabs(sumthrsh) >= dabs(EPSNEW)) ithresh(i) = 1
end do
write(*,*)'The program generates a list of CSFs in LS-coupling'
call setLS(ithresh,NCFMIN,NCFMAX)
!
! output to *.lsj.c
Expand Down Expand Up @@ -1577,8 +1682,13 @@ SUBROUTINE jj2lsj
!
! perform the transformation
!
if(lev == 1) call asf2ls &
(iw(1),ithresh,number_of_levels(IBLKNUM),IBLKNUM,levels,NCFMIN,NCFMAX)
if(lev == 1) then
write(*,*) &
'The program generates a list of transformation matrix'
call asf2ls &
(iw(1),ithresh,number_of_levels(IBLKNUM),IBLKNUM,levels,&
NCFMIN,NCFMAX,ioutT)
end if
!
! output to the screen jj- coupling
print *, "Weights of major contributors to ASF in jj-coupling:"
Expand Down Expand Up @@ -2211,7 +2321,7 @@ SUBROUTINE setLS(ithresh,NCFMIN,NCFMAX)
!
! 4. for each nonequivalent csf_jj find all the csfs_LS
!
! To avoid the dependency on the number of subshells
! To avoid the dependency on the number of subshells
! the recursive subroutine is used
allocate(Li(asf_set_LS%csf_set_LS%nwshells))
allocate(L_i(asf_set_LS%csf_set_LS%nwshells))
Expand Down
1 change: 1 addition & 0 deletions src/tool/BUILDCONF.sh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ rwfnrotate
wfnplot
rwfntotxt
fical
rfinetune
"
# rcsfratip was not being compiled in the original ${MAKEFILE} for some reason.

Expand Down
4 changes: 4 additions & 0 deletions src/tool/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -98,3 +98,7 @@ add_executable(fical fical.f90)
target_link_libraries_Fortran(fical PRIVATE mod 9290)
install(TARGETS fical DESTINATION bin/)

add_executable(rfinetune rfinetune.f90)
target_link_libraries_Fortran(rfinetune PRIVATE mod 9290)
install(TARGETS rfinetune DESTINATION bin/)

7 changes: 5 additions & 2 deletions src/tool/Makefile
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
LIBS=-L ${GRASP}/lib/ -l9290 -lmod
FC_MODULES=-I ${GRASP}/src/lib/lib9290 -I ${GRASP}/src/lib/libmod

all: ${GRASP}/bin/rsave ${GRASP}/bin/lscomp.pl ${GRASP}/bin/rwfnpyplot ${GRASP}/bin/rasfsplit ${GRASP}/bin/rcsfblock ${GRASP}/bin/rcsfmr ${GRASP}/bin/rcsfsplit ${GRASP}/bin/rhfs_lsj ${GRASP}/bin/rlevelseV ${GRASP}/bin/rlevels ${GRASP}/bin/rmixaccumulate ${GRASP}/bin/rmixextract ${GRASP}/bin/rseqenergy ${GRASP}/bin/rseqhfs ${GRASP}/bin/rseqtrans ${GRASP}/bin/rtabhfs ${GRASP}/bin/rtablevels ${GRASP}/bin/rtabtrans1 ${GRASP}/bin/rtabtrans2 ${GRASP}/bin/rtabtransE1 ${GRASP}/bin/rwfnmchfmcdf ${GRASP}/bin/rwfnplot ${GRASP}/bin/rwfnrelabel ${GRASP}/bin/rwfnrotate ${GRASP}/bin/wfnplot ${GRASP}/bin/rwfntotxt ${GRASP}/bin/fical
all: ${GRASP}/bin/rsave ${GRASP}/bin/lscomp.pl ${GRASP}/bin/rwfnpyplot ${GRASP}/bin/rasfsplit ${GRASP}/bin/rcsfblock ${GRASP}/bin/rcsfmr ${GRASP}/bin/rcsfsplit ${GRASP}/bin/rhfs_lsj ${GRASP}/bin/rlevelseV ${GRASP}/bin/rlevels ${GRASP}/bin/rmixaccumulate ${GRASP}/bin/rmixextract ${GRASP}/bin/rseqenergy ${GRASP}/bin/rseqhfs ${GRASP}/bin/rseqtrans ${GRASP}/bin/rtabhfs ${GRASP}/bin/rtablevels ${GRASP}/bin/rtabtrans1 ${GRASP}/bin/rtabtrans2 ${GRASP}/bin/rtabtransE1 ${GRASP}/bin/rwfnmchfmcdf ${GRASP}/bin/rwfnplot ${GRASP}/bin/rwfnrelabel ${GRASP}/bin/rwfnrotate ${GRASP}/bin/wfnplot ${GRASP}/bin/rwfntotxt ${GRASP}/bin/fical ${GRASP}/bin/rfinetune

${GRASP}/bin/rsave: rsave
cp $^ $@
Expand Down Expand Up @@ -87,9 +87,12 @@ ${GRASP}/bin/rwfntotxt: rwfntotxt.o
${GRASP}/bin/fical: fical.o
$(FC) -o $@ $? $(FC_LD) $(LIBS) $(LAPACK_LIBS)

${GRASP}/bin/rfinetune: rfinetune.o
$(FC) -o $@ $? $(FC_LD) $(LIBS) $(LAPACK_LIBS)

%.o: %.f90
$(FC) -c $(FC_FLAGS) $(FC_MODULES) -o $@ $<

clean:
-rm -f ${GRASP}/bin/rsave ${GRASP}/bin/lscomp.pl ${GRASP}/bin/rwfnpyplot ${GRASP}/bin/rasfsplit ${GRASP}/bin/rcsfblock ${GRASP}/bin/rcsfmr ${GRASP}/bin/rcsfsplit ${GRASP}/bin/rhfs_lsj ${GRASP}/bin/rlevelseV ${GRASP}/bin/rlevels ${GRASP}/bin/rmixaccumulate ${GRASP}/bin/rmixextract ${GRASP}/bin/rseqenergy ${GRASP}/bin/rseqhfs ${GRASP}/bin/rseqtrans ${GRASP}/bin/rtabhfs ${GRASP}/bin/rtablevels ${GRASP}/bin/rtabtrans1 ${GRASP}/bin/rtabtrans2 ${GRASP}/bin/rtabtransE1 ${GRASP}/bin/rwfnmchfmcdf ${GRASP}/bin/rwfnplot ${GRASP}/bin/rwfnrelabel ${GRASP}/bin/rwfnrotate ${GRASP}/bin/wfnplot ${GRASP}/bin/rwfntotxt ${GRASP}/bin/fical
-rm -f ${GRASP}/bin/rsave ${GRASP}/bin/lscomp.pl ${GRASP}/bin/rwfnpyplot ${GRASP}/bin/rasfsplit ${GRASP}/bin/rcsfblock ${GRASP}/bin/rcsfmr ${GRASP}/bin/rcsfsplit ${GRASP}/bin/rhfs_lsj ${GRASP}/bin/rlevelseV ${GRASP}/bin/rlevels ${GRASP}/bin/rmixaccumulate ${GRASP}/bin/rmixextract ${GRASP}/bin/rseqenergy ${GRASP}/bin/rseqhfs ${GRASP}/bin/rseqtrans ${GRASP}/bin/rtabhfs ${GRASP}/bin/rtablevels ${GRASP}/bin/rtabtrans1 ${GRASP}/bin/rtabtrans2 ${GRASP}/bin/rtabtransE1 ${GRASP}/bin/rwfnmchfmcdf ${GRASP}/bin/rwfnplot ${GRASP}/bin/rwfnrelabel ${GRASP}/bin/rwfnrotate ${GRASP}/bin/wfnplot ${GRASP}/bin/rwfntotxt ${GRASP}/bin/fical ${GRASP}/bin/rfinetune
-rm -f *.o *.mod
Empty file modified src/tool/fical.f90
100755 → 100644
View file
Open in desktop
Empty file.
Loading