Skip to content

Commit 1dc4a01

Browse files
WenxianLiWenxianLi
committed
Updated version of jj2lsj
1 parent 5f0a443 commit 1dc4a01

15 files changed

+25675
-0
lines changed

‎src/appl/jj2lsj90_2025/Makefile

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
.SUFFIXES: .f90 .mod
2+
3+
# executable :: jj2lsj90
4+
EXE = jj2lsj_2025
5+
BINDIR = ${GRASP}/bin
6+
GRASPLIB = ${GRASP}/lib
7+
BINFILE = $(BINDIR)/$(EXE)
8+
SRCLIBDIR = ../../lib
9+
MODDIR = ${SRCLIBDIR}/libmod
10+
MODL92 = ${SRCLIBDIR}/lib9290
11+
MODLRANG = ${SRCLIBDIR}/librang90
12+
GRASPLIBS = -l9290 -lrang90 -lmod
13+
14+
APP_LIBS = -L ${GRASPLIB} ${GRASPLIBS}
15+
16+
# Define data types
17+
VASTO = ${MODDIR}/vast_kind_param_M.o
18+
19+
# Define Commons
20+
Commons = jj2lsj_data_1_C.o jj2lsj_data_2_C.o jj2lsj_data_3_C.o
21+
22+
# Define memory management module
23+
Memory = ${MODDIR}/memory_man.o
24+
25+
# Define interface to routines from the library
26+
Interface = packLS_I.o getmixblock_I.o idigit_I.o lval_I.o
27+
28+
APP_OBJ = \
29+
packLS.o getmixblock.o idigit.o lval.o \
30+
jj2lsj_code.o jj2lsj2K.o
31+
32+
$(EXE): ${VASTO} ${Commons} ${Memory} ${Interface} $(APP_OBJ)
33+
$(FC) -o $(BINFILE) $(FC_LD) $(Commons) ${Interface} $(APP_OBJ) $(APP_LIBS)
34+
35+
.f90.o:
36+
$(FC) -c $(FC_FLAGS) $< -I $(MODDIR) -I . -I ${MODL92} \
37+
-I ${MODLRANG} -o $@
38+
39+
.f90.mod:
40+
$(FC) -c $(FC_FLAGS) $< -I $(MODDIR) -I . -I ${MODL92} \
41+
-I ${MODLRANG} -o $@
42+
43+
clean:
44+
-rm -f *.o core *.mod
45+
46+
APP_SRC = \
47+
jj2lsj_data_1.f90 jj2lsj_data_2.f90 jj2lsj_data_3.f90 \
48+
jj2lsj_code.f90 jj2lsj2K.f90

‎src/appl/jj2lsj90_2025/ReadMe_diff

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
jj2lsj2K.f90
2+
27d26
3+
< ! Modified by G. Gaigalas Jan 2025 *
4+
45c44
5+
< print *, " (2025)."
6+
---
7+
> print *, " (2024)."
8+
9+
10+
11+
jj2lsj_code.f90
12+
14d13
13+
< ! Modified by G. Gaigalas 2025 *
14+
3013d3011
15+
< ! Modified by G. Gaigalas Jan 2025 *
16+
3039,3041c3037
17+
< !GG begin 2025
18+
< number_plus_1, &
19+
< !GG end 2025
20+
---
21+
> number_plus_1, number_minus_1, &
22+
3095,3099c3091
23+
< !GG begin 2025
24+
< if (N_LS == N_minus + N_plus .and. N_LS == 0) then
25+
< wa = one
26+
< else if (N_LS == N_minus + N_plus .and. N_LS /= 0) then
27+
< !GG end 2025
28+
---
29+
> if (N_LS == N_minus + N_plus) then
30+
3106,3108c3098,3104
31+
< !GG begin 2025
32+
< J_1_i1 = Jcoup(number_plus_1,jj_number)
33+
< !GG end 2025
34+
---
35+
> number_minus_1 = &
36+
> asf_set_LS%csf_set_LS%parent(shell_number-1)%parent_minus
37+
> if (number_minus_1 == 0) then
38+
> number_minus_1 = &
39+
> asf_set_LS%csf_set_LS%parent(shell_number-1)%parent_plus
40+
> end if
41+
> J_1_i1 =JQS(3,number_minus_1,jj_number)-1

‎src/appl/jj2lsj90_2025/getmixblock.f90

Lines changed: 180 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,180 @@
1+
!***********************************************************************
2+
! *
3+
SUBROUTINE GETMIXBLOCK(NAME, NCI)
4+
! *
5+
! Reads mixing coefficient file from block-structured format *
6+
! *
7+
! Note: *
8+
! eav is not compatible with the non-block version if some blocks *
9+
! were not diagonalized *
10+
! *
11+
! This is a modified version of cvtmix.f *
12+
! *
13+
! Written by Per Jonsson, September 2003 *
14+
! Modified by G. Gaigalas, May 2011 *
15+
! *
16+
! Modified by C. Cychen 2021 *
17+
! *
18+
!***********************************************************************
19+
!...Translated by Pacific-Sierra Research 77to90 4.3E 18:32:57 1/ 6/07
20+
!-----------------------------------------------
21+
! M o d u l e s
22+
!-----------------------------------------------
23+
USE vast_kind_param, ONLY: DOUBLE
24+
USE memory_man
25+
USE def_C
26+
USE EIGV_C
27+
USE orb_C
28+
USE prnt_C
29+
USE syma_C
30+
USE iounit_C
31+
USE blk_C, ONLY: NEVINBLK, NCFINBLK, TWO_J
32+
!-----------------------------------------------
33+
! I n t e r f a c e B l o c k s
34+
!-----------------------------------------------
35+
USE openfl_I
36+
IMPLICIT NONE
37+
!-----------------------------------------------
38+
! D u m m y A r g u m e n t s
39+
!-----------------------------------------------
40+
INTEGER , INTENT(IN) :: NCI
41+
CHARACTER(LEN=24), INTENT(IN) :: NAME
42+
!-----------------------------------------------
43+
! L o c a l V a r i a b l e s
44+
!-----------------------------------------------
45+
INTEGER :: K, IERR, IOS, NCFTOT, NVECTOT, NVECSIZ, NBLOCK, I, NVECPAT, &
46+
NCFPAT, NEAVSUM, JB, NB, NCFBLK, NEVBLK, IATJP, IASPA, J
47+
REAL(DOUBLE) :: EAVSUM
48+
integer*8 NVECSIZPAT, NCFTOT_i8, NVECSIZ_i8
49+
CHARACTER(LEN=3) :: STATUS
50+
CHARACTER(LEN=6) :: G92MIX
51+
CHARACTER(LEN=11) :: FORM
52+
CHARACTER(LEN=256) :: FILNAM
53+
!-----------------------------------------------
54+
!
55+
! The .mix file is UNFORMATTED; it must exist
56+
!
57+
K = INDEX(NAME,' ')
58+
IF (NCI == 0) THEN
59+
FILNAM = NAME(1:K-1)//'.cm'
60+
ELSE
61+
FILNAM = NAME(1:K-1)//'.m'
62+
ENDIF
63+
FORM = 'UNFORMATTED'
64+
STATUS = 'OLD'
65+
!
66+
CALL OPENFL (25, FILNAM, FORM, STATUS, IERR)
67+
IF (IERR == 1) THEN
68+
WRITE (ISTDE, *) 'Error when opening', FILNAM
69+
STOP
70+
ENDIF
71+
!
72+
! Check the header of the file; if not as expected, try again
73+
!
74+
READ (25, IOSTAT=IOS) G92MIX
75+
IF (IOS/=0 .OR. G92MIX/='G92MIX') THEN
76+
WRITE (ISTDE, *) 'Not a GRASP92 MIXing Coefficients File;'
77+
CLOSE(25)
78+
STOP
79+
ENDIF
80+
81+
READ (25) NELEC, NCFTOT, NW, NVECTOT, NVECSIZ, NBLOCK
82+
WRITE (*, *) ' nelec = ', NELEC
83+
WRITE (*, *) ' ncftot = ', NCFTOT
84+
WRITE (*, *) ' nw = ', NW
85+
WRITE (*, *) ' nblock = ', NBLOCK
86+
WRITE (*, *)
87+
NCFTOT_i8 = NCFTOT
88+
89+
!***********************************************************************
90+
! Allocate memory for old format data
91+
!***********************************************************************
92+
93+
!GG CALL ALLOC (EVAL, NVECTOT, 'EVAL', 'GETMIXBLOCK')
94+
!GG CALL ALLOC (EVEC, NCFTOT*NVECTOT, 'EVEC', 'GETMIXBLOCK')
95+
!GG CALL ALLOC (IVEC, NVECTOT, 'IVEC', 'GETMIXBLOCK')
96+
!GG CALL ALLOC (IATJPO, NVECTOT, 'IATJPO', 'GETMIXBLOCK')
97+
!GG CALL ALLOC (IASPAR, NVECTOT, 'IASPAR', 'GETMIXBLOCK')
98+
allocate (EVAL(NVECTOT))
99+
allocate (EVEC(NCFTOT_i8*NVECTOT))
100+
allocate (IVEC(NVECTOT))
101+
allocate (IATJPO(NVECTOT))
102+
allocate (IASPAR(NVECTOT))
103+
104+
!***********************************************************************
105+
! Initialize mixing coefficients to zero; others are fine
106+
!***********************************************************************
107+
EVEC(:NVECTOT*NCFTOT_i8) = 0.D0
108+
109+
!***********************************************************************
110+
! Initialize counters and sum registers
111+
!
112+
! nvecpat: total number of eigenstates of the previous blocks
113+
! ncfpat: total number of CSF of the previous blocks
114+
! nvecsizpat: vector size of the previous blocks
115+
! eavsum: sum of diagonal elements of the previous blocks where
116+
! at least one eigenstate is calculated
117+
! neavsum: total number CSF contributing to eavsum
118+
!***********************************************************************
119+
120+
NVECPAT = 0
121+
NCFPAT = 0
122+
NVECSIZPAT = 0
123+
NEAVSUM = 0
124+
EAVSUM = 0.D0
125+
126+
WRITE (*, *) ' block ncf nev 2j+1 parity'
127+
DO JB = 1, NBLOCK
128+
129+
READ (25) NB, NCFBLK, NEVBLK, IATJP, IASPA
130+
WRITE (*, '(5I8)') NB, NCFBLK, NEVBLK, IATJP, IASPA
131+
NEVINBLK(JB) = NEVBLK
132+
NCFINBLK(JB) = NCFBLK
133+
TWO_J(JB) = IATJP - 1
134+
IF (JB /= NB) STOP 'jb .NE. nb'
135+
136+
IF (NEVBLK > 0) THEN
137+
138+
READ (25) (IVEC(NVECPAT + I),I=1,NEVBLK)
139+
! ivec(i) = ivec(i) + ncfpat ! serial # of the state
140+
IATJPO(NVECPAT+1:NEVBLK+NVECPAT) = IATJP
141+
IASPAR(NVECPAT+1:NEVBLK+NVECPAT) = IASPA
142+
143+
READ (25) EAV, (EVAL(NVECPAT+I),I=1,NEVBLK)
144+
145+
! ...Construct the true energy by adding up the average
146+
EVAL(NVECPAT+1:NEVBLK+NVECPAT) = EVAL(NVECPAT+1:NEVBLK+NVECPAT) + &
147+
EAV
148+
! ...For overal (all blocks) average energy
149+
EAVSUM = EAVSUM + EAV*NCFBLK
150+
NEAVSUM = NEAVSUM + NCFBLK
151+
152+
READ (25) ((EVEC(NVECSIZPAT+NCFPAT+I+(J-1)*NCFTOT_i8),I=1,NCFBLK),J=1,&
153+
NEVBLK)
154+
ENDIF
155+
!
156+
NVECPAT = NVECPAT + NEVBLK
157+
NCFPAT = NCFPAT + NCFBLK
158+
NVECSIZPAT = NVECSIZPAT + NEVBLK*NCFTOT_i8
159+
!
160+
END DO
161+
162+
! ...Here eav is the average energy of the blocks where at least
163+
! one eigenstate is calculated. It is not the averge of the
164+
! total Hamiltonian.
165+
166+
EAV = EAVSUM/NEAVSUM
167+
168+
IF (NCFTOT /= NEAVSUM) WRITE (6, *) &
169+
'Not all blocks are diagonalized --- Average E ', 'not correct'
170+
171+
! ...Substrct the overal average energy
172+
EVAL(:NVECTOT) = EVAL(:NVECTOT) - EAV
173+
!
174+
CLOSE(25)
175+
!
176+
NCF = NCFTOT
177+
NVEC = NVECTOT
178+
!
179+
RETURN
180+
END SUBROUTINE GETMIXBLOCK

‎src/appl/jj2lsj90_2025/getmixblock_I.f90

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
MODULE getmixblock_I
2+
INTERFACE
3+
!...Generated by Pacific-Sierra Research 77to90 4.3E 18:32:57 1/ 6/07
4+
SUBROUTINE getmixblock (NAME, NCI)
5+
CHARACTER (LEN = 24), INTENT(IN) :: NAME
6+
INTEGER, INTENT(IN) :: NCI
7+
END SUBROUTINE
8+
END INTERFACE
9+
END MODULE

‎src/appl/jj2lsj90_2025/idigit.f90

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
!***********************************************************************
2+
! *
3+
INTEGER FUNCTION IDIGIT (CST)
4+
! *
5+
! *
6+
! *
7+
!***********************************************************************
8+
!-----------------------------------------------
9+
IMPLICIT NONE
10+
!-----------------------------------------------
11+
! D u m m y A r g u m e n t s
12+
!-----------------------------------------------
13+
CHARACTER , INTENT(IN) :: CST
14+
!-----------------------------------------------
15+
! L o c a l V a r i a b l e s
16+
!-----------------------------------------------
17+
INTEGER :: I
18+
CHARACTER, DIMENSION(0:9) :: CDGT
19+
!-----------------------------------------------
20+
!
21+
DATA CDGT/ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'/
22+
!
23+
DO I = 0, 9
24+
IF (CST /= CDGT(I)) CYCLE
25+
IDIGIT = I
26+
EXIT
27+
END DO
28+
!
29+
RETURN
30+
END FUNCTION IDIGIT

‎src/appl/jj2lsj90_2025/idigit_I.f90

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
MODULE idigit_I
2+
INTERFACE
3+
!...Generated by Pacific-Sierra Research 77to90 4.3E 10:48:52 2/14/04
4+
INTEGER FUNCTION idigit (CST)
5+
CHARACTER (LEN = 1), INTENT(IN) :: CST
6+
END FUNCTION
7+
END INTERFACE
8+
END MODULE

‎src/appl/jj2lsj90_2025/jj2lsj2K.f90

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
!
2+
!***********************************************************************
3+
! *
4+
PROGRAM jj2lsj2K
5+
! *
6+
! This MAIN program controls the transformation of atomic states, *
7+
! which are given in a jj-coupled CSF basis, into an LS-coupled *
8+
! basis. The program requires a jj-coupled basis in standard order *
9+
! where, if both subshells | n j = l-1/2> and | n j = l+1/2> *
10+
! of a given shell (nl) occurs, they always follow successively *
11+
! in this order. The LS-coupled basis, moreover, is given in *
12+
! the same sequence of shells. *
13+
! *
14+
! All LS-jj transformation coefficients are precalculated and *
15+
! 'stored' in the modules rabs_lsj_data_1, rabs_lsj_data_2 and *
16+
! rabs_lsj_data_3. *
17+
! *
18+
! Calls: FACTT, SETISO, JJ2LSJ, starttime, stoptime. *
19+
! *
20+
! Written by G. Gaigalas, *
21+
! NIST May 2011 *
22+
! VILNIUS May 2017 *
23+
! *
24+
! Modified by G. Gaigalas and C. Cychen 2021 *
25+
! Modified by G. Gaigalas 2022 *
26+
! Modified by G. Gaigalas Jan 2024 *
27+
! Modified by G. Gaigalas Jan 2025 *
28+
! *
29+
!***********************************************************************
30+
!-----------------------------------------------
31+
! M o d u l e s
32+
!-----------------------------------------------
33+
USE jj2lsj_code
34+
IMPLICIT NONE
35+
!-----------------------------------------------
36+
! L o c a l V a r i a b l e s
37+
!-----------------------------------------------
38+
integer :: ncount1
39+
!-----------------------------------------------
40+
call starttime (ncount1, 'jj2lsj')
41+
print *, " "
42+
print *, "jj2lsj: Transformation of ASFs from a jj-coupled CSF basis"
43+
print *, " into an LS-coupled CSF basis (Fortran 95 version)"
44+
print *, " (C) Copyright by G. Gaigalas and Ch. F. Fischer,"
45+
print *, " (2025)."
46+
print *, " Input files: name.c, name.(c)m"
47+
print *, " (optional) name.lsj.T"
48+
print *, " Ouput files: name.lsj.lbl,"
49+
print *, " (optional) name.lsj.c, name.lsj.j,"
50+
print *, " name.uni.lsj.lbl, name.uni.lsj.sum,"
51+
print *, " name.lsj.T"
52+
print *, " "
53+
!
54+
! Set up the table of logarithms of factorials
55+
call factt
56+
!
57+
CALL setiso('isodata')
58+
CALL jj2lsj
59+
!
60+
call stoptime (ncount1, 'jj2lsj')
61+
stop
62+
end program jj2lsj2K

0 commit comments

Comments
 (0)