!***********************************************************************
! This file is part of OpenMolcas.                                     *
!                                                                      *
! OpenMolcas is free software; you can redistribute it and/or modify   *
! it under the terms of the GNU Lesser General Public License, v. 2.1. *
! OpenMolcas is distributed in the hope that it will be useful, but it *
! is provided "as is" and without any express or implied warranties.   *
! For more details see the full text of the license in the file        *
! LICENSE or in <http://www.gnu.org/licenses/>.                        *
!                                                                      *
! Copyright (C) 1990, Markus P. Fuelscher                              *
!               1990, Jeppe Olsen                                      *
!***********************************************************************
!#define _DEBUGPRINT_
      SUBROUTINE REORD(SGS,CIS,EXS,NCONF,IMODE,ICONF,ISPIN,kSym,CIOLD)
!
!     AUTHOR:  M.P. FUELSCHER AND J. OLSEN
!              UNIV. OF LUND, SWEDEN 1990
!
!     PURPOSE: CONSTRUCT THE REINDEXING ARRAY WHICH REORDERS
!              THE CSFS GENERATED BY THE DETERMINANT CODE INTO
!              THE SPLIT GRAPH GUGA ORDER.
!              FOR THAT CONSTRUCT FOR EACH CSF THE CORRESPONDING
!              STEP VECTOR AND PASS IT TO THE FUNCTIONS IPHASE
!              AND ISGNUM WHICH COMPUTES THE THE PHASE FACTOR
!              INVOLVED WHEN GOING FROM THE SYMMETRIC TO THE
!              UNITARY GROUP AND THE SPLIT ORDERING NUMBER.
!              FINALLY, THE VECTORS OF CI COEFFICIENTS ARE
!              REORDERED AND, TWO MODE ARE POSSIBLE:
!              IMODE=0 : FROM SYMMETRIC GROUP TO SPLIT GRAPH UGA ORDER
!              IMODE=1 : FROM SPLIT GRAPH UGA TO SYMMETRIC GROUP ORDER
!
!
#ifdef _DEBUGPRINT_
      use Definitions, only: u6
#endif
      use spinfo_mclr_data, only: minop, NCSFTP=>NCPCNT, NCNFTP=>NCNATS, NTYP
      use stdalloc, only: mma_allocate, mma_deallocate
      use gugx, only: SGStruct, CIStruct, EXStruct
      IMPLICIT None
      Type(SGStruct) SGS
      Type(CIStruct) CIS
      Type(EXStruct) EXS
      Integer kSym, nCONF, IMODE
      Integer ICONF(*),ISPIN(*)
      Real*8 CIOLD(NCONF)
!
      Real*8, Allocatable:: CINEW(:)
      Integer IWALK(50)
      Integer, External:: IPHASE, ISGNUM
      Integer :: IC, ICL, ICNBS, ICNBS0, ICSBAS, ICSFJP, IICSF, IOPEN, IP, IPBAS, ISG, ITYP
      Real*8 PHASE
#ifdef _DEBUGPRINT_
      Integer I
#endif

      Call mma_allocate(CINEW,NCONF,Label='CINEW')

      Associate (nLev=> SGS%nLev, IDRT=>SGS%DRT, IDOWN=>SGS%Down ,      &
     &           IDAW=>SGS%DAW, IUP=>SGS%Up, IRAW=>SGS%RAW,             &
     &           IUSGN=>EXS%USGN, ILSGN=>EXS%LSGN, nVert=>SGS%nVert,    &
     &           MidLev=>SGS%MidLev, MVSta=>SGS%MVSta,                  &
     &           nMidV=>CIS%nMidV, MXUP=>SGS%MxUp, MXDWN=>SGS%MxDwn,    &
     &           nEl=>SGS%nActEl, NORB=>SGS%nLev)
!
!     LOOP OVER CONFIGURATIONS TYPES
!
      ICSFJP = 0
      ICNBS0 = 0 ! dummy initialize
      IPBAS  = 0 ! dummy initialize
      DO ITYP = 1, NTYP
        IOPEN = ITYP + MINOP - 1 ! MINOP IS NOT INITIALIZED TEOEAW
        ICL = (NEL - IOPEN) / 2
!       BASE ADRESS FOR CONFIGURATION OF THIS TYPE
        IF( ITYP .EQ. 1 ) THEN
          ICNBS0 = 1
        ELSE
          ICNBS0 = ICNBS0 + NCNFTP(ITYP-1,kSym)*(NEL+IOPEN-1)/2
        END IF
!      BASE ADRESS FOR PROTOTYPE SPIN COUPLINGS
        IF( ITYP .EQ. 1 ) THEN
          IPBAS = 1
        ELSE
          IPBAS = IPBAS + NCSFTP(ITYP-1)*(IOPEN-1)
        END IF
!
!     LOOP OVER NUMBER OF CONFIGURATIONS OF TYPE ITYP AND PROTOTYPE
!     SPIN COUPLINGS
!
        DO IC = 1, NCNFTP(ITYP,kSym)
          ICNBS = ICNBS0 + (IC-1)*(IOPEN+ICL)
          DO IICSF = 1,NCSFTP(ITYP)
            ICSFJP = ICSFJP + 1
            ICSBAS = IPBAS + (IICSF-1)*IOPEN
!     COMPUTE STEP VECTOR
            CALL STEPVEC(ICONF(ICNBS),ICONF(ICNBS+ICL),ICL,IOPEN,ISPIN(ICSBAS),NORB,IWALK)
!     GET SPLIT GRAPH ORDERING NUMBER
!     FUNCTION ISGNUM
            ISG=ISGNUM(NLEV,NVERT,MIDLEV,MVSta,NMIDV,MXUP,MXDWN,IDOWN,IUP,IDAW,IRAW,IUSGN,ILSGN,IWALK)
!     GET PHASE PHASE FACTOR
            IP=IPHASE(NLEV,NVERT,IDRT,IUP,IWALK)
!     NOW REORDER THIS ELEMENT OF THE CI-VECTOR
            PHASE=DBLE(IP)
            Select Case (iMode)
              Case (0)
               CINEW(ISG)=CIOLD(ICSFJP)*PHASE
              Case(1)
               CINEW(ICSFJP)=CIOLD(ISG)*PHASE
            End Select
          END DO
        END DO
      END DO
!
#ifdef _DEBUGPRINT_
      WRITE(u6,*)
      WRITE(u6,*)' OLD CI-VECTORS IN SUBROUTINE REORD'
      WRITE(u6,'(10F12.8)') (CIOLD(I),I=1,NCONF)
      WRITE(u6,*)' NEW CI-VECTORS IN SUBROUTINE REORD'
      WRITE(u6,'(10F12.8)') (CINEW(I),I=1,NCONF)
      WRITE(u6,*)
#endif
!
      End Associate
      CIOLD(:)=CINEW(:)
      Call mma_deallocate(CINEW)

      END SUBROUTINE REORD
