Esope source files

   1 : C CRSOLU    SOURCE    BP208322  09/03/20    21:15:09     6331           
   2 : C CRSOLU   SOURCE    WPAMJ       05/09/94
   3 : ************************************************************************
   4 : *
   5 : *                                CRSOLU
   6 : *                             -----------
   7 : *
   8 : * FONCTION:
   9 : * ---------
  10 : *
  11 : *     -- CONSTRUCTION D'UN OBJET SOLUTION, A PARTIR DE LA LISTE
  12 : *     DES FREQUENCES PROPRES ET DE CELLE DES MODES PROPRES.
  13 : *     LES LISTES SONT SUPPOSES TRIEES, LES FREQUENCES SHIFTEES,
  14 : *     ET LES MODES ORTHONORMALISES. --
  15 : *
  16 : * MODE D'APPEL:
  17 : * -------------
  18 : *
  18 : *     CALL   CRSOLU (FREQ,IPLVAL, IPLVEC, NBMOD, IPKW2M, IPMASS, IPSOLU)
  19 : *
  20 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  21 : * -----------
  22 : *
  23 : *     IPLVAL  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  24 : *                            LA SUITE DES FREQUENCES PROPRES.
  25 : *     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  26 : *                            LA SUITE DES MODES PROPRES.
  27 : *     NBMOD   ENTIER    (E)  NOMBRE DE MODES A INSERER DANS LA SOLUTION
  28 : *                            ON A: NBMOD .LE. DIMENSION( IPLVAL )
  29 : *
  30 : *     IPKW2M, IPMASS    (E)  MATRICES DE RIGIDITE (DECALEE) ET DE MASSE
  31 : *
  31 : *     FREQ    REEL      (E)  FREQUENCE UTILISEE POUR LE DECALLAGE
  32 : *
  33 : *     IPSOLU  ENTIER    (S)  POINTEUR SUR LA SOLUTION CREE.
  34 : *
  35 : *
  36 : * AUTEUR, DATE DE CREATION:
  37 : * -------------------------
  38 : *
  39 : *     A.M. JOLIVALT, W. PASILLAS     06 / 07 / 94. ( ESOPE )
  40 : *
  41 : ***************************************************
  42 : *      SUBROUTINE CRSOLU (FREQ,IPLVAL,IPLVEC,NBMOD,IPKW2M,IPMASS,
  43 :       SUBROUTINE CRSOLU (W2,IPLVAL,IPLVEC,NBMOD,IPKW2M,IPMASS,
  44 :      >           IPSOLU,INF0)
  45 : 
  46 :       IMPLICIT INTEGER(I-N)
  47 :       IMPLICIT REAL*8 (A-H,O-Z)
  48 : 
  49 : -INC CCOPTIO
  50 : -INC SMLCHPO
  51 : -INC SMLREEL
  52 : -INC SMLMOTS
  53 : -INC CCREEL
  54 : 
  55 : ******
  56 : *     -- CONSTANTES --
  57 : ***
  58 :       PARAMETER (LPROPR = 5)
  59 :       PARAMETER (DEUXPI = (2.D0*XPI))
  60 : 
  61 : ******
  62 : *     -- ARGUMENTS --
  63 : ***
  64 :       POINTEUR IPLVEC.MLCHPO, IPLVAL.MLREEL
  65 :       INTEGER NBMOD, IPKW2M, IPMASS, IPSOLU
  66 : 
  67 : ******
  68 : *     -- VARIABLES LOCALES --
  69 : ***
  70 :       POINTEUR IPLMD.MLMOTS, IPLMF.MLMOTS
  71 :       INTEGER  IPMX, IPMODE, IPSOL1
  72 :       REAL*8   OMEGA2, PROPRE(LPROPR), FREQ, XXTMX
  73 : 
  74 : 
  75 : ******
  76 : *     -- LES MODES PROPRES CORRESPONDENT AUX COUPLES: --
  77 : *         ( IPLVAL(I) , IPLVEC(I) )    I = 1, NBMOD
  78 : ***
  79 :       SEGACT ,IPLVEC, IPLVAL
  80 : 
  81 : *      NBMOD2 = 0
  82 : *      DO 10 IB100 = 1, NBMOD
  83 : *         FREQUI = IPLVAL.PROG(IB100)
  84 : *         IF (FREQUI.GE.FREQ) NBMOD2 = NBMOD2 + 1
  85 : * 10   CONTINUE
  86 : *
  87 : *      NNBMOD = NBMOD - NBMOD2
  88 :       NBNEG = 1
  89 :       NBPOS = 0
  90 : 
  91 :       DO 100 IB100 = 1, NBMOD
  92 :          IPVECP = IPLVEC.ICHPOI(IB100)
  92 :          CALL XTMX ( IPVECP, IPMASS, XXTMX )
  93 :          IF ( IERR .NE. 0 ) RETURN
  93 :          CALL MUCPRI ( IPVECP, IPMASS, IPMX )
  94 :          IF ( IERR .NE. 0 ) RETURN
  95 :          IF ( IB100 .EQ. 1 ) THEN
  96 : *           -- NOM DES COMPOSANTES: --
  96 :             CALL CORRSP ( ipmass, IPVECP, IPMX, IPLMD, IPLMF )
  97 :             IF ( IERR .NE. 0 ) RETURN
  98 :          ENDIF
  99 : *         NUMOD2 = IB100 - NNBMOD
 100 :          PROPRE(1) = IPLVAL.PROG(IB100)
 101 :          PROPRE(2) = XXTMX
 102 :          XLAMBR = sign( ((DEUXPI*PROPRE(1))**2) , PROPRE(1) )
 103 :          if(XLAMBR .lt. W2) then
 104 :             NBNEG = NBNEG - 1
 105 :             NUMOD2 = NBNEG
 106 :          else
 107 :             NBPOS = NBPOS + 1
 108 :             NUMOD2 = NBPOS
 109 :          endif
 109 :          CALL MASGEN ( IPVECP, PROPRE )
 110 :          IF ( IERR .NE. 0 ) RETURN
 110 :          CALL DEPGEN ( IPMASS, IPVECP, PROPRE, IPMX, IPLMD, IPLMF)
 111 :          IF ( IERR .NE. 0 ) RETURN
 111 : *         CALL CREMOD ( PROPRE,IPVECP,IPKW2M,INF0,FREQ,NUMOD2,IPMODE)
 111 :          CALL CREMOD ( PROPRE,IPVECP,IPKW2M,INF0,NUMOD2,IPMODE)
 112 :          IF ( IERR .NE. 0 ) RETURN
 113 : *        -- AFFICHAGE DE LA SOLUTION --
 113 :          IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE )
 114 :          IF (IB100 .EQ. 1) THEN
 115 :             IPSOLU = IPMODE
 116 :          ELSE
 116 :             CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 )
 117 :             IF ( IERR .NE. 0 ) RETURN
 117 :             CALL DESOLU( IPMODE )
 118 :             IF ( IERR .NE. 0 ) RETURN
 118 :             CALL DESOLU( IPSOLU )
 119 :             IF ( IERR .NE. 0 ) RETURN
 120 :             IPSOLU = IPSOL1
 121 :          ENDIF
 121 :          CALL DTCHPO ( IPMX )
 122 :          IF ( IERR .NE. 0 ) RETURN
 123 :  100  CONTINUE
 124 : 
 125 :       IPMODE = IPSOLU
 126 : 
 127 :       SEGDES ,IPLVEC, IPLVAL
 128 : 
 129 :       SEGSUP ,IPLMD , IPLMF
 130 : 
 131 :       RETURN
 132 :       END 
 133 :  
 134 :