************************************************************************
* 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                                      *
************************************************************************
      SUBROUTINE REORD
     &           (NLEV,NVERT,MIDLEV,MIDV1,MIDV2,NMIDV,MXUP,MXDWN,
     &            IDRT,IDOWN,IDAW,IUP,IRAW,IUSGN,ILSGN,
     &            NEL,NORB,NCONF,NTYP,
     &            IMODE,IPRINT,
     &            ICONF,ISPIN,NCNFTP,NCSFTP,
     &            CIOLD,CINEW,minop)
C
C     AUTHOR:  M.P. FUELSCHER AND J. OLSEN
C              UNIV. OF LUND, SWEDEN 1990
C
C     PURPOSE: CONSTRUCT THE REINDEXING ARRAY WHICH REORDERS
C              THE CSFS GENERATED BY THE DETERMINANT CODE INTO
C              THE SPLIT GRAPH GUGA ORDER.
C              FOR THAT CONSTRUCT FOR EACH CSF THE CORRESPONDING
C              STEP VECTOR AND PASS IT TO THE FUNCTIONS IPHASE
C              AND ISGNUM WHICH COMPUTES THE THE PHASE FACTOR
C              INVOLVED WHEN GOING FROM THE SYMMETRIC TO THE
C              UNITARY GROUP AND THE SPLIT ORDERING NUMBER.
C              FINALLY, THE VECTORS OF CI COEFFICIENTS ARE
C              REORDERED AND, TWO MODE ARE POSSIBLE:
C              IMODE=0 : FROM SYMMETRIC GROUP TO SPLIT GRAPH UGA ORDER
C              IMODE=1 : FROM SPLIT GRAPH UGA TO SYMMETRIC GROUP ORDER
C
C iPhase and iSgnum are clones from rasscf
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      DIMENSION ICONF(*),ISPIN(*),NCNFTP(*),NCSFTP(*)
      DIMENSION CIOLD(NCONF),CINEW(NCONF)
C
      DIMENSION IDRT(NVERT,5)
      DIMENSION IDOWN(NVERT,0:3),IDAW(NVERT,0:4)
      DIMENSION IUP(NVERT,0:3),IRAW(NVERT,0:4)
      DIMENSION IUSGN(MXUP,NMIDV),ILSGN(MXDWN,NMIDV)
      DIMENSION IWALK(50)
C
C
C     LOOP OVER CONFIGURATIONS TYPES
C
      ICSFJP = 0
      ICNBS0 = 0 ! dummy initialize
      IPBAS  = 0 ! dummy initialize
      DO 1000 ITYP = 1, NTYP
        IOPEN = ITYP + MINOP - 1 ! MINOP IS NOT INITIALIZED TEOEAW
        ICL = (NEL - IOPEN) / 2
C       BASE ADRESS FOR CONFIGURATION OF THIS TYPE
        IF( ITYP .EQ. 1 ) THEN
          ICNBS0 = 1
        ELSE
          ICNBS0 = ICNBS0 + NCNFTP(ITYP-1)*(NEL+IOPEN-1)/2
        END IF
C      BASE ADRESS FOR PROTOTYPE SPIN COUPLINGS
        IF( ITYP .EQ. 1 ) THEN
          IPBAS = 1
        ELSE
          IPBAS = IPBAS + NCSFTP(ITYP-1)*(IOPEN-1)
        END IF
C
C     LOOP OVER NUMBER OF CONFIGURATIONS OF TYPE ITYP AND PROTOTYPE
C     SPIN COUPLINGS
C
        DO 900  IC = 1, NCNFTP(ITYP)
          ICNBS = ICNBS0 + (IC-1)*(IOPEN+ICL)
          DO 800 IICSF = 1,NCSFTP(ITYP)
            ICSFJP = ICSFJP + 1
            ICSBAS = IPBAS + (IICSF-1)*IOPEN
C     COMPUTE STEP VECTOR
            CALL STEPVEC(ICONF(ICNBS),ICONF(ICNBS+ICL),ICL,IOPEN,
     &                   ISPIN(ICSBAS),NORB,IWALK)
C     GET SPLIT GRAPH ORDERING NUMBER
C     FUNCTION ISGNUM2
            ISG=ISGNUM2(NLEV,NVERT,MIDLEV,MIDV1,MIDV2,NMIDV,MXUP,
     &                   MXDWN,IDOWN,IUP,IDAW,IRAW,IUSGN,ILSGN,IWALK)
C     GET PHASE PHASE FACTOR
            IP=IPHASE2(NLEV,NVERT,IDRT,IUP,IWALK)
C     NOW REORDER THIS ELEMENT OF THE CI-VECTOR
            PHASE=DBLE(IP)
            IF ( IMODE.EQ.0 ) THEN
               CINEW(ISG)=CIOLD(ICSFJP)*PHASE
            END IF
            IF ( IMODE.EQ.1 ) THEN
               CINEW(ICSFJP)=CIOLD(ISG)*PHASE
            END IF
800       CONTINUE
900     CONTINUE
1000  CONTINUE
C
      IF( IPRINT.GE.5 ) THEN
        LPRINT=NCONF
        WRITE(6,*)
        WRITE(6,*)' OLD CI-VECTORS IN SUBROUTINE REORD'
        WRITE(6,'(10F12.8)') (CIOLD(I),I=1,LPRINT)
        WRITE(6,*)' NEW CI-VECTORS IN SUBROUTINE REORD'
        WRITE(6,'(10F12.8)') (CINEW(I),I=1,LPRINT)
        WRITE(6,*)
      ENDIF
C
C
      RETURN
      END
