Télécharger arpch2.eso

Retour à la liste

arpch2
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
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales