New jj2lsj90_2024 code by G. Gaigalas

src/appl/jj2lsj90_2024/Makefile

@@ -0,0 +1,48 @@
+.SUFFIXES: .f90 .mod
+
+# executable :: jj2lsj90
+EXE = jj2lsj_2024
+BINDIR = ${GRASP}/bin
+GRASPLIB = ${GRASP}/lib
+BINFILE = $(BINDIR)/$(EXE)
+SRCLIBDIR = ../../lib
+MODDIR = ${SRCLIBDIR}/libmod
+MODL92 = ${SRCLIBDIR}/lib9290
+MODLRANG = ${SRCLIBDIR}/librang90
+GRASPLIBS =  -l9290 -lrang90 -lmod
+
+APP_LIBS = -L ${GRASPLIB} ${GRASPLIBS}
+
+#   Define data types
+VASTO = ${MODDIR}/vast_kind_param_M.o
+
+#   Define Commons
+Commons = jj2lsj_data_1_C.o jj2lsj_data_2_C.o jj2lsj_data_3_C.o
+
+#  Define memory management module
+Memory = ${MODDIR}/memory_man.o
+
+#  Define interface to routines from the library
+Interface = packLS_I.o getmixblock_I.o idigit_I.o lval_I.o
+
+APP_OBJ = \
+   packLS.o getmixblock.o idigit.o lval.o \
+   jj2lsj_code.o jj2lsj2K.o
+
+$(EXE): ${VASTO} ${Commons} ${Memory} ${Interface} $(APP_OBJ)
+	$(FC) -o $(BINFILE) $(FC_LD) $(Commons) ${Interface} $(APP_OBJ) $(APP_LIBS)
+
+.f90.o:
+	$(FC) -c $(FC_FLAGS) $< -I $(MODDIR) -I . -I ${MODL92} \
+	-I ${MODLRANG} -o $@
+
+.f90.mod:
+	$(FC) -c $(FC_FLAGS) $< -I $(MODDIR) -I . -I ${MODL92} \
+	-I ${MODLRANG} -o $@
+
+clean:
+	-rm -f *.o core *.mod
+
+APP_SRC =  \
+      jj2lsj_data_1.f90 jj2lsj_data_2.f90 jj2lsj_data_3.f90 \
+      jj2lsj_code.f90 jj2lsj2K.f90

src/appl/jj2lsj90_2024/getmixblock.f90

@@ -0,0 +1,180 @@
+!***********************************************************************
+!                                                                      *
+      SUBROUTINE GETMIXBLOCK(NAME, NCI)
+!                                                                      *
+!   Reads mixing coefficient file from block-structured format         *
+!                                                                      *
+!   Note:                                                              *
+!   eav is not compatible with the non-block version if some blocks    *
+!   were not diagonalized                                              *
+!                                                                      *
+!   This is a modified version of cvtmix.f                             *
+!                                                                      *
+!   Written by Per Jonsson,                           September 2003   *
+!   Modified by G. Gaigalas,                                May 2011   *
+!                                                                      *
+!   Modified by C. Cychen                                       2021   *
+!                                                                      *
+!***********************************************************************
+!...Translated by Pacific-Sierra Research 77to90  4.3E  18:32:57   1/ 6/07
+!-----------------------------------------------
+!   M o d u l e s
+!-----------------------------------------------
+      USE vast_kind_param, ONLY:  DOUBLE
+      USE memory_man
+      USE def_C
+      USE EIGV_C
+      USE orb_C
+      USE prnt_C
+      USE syma_C
+      USE iounit_C
+      USE blk_C,            ONLY: NEVINBLK, NCFINBLK, TWO_J
+!-----------------------------------------------
+!   I n t e r f a c e   B l o c k s
+!-----------------------------------------------
+      USE openfl_I
+      IMPLICIT NONE
+!-----------------------------------------------
+!   D u m m y   A r g u m e n t s
+!-----------------------------------------------
+      INTEGER , INTENT(IN) :: NCI
+      CHARACTER(LEN=24), INTENT(IN) :: NAME
+!-----------------------------------------------
+!   L o c a l   V a r i a b l e s
+!-----------------------------------------------
+      INTEGER :: K, IERR, IOS, NCFTOT, NVECTOT, NVECSIZ, NBLOCK, I, NVECPAT, &
+         NCFPAT, NEAVSUM, JB, NB, NCFBLK, NEVBLK, IATJP, IASPA, J
+      REAL(DOUBLE) :: EAVSUM
+      integer*8 NVECSIZPAT, NCFTOT_i8, NVECSIZ_i8
+      CHARACTER(LEN=3)   :: STATUS
+      CHARACTER(LEN=6)   :: G92MIX
+      CHARACTER(LEN=11)  :: FORM
+      CHARACTER(LEN=256) :: FILNAM
+!-----------------------------------------------
+!
+!   The  .mix  file is UNFORMATTED; it must exist
+!
+      K = INDEX(NAME,' ')
+      IF (NCI == 0) THEN
+         FILNAM = NAME(1:K-1)//'.cm'
+      ELSE
+         FILNAM = NAME(1:K-1)//'.m'
+      ENDIF
+      FORM = 'UNFORMATTED'
+      STATUS = 'OLD'
+!
+      CALL OPENFL (25, FILNAM, FORM, STATUS, IERR)
+      IF (IERR == 1) THEN
+         WRITE (ISTDE, *) 'Error when opening', FILNAM
+         STOP
+      ENDIF
+!
+!   Check the header of the file; if not as expected, try again
+!
+      READ (25, IOSTAT=IOS) G92MIX
+      IF (IOS/=0 .OR. G92MIX/='G92MIX') THEN
+         WRITE (ISTDE, *) 'Not a GRASP92 MIXing Coefficients File;'
+         CLOSE(25)
+         STOP
+      ENDIF
+
+      READ (25) NELEC, NCFTOT, NW, NVECTOT, NVECSIZ, NBLOCK
+      WRITE (*, *) '   nelec  = ', NELEC
+      WRITE (*, *) '   ncftot = ', NCFTOT
+      WRITE (*, *) '   nw     = ', NW
+      WRITE (*, *) '   nblock = ', NBLOCK
+      WRITE (*, *)
+      NCFTOT_i8 = NCFTOT
+
+!***********************************************************************
+! Allocate memory for old format data
+!***********************************************************************
+
+!GG      CALL ALLOC (EVAL, NVECTOT, 'EVAL', 'GETMIXBLOCK')
+!GG      CALL ALLOC (EVEC, NCFTOT*NVECTOT, 'EVEC', 'GETMIXBLOCK')
+!GG      CALL ALLOC (IVEC, NVECTOT, 'IVEC', 'GETMIXBLOCK')
+!GG      CALL ALLOC (IATJPO, NVECTOT, 'IATJPO', 'GETMIXBLOCK')
+!GG      CALL ALLOC (IASPAR, NVECTOT, 'IASPAR', 'GETMIXBLOCK')
+      allocate (EVAL(NVECTOT))
+      allocate (EVEC(NCFTOT_i8*NVECTOT))
+      allocate (IVEC(NVECTOT))
+      allocate (IATJPO(NVECTOT))
+      allocate (IASPAR(NVECTOT))
+
+!***********************************************************************
+! Initialize mixing coefficients to zero; others are fine
+!***********************************************************************
+      EVEC(:NVECTOT*NCFTOT_i8) = 0.D0
+
+!***********************************************************************
+! Initialize counters and sum registers
+!
+!    nvecpat:    total number of eigenstates of the previous blocks
+!    ncfpat:     total number of CSF of the previous blocks
+!    nvecsizpat: vector size of the previous blocks
+!    eavsum:     sum of diagonal elements of the previous blocks where
+!                at least one eigenstate is calculated
+!    neavsum:    total number CSF contributing to eavsum
+!***********************************************************************
+
+      NVECPAT = 0
+      NCFPAT = 0
+      NVECSIZPAT = 0
+      NEAVSUM = 0
+      EAVSUM = 0.D0
+
+      WRITE (*, *) '  block     ncf     nev    2j+1  parity'
+      DO JB = 1, NBLOCK
+
+         READ (25) NB, NCFBLK, NEVBLK, IATJP, IASPA
+         WRITE (*, '(5I8)') NB, NCFBLK, NEVBLK, IATJP, IASPA
+         NEVINBLK(JB) = NEVBLK
+         NCFINBLK(JB) = NCFBLK
+         TWO_J(JB) = IATJP - 1
+         IF (JB /= NB) STOP 'jb .NE. nb'
+
+         IF (NEVBLK > 0) THEN
+
+            READ (25) (IVEC(NVECPAT + I),I=1,NEVBLK)
+               ! ivec(i)   = ivec(i) + ncfpat ! serial # of the state
+            IATJPO(NVECPAT+1:NEVBLK+NVECPAT) = IATJP
+            IASPAR(NVECPAT+1:NEVBLK+NVECPAT) = IASPA
+
+            READ (25) EAV, (EVAL(NVECPAT+I),I=1,NEVBLK)
+
+!           ...Construct the true energy by adding up the average
+            EVAL(NVECPAT+1:NEVBLK+NVECPAT) = EVAL(NVECPAT+1:NEVBLK+NVECPAT) + &
+               EAV
+!           ...For overal (all blocks) average energy
+            EAVSUM = EAVSUM + EAV*NCFBLK
+            NEAVSUM = NEAVSUM + NCFBLK
+
+            READ (25) ((EVEC(NVECSIZPAT+NCFPAT+I+(J-1)*NCFTOT_i8),I=1,NCFBLK),J=1,&
+               NEVBLK)
+         ENDIF
+!
+         NVECPAT = NVECPAT + NEVBLK
+         NCFPAT = NCFPAT + NCFBLK
+         NVECSIZPAT = NVECSIZPAT + NEVBLK*NCFTOT_i8
+!
+      END DO
+
+!     ...Here eav is the average energy of the blocks where at least
+!        one eigenstate is calculated. It is not the averge of the
+!        total Hamiltonian.
+
+      EAV = EAVSUM/NEAVSUM
+
+      IF (NCFTOT /= NEAVSUM) WRITE (6, *) &
+         'Not all blocks are diagonalized --- Average E ', 'not correct'
+
+!     ...Substrct the overal average energy
+      EVAL(:NVECTOT) = EVAL(:NVECTOT) - EAV
+!
+      CLOSE(25)
+!
+      NCF = NCFTOT
+      NVEC = NVECTOT
+!
+      RETURN
+      END SUBROUTINE GETMIXBLOCK

src/appl/jj2lsj90_2024/getmixblock_I.f90

@@ -0,0 +1,9 @@
+      MODULE getmixblock_I
+      INTERFACE
+!...Generated by Pacific-Sierra Research 77to90  4.3E  18:32:57   1/ 6/07
+      SUBROUTINE getmixblock (NAME, NCI)
+      CHARACTER (LEN = 24), INTENT(IN) :: NAME
+      INTEGER, INTENT(IN) :: NCI
+      END SUBROUTINE
+      END INTERFACE
+      END MODULE

src/appl/jj2lsj90_2024/idigit.f90

@@ -0,0 +1,30 @@
+!***********************************************************************
+!                                                                      *
+      INTEGER FUNCTION IDIGIT (CST)
+!                                                                      *
+!                                                                      *
+!                                                                      *
+!***********************************************************************
+!-----------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------
+!   D u m m y   A r g u m e n t s
+!-----------------------------------------------
+      CHARACTER , INTENT(IN) :: CST
+!-----------------------------------------------
+!   L o c a l   V a r i a b l e s
+!-----------------------------------------------
+      INTEGER :: I
+      CHARACTER, DIMENSION(0:9) :: CDGT
+!-----------------------------------------------
+!
+      DATA CDGT/ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'/
+!
+      DO I = 0, 9
+         IF (CST /= CDGT(I)) CYCLE
+         IDIGIT = I
+         EXIT
+      END DO
+!
+      RETURN
+      END FUNCTION IDIGIT

src/appl/jj2lsj90_2024/idigit_I.f90

@@ -0,0 +1,8 @@
+      MODULE idigit_I
+      INTERFACE
+!...Generated by Pacific-Sierra Research 77to90  4.3E  10:48:52   2/14/04
+      INTEGER FUNCTION idigit (CST)
+      CHARACTER (LEN = 1), INTENT(IN) :: CST
+      END FUNCTION
+      END INTERFACE
+      END MODULE

src/appl/jj2lsj90_2024/jj2lsj2K.f90

@@ -0,0 +1,61 @@
+!
+!***********************************************************************
+!                                                                      *
+      PROGRAM jj2lsj2K
+!                                                                      *
+!     This MAIN program controls the transformation of atomic states,  *
+!     which are given in a jj-coupled CSF basis, into an LS-coupled    *
+!     basis. The program requires a jj-coupled basis in standard order *
+!     where, if both subshells | n j = l-1/2> and | n j = l+1/2>       *
+!     of a given shell (nl) occurs, they always follow successively    *
+!     in this order. The LS-coupled basis, moreover, is given in       *
+!     the same sequence of shells.                                     *
+!                                                                      *
+!     All LS-jj transformation coefficients are precalculated and      *
+!     'stored' in the modules rabs_lsj_data_1, rabs_lsj_data_2 and     *
+!     rabs_lsj_data_3.                                                 *
+!                                                                      *
+!     Calls:  FACTT, SETISO, JJ2LSJ, starttime, stoptime.              *
+!                                                                      *
+!     Written by G. Gaigalas,                                          *
+!     NIST                                                  May 2011   *
+!     VILNIUS                                               May 2017   *
+!                                                                      *
+!     Modified by G. Gaigalas and C. Cychen                     2021   *
+!     Modified by G. Gaigalas                                   2022   *
+!     Modified by G. Gaigalas                               Jan 2024   *
+!                                                                      *
+!***********************************************************************
+!-----------------------------------------------
+!   M o d u l e s
+!-----------------------------------------------
+      USE jj2lsj_code
+      IMPLICIT NONE
+!-----------------------------------------------
+!   L o c a l   V a r i a b l e s
+!-----------------------------------------------
+      integer           :: ncount1
+!-----------------------------------------------
+      call starttime (ncount1, 'jj2lsj')
+      print *, " "
+      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 *, "        (2024)."
+      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.lsj.T"
+      print *, " "
+!
+!  Set up the table of logarithms of factorials
+      call factt
+!
+      CALL setiso('isodata')
+      CALL jj2lsj
+!
+      call stoptime (ncount1, 'jj2lsj')
+      stop
+      end program jj2lsj2K