C ARPCH2    SOURCE    BP208322  20/02/06    21:15:04     10512          
      SUBROUTINE ARPCH2 (IPRIGI,IPRIG,IPMAUP,IPLCHP,APOINT,SENS)


***********************************************************************
*
*                          A R P C H 2
*
* FONCTION:
* ---------
*
*      PASSAGE D'UN LISTCHPO DE 2 CHPOINTS (ORDONES) A UN VECTEUR
*      COMPATIBLE AVEC LA "REVERSE COMMUNICATION" D'ARPACK
*      ET VICE VERSA POUR UN PROBLEME QUADRATIQUE
*
*
* PARAMETRES:  (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPRIGI  ENTIER    (E)    POINTEUR D'UN MRIGID (IVECRI)
*
*     IPRIG  ENTIER    (E)    POINTEUR DE LA RIGIDITE
*
*     IPMAUP  ENTIER    (E/S)  POINTEUR DES ELEMENTS ARPACK
*
*     IPLCHP   ENTIER    (E/S)  POINTEUR DU DU LISTCHPO
*
*     APOINT  ENTIER    (E)    INDICE DU TABLEAU 'ipntr':
*                              POSITION DE LA 1ERE COMPOSANTE
*                              DANS LE TABLEAU DE TRAVAIL 'workd'
*
*     SENS   ENTIER     (E)    ENTIER POUR TYPE DE LA CONVERSION
*                              -1  CHPOINTS -> VECTEUR PRIMAL
*                              -2  CHPOINTS -> VECTEUR DUAL
*                              -3  VECTEUR -> CHPOINTS PRIMAUX
*                              -4  VECTEUR -> CHPOINTS DUALS
*
* SOUS-PROGRAMMES APPELES:
* ------------------------

*
*     TRIANG,LDMT1,VCH1,VCH2,CHV3,CHV2
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL BOUDA     17 JUILLET 2015
*
* LANGAGE:
* --------
*
*     FORTRAN 77 & 90
*
***********************************************************************



-INC PPARAM
-INC CCOPTIO
-INC SMRIGID
-INC SMLCHPO
-INC SMVECTD
-INC TARWORK

      INTEGER IPRIGI
      INTEGER IPRIG
      INTEGER IPMAUP
      INTEGER IPLCHP
      INTEGER APOINT
      INTEGER SENS


      INTEGER IPVEC
      INTEGER IPCHO
      INTEGER INSYM
      INTEGER START
      INTEGER ndim
      INTEGER N1



*On recupere le ichole
      MRIGID=IPRIGI
      SEGACT MRIGID
      IPCHO=ICHOLE
      SEGDES MRIGID


*On récupère la position de la 1ere composante et la taille du vecteur
      MAUP=IPMAUP
      SEGACT MAUP
      START=ipntr(APOINT)-1
      ndim=resid(/1)
c       SEGDES MAUP

      INC=ndim/2

*Premier sens: on lit le vecteur arpack (en ayant repere sa position au
*prealable) et on le transforme en un listchpo
      IF (SENS .EQ. 3 .OR. SENS .EQ. 4) THEN

*Recuperation la premiere partie du vecteur
        MAUP=IPMAUP
        SEGACT MAUP


        SEGINI MVECTD
        DO  i=1,INC
          VECTBB(i)=workd(START+i)
        ENDDO

        IPVEC=MVECTD
        SEGDES MVECTD

        IF (SENS .EQ. 3) THEN
*transofmation en chpoint primal
          CALL VCH1 (IPCHO,IPVEC,IPCHP1,IPRIG)

        ELSEIF (SENS .EQ. 4) THEN
* transformation en chpoint dual
          CALL VCH2 (IPCHO,IPVEC,IPCHP1,IPRIG)

        ENDIF

*Recuperation de la seconde partie du vecteur
        MVECTD=IPVEC
        SEGACT MVECTD*MOD
        DO  i=1,INC
          VECTBB(i)=workd(START+INC+i)
        ENDDO

        IPVEC=MVECTD
        SEGDES MVECTD

        SEGDES MAUP

        IF (SENS .EQ. 3) THEN
*transofmation en chpoint primal
          CALL VCH1 (IPCHO,IPVEC,IPCHP2,IPRIG)

        ELSEIF (SENS .EQ. 4) THEN
* transformation en chpoint dual
          CALL VCH2 (IPCHO,IPVEC,IPCHP2,IPRIG)

        ENDIF

        SEGSUP MVECTD

*On remplit le mlchpo

        N1=2
        SEGINI MLCHPO
        ICHPOI(1)=IPCHP1
        ICHPOI(2)=IPCHP2
        IPLCHP=MLCHPO
        SEGDES MLCHPO

*Second sens: on ecrit dans le vecteur arpack (en ayant repéré sa
*position au préalable)
      ELSEIF (SENS .EQ. 1 .OR. SENS .EQ. 2) THEN

*On recupere les chpoints
        MLCHPO=IPLCHP
        SEGACT MLCHPO
        IPCHP1=ICHPOI(1)
        IPCHP2=ICHPOI(2)
        SEGDES MLCHPO


* transformation 1 en vecteur primal
        IF (SENS .EQ. 1) THEN

          CALL CHV3 (IPCHO,IPCHP1,IPVEC,1)

        ELSEIF (SENS .EQ. 2) THEN
*transformation 1 en vecteur dual
          CALL CHV2 (IPCHO,IPCHP1,IPVEC,1)

        ENDIF

        MAUP=IPMAUP
        SEGACT MAUP*MOD

        MVECTD=IPVEC
        SEGACT MVECTD
        DO i=1,INC
          workd(START+i)=VECTBB(i)
        ENDDO

        IPVEC=MVECTD
        SEGDES MVECTD

* transformation 2 en vecteur primal
        IF (SENS .EQ. 1) THEN

          CALL CHV3 (IPCHO,IPCHP2,IPVEC,1)

        ELSEIF (SENS .EQ. 2) THEN
*transformation 2 en vecteur dual
          CALL CHV2 (IPCHO,IPCHP2,IPVEC,1)

        ENDIF

        MVECTD=IPVEC
        SEGACT MVECTD

        DO i=1,INC
          workd(START+INC+i)=VECTBB(i)
        ENDDO

        SEGSUP MVECTD

        IPMAUP=MAUP
c         SEGDES MAUP

      ENDIF


      END