Sources Esope | Cast3M

proche
C PROCHE    SOURCE    PB245956  20/12/21    21:15:12     10747          
C    SUBROUTINE PROCHE(IPMASS,IPSOLU,IPFREQ,IPRIG1,IPRIG2,LIMAGE,IPNMOD,MBASC
C                      ,INSYM)
************************************************************************
*
*                             P R O C H E
*                             -----------
*
*     SOUS-PROGRAMME ASSOCIE A L'OPTION "PROCHE" DE L'OPERATEUR
*     "VIBRATION".
*
* FONCTION:
* ---------
*
*     DETERMINER UNE SERIE DE MODES PROPRES DONT LES FREQUENCES SONT
*     LES PLUS PROCHES D'UNE SUITE DE VALEURS DONNEES.
*
* PHRASE D'APPEL:
* ----------------------------
*
*     MODES = VIBRATION PROCHE SUIT_VAL [ SUIT_MULT ] MAT_K MAT_M ;
*
*     CALL PROCHE(IPMASS,IPSOLU,IPFREQ,IPRIG1,IPRIG2,LIMAGE,IPNMOD )
*
* OPERANDES ET RESULTATS:
* -----------------------
*
*     IPFREQ    'LISTREEL'  (E) SUITE DE VALEURS REELLES DES QUELLES LES
*                               FREQUENCES PROPRES DEVRONT ETRE PROCHES.
*     IPNMOD    'LISTENTI'  (E) SUITE DES MULTIPLICITES DES FREQUENCE
*                               PROPRES ( OPTIONEL ).
*     IPRIG?    'RIGIDITE'  (E) MATRICE DE RIGIDITE.
*     IPRIG?    'RIGIDITE'  (E) MATRICE MASSE.
*     IPMASS    'RIGIDITE'  (S) MATRICE MASSE. (UTILISEE DANS VIBRAT).
*     IPSOLU    'SOLUTION'  (S) ENSEMBLE DES MODES PROPRES CALCULES.
*     MBASC     'TABLE SOLUTION'   (S) ENSEMBLE DE MODES PROPRES COMPLEXES
*
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     1ER OCTOBRE 1984    (ESOPE)
*     PASCAL BOUDA     DECEMBRE 2020 : sortie du pretraitement 
*              (analyse des matrices)
*
************************************************************************
 
c      SUBROUTINE PROCHE( IPMASS, IPSOLU, IPFREQ, IPRIG1, IPRIG2,
c     $                   LIMAGE, IPNMOD, MBASC ,INSYM)
      SUBROUTINE PROCHE( IPSOLU, IPFREQ, IPMASS, IPRIGI,
     $                   LIMAGE, IPNMOD, MBASC ,INSYM)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMLREEL
-INC SMLENTI
-INC SMTABLE
******
*     -- ARGUMENTS --
***
      POINTEUR IPNMOD.MLENTI, IPFREQ.MLREEL
      INTEGER  IPMASS, IPSOLU, IPRIG1, IPRIG2
      LOGICAL  LIMAGE
 
******
*     -- VARIABLES LOCALES --
***
      INTEGER IB100, NBFREQ
 
******
*     --  SI UNE 'LISTENTI' A ETE FOURNIE, IPNMOD EST DIFFERENT DE
*     ZERO. SINON, IPNMOD EST NUL. DANS CE CAS TOUTES LES VALEURS
*     PROPRES SONT SUPPOSEES SIMPLES.ON CREE DONC L'IPNMOD ADEQUAT: --
***
      IF ( IPNMOD .EQ. 0 ) THEN
         SEGACT  ,IPFREQ
         NBFREQ = IPFREQ.PROG(/1)
         SEGDES  ,IPFREQ
         JG     = NBFREQ
         SEGINI  ,IPNMOD
         DO 100 IB100 = 1, NBFREQ
            IPNMOD.LECT( IB100 ) = 1
 100     CONTINUE
         SEGDES  ,IPNMOD
      ENDIF
 
*pb dec20: le travail est desormais fait en amont (cf vibrat.eso)
******
*     -- VERIFICATION DES SOUS-TYPES DES 'RIGIDITE' --
***
*      CALL WHICH1 (IPRIG1,IPRIG2,  IPRIGI,IPMASS)
*      IF (IERR .NE. 0) RETURN
 
******
*     -- DETERMINATION DES MODES PROPRES --
***
      CALL PROCH1 ( IPFREQ, IPNMOD, IPRIGI, IPMASS, IPSOLU,
     &     LIMAGE, MBASC , INSYM)
      IF (IERR .NE. 0) RETURN
 
 
*      RETURN
      END