Sources Esope | Cast3M

arpope
C ARPOPE    SOURCE    PV        22/04/15    17:10:46     11344          
      SUBROUTINE ARPOPE (IPRIGI,IPMASS,IPAMOR,QUAD,SIGMA,IPRTRA)
 
 
***********************************************************************
*
*                          A R P O P E
*
* FONCTION:
* ---------
*
*     CONSTRUCTION DES OPERATEURS DE TRAVAIL POUR ARPACK
*
*
* PARAMETRES:  (E)=ENTREE   (S)=SORTIE
* -----------
*
*
*     IPRIGI   ENTIER       (E)  POINTEUR DE LA RIGIDITE
*
*     IPMASS   ENTIER       (E)  POINTEUR DE LA MASSE
*
*     IPAMOR   ENTIER       (E)  POINTEUR DE L'AMORTISSEMENT
*
*     QUAD    LOGIQUE       (E)  PROBLEME QUADRATIQUE OU NON
*
*     SIGMA    COMPLEXE DP  (E)  VALEUR DU SHIFT
*
*     IPRTRA   ENTIER       (S)  POINTEUR VERS LE SEGMENT DES OPERATEURS
*
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     DECALE, TRIANG, LDMT1
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL BOUDA     17 JUILLET 2015
*
* LANGAGE:
* --------
*
*     FORTRAN 77 & 90
*
************************************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMRIGID
-INC TARWORK
-INC CCREEL
 
 
      INTEGER IPRIGI
      INTEGER IPMASS
      INTEGER IPAMOR
      LOGICAL QUAD
      COMPLEX*16 SIGMA
      INTEGER IPRTRA
 
      INTEGER IPBUFF
      INTEGER IPINT
      INTEGER IPCHO
      INTEGER NBR, NRG
 
* Liste des operateurs construits
*
* K MATRICE DE RIGIDITE
* M MATRICE DE MASSE
* C MATRICE D'AMORTISSEMENT
 
 
* RIGI(1)=K
* RIGI(2)=M OU KSIGMA
* RIGI(3)=C
* RIGI(4)=K-RE(SIGMA)*M
* RIGI(5)=C+RE(SIGMA)*M
* RIGI(6)=K+RE(SIGMA)*(C+RE(SIGMA)*M)
 
* SYME indique si l'operateur construit est symetrique
*ou non
 
      xspetl = xspeti
      NB=6
      SEGINI MRITRA
 
      DO i=1,RIGI(/1)
        RIGI(i)=0
      ENDDO
 
      RIGI(1)=IPRIGI
      RIGI(2)=IPMASS
 
 
      IF (.NOT. QUAD) THEN
 
        CALL DECALE(IPRIGI,IPMASS,REAL(SIGMA),IPBUFF)
        RIGI(4)=IPBUFF
 
      ELSE
 
        RIGI(3)=IPAMOR
 
        CALL DECALE (IPAMOR,IPMASS,-REAL(SIGMA),IPINT)
        RIGI(5)=IPINT
 
        CALL DECALE (IPRIGI,IPINT,-REAL(SIGMA),IPBUFF)
        RIGI(6)=IPBUFF
 
      ENDIF
 
*Triangularisation des operateurs de travail si necessaire
      DO i=1,RIGI(/1)
 
        IF (RIGI(i) .NE. 0) THEN
 
          MRIGID=RIGI(i)
          SEGACT MRIGID
          IPCHO=ICHOLE
 
          NRG = IRIGEL(/1)
          NBR = IRIGEL(/2)
 
          SYME(i)=0
 
          IF (NRG .GE. 7) THEN
            DO j=1,NBR
              IANTI=IRIGEL(7,j)
              IF (IANTI .GT. 0) THEN
                SYME(i)=1
              ENDIF
            ENDDO
          ENDIF
 
          SEGDES MRIGID
 
          IF (IPCHO .EQ. 0) THEN
            IPBUFF=RIGI(i)
            IF (SYME(i) .EQ. 0) THEN
              CALL TRIANG (IPBUFF,xspetl,0)
              IF (IERR .NE. 0) RETURN
            ELSE
              CALL LDMT1(IPBUFF,xspetl)
              IF (IERR .NE. 0) RETURN
            ENDIF
            RIGI(i)=IPBUFF
          ENDIF
 
        ENDIF
 
      ENDDO
 
 
      IPRTRA=MRITRA
      SEGDES MRITRA
 
      END