Sources Esope | Cast3M

extra7
C EXTRA7    SOURCE    CB215821  20/11/04    21:17:09     10766          
      SUBROUTINE EXTRA7 (IPBASE,MOT, IPTR)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
************************************************************************
*
*                             E X T R A 7
*                             -----------
*
* FONCTION:
* ---------
*
*     SOUS-PROGRAMME POUR EXTRAIRE D'UNE BASE MODALE
*            UNE 'RIGIDITE',
*            OU L'OBJET SOLUTION DE SOUS-TYPE 'MODE    ',
*            OU L'OBJET SOLUTION DE SOUS_TYPE 'SOLUSTAT',
*            OU L'OBJET SOLUTION DE SOUS_TYPE 'PSEUMODE'.
*
* MODULES UTILISES:
* -----------------
*
 
-INC PPARAM
-INC CCOPTIO
-INC SMBASEM
-INC SMSTRUC
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     IPBASE  (E)  POINTEUR SUR LE SEGMENT MBASEM
*     MOT     (E)  MOT-CLE : 'RIGI', OU 'MASS',
*                            OU 'MODE', OU 'STAT', 'PSMO'.
*     IPTR    (S)  POINTEUR SUR UN OBJET RIGIDITE  SI 'RIGI' OU 'MASS'
*                  POINTEUR SUR UN OBJET SOLUTION
*                           SI 'MODE' OU 'STAT' OU 'PSMO'.
*
      CHARACTER*(*) MOT
*
* MODE DE FONCTIONNEMENT :
* ------------------------
*
*     ON SUPPOSE QUE LE PROGRAMME APPELANT A VERIFIE QUE LE
*        MOT-CLE SOIT CORRECT.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     LIONEL VIVAN       4 MARS 1988
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
      IF (MOT.EQ.'MODE' .OR. MOT.EQ.'STAT' .OR. MOT.EQ.'PSMO') THEN
         MBASEM=IPBASE
         SEGACT,MBASEM
         NBAS=LISBAS(/1)
         DO 10 I=1,NBAS
            MSOBAS=LISBAS(I)
            SEGACT,MSOBAS
            IF (I.EQ.1) THEN
               IF (MOT.EQ.'MODE') THEN
                  IPTM1=IBSTRM(2)
               ELSE IF (MOT.EQ.'STAT') THEN
                  IPTM1=IBSTRM(3)
               ELSE
                  IPTM1=IBSTRM(5)
               ENDIF
            ELSE
               IF (MOT.EQ.'MODE') THEN
                  IPTM2=IBSTRM(2)
               ELSE IF (MOT.EQ.'STAT') THEN
                  IPTM2=IBSTRM(3)
               ELSE
                  IPTM2=IBSTRM(5)
               ENDIF
               CALL FUSOLU(IPTM1,IPTM2,IPTM3)
               IF (IERR.NE.0) RETURN
               CALL DTSOLU(IPTM1)
               IF (IERR.NE.0) RETURN
               IPTM1=IPTM3
            ENDIF
            SEGDES,MSOBAS
10       CONTINUE
         SEGDES,MBASEM
         IPTR=IPTM1
*
      ELSE IF (MOT.EQ.'MASS' .OR. MOT.EQ.'RIGI') THEN
         MBASEM=IPBASE
         SEGACT,MBASEM
         NBAS=LISBAS(/1)
         DO 20 I=1,NBAS
            MSOBAS=LISBAS(I)
            SEGACT,MSOBAS
            MSOSTU=IBSTRM(1)
            SEGDES,MSOBAS
            SEGACT,MSOSTU
            IF (I.EQ.1) THEN
               IF (MOT.EQ.'MASS') THEN
                  IPTR1=ISMASS
               ELSE
                  IPTR1=ISRAID
               ENDIF
            ELSE
               IF (MOT.EQ.'MASS') THEN
                  IPTR2=ISMASS
               ELSE
                  IPTR2=ISRAID
               ENDIF
               CALL FUSRIG(IPTR1,IPTR2,IPTR3)
               IF (IERR.NE.0) RETURN
               CALL DTRIGI(IPTR1)
               IF (IERR.NE.0) RETURN
               IPTR1=IPTR3
            ENDIF
            SEGDES,MSOSTU
20       CONTINUE
         SEGDES,MBASEM
         IPTR=IPTR1
      ENDIF
*
      END