Télécharger la plaquette Cast3M


fr en

Télécharger intva3.eso

Retour à la liste

Numérotation des lignes : 

intva3

  1. C INTVA3    SOURCE    BP208322  09/03/24    21:15:00     6341
  2.       SUBROUTINE INTVA3 (IPRIGI,IPMASS,INF0,IPMODE,IALEAT,LIMAGE)
  3. ************************************************************************
  4. *
  5. *                             I N T V A 3
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     RECHERCHE D'UN MODE PROPRE.
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. *     CALL INTVA3 (IPRIGI,IPMASS,INF0,IPMODE)
  17. *
  18. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  19. * -----------
  20. *
  21. *     IPRIGI  ENTIER    (E)  POINTEUR DE L'OBJET 'RIGIDITE' CONTENANT
  22. *                            LA MATRICE DE RIGIDITE.
  23. *     IPMASS  ENTIER    (E)  POINTEUR DE L'OBJET 'RIGIDITE' CONTENANT
  24. *                            LA MATRICE MASSE.
  25. *     INF0    ENTIER    (E)  NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA
  26. *                            'RIGIDITE' "K" DECOMPOSEE EN L.D.LT .
  27. *                            CE NOMBRE N'EST PAS NUL A CAUSE DE LA FACON
  28. *                            DONT SONT INTRODUITS LES BLOCAGES DES
  29. *                            D.D.L. (MULTIPLICATEURS DE LAGRANGE "LX").
  30. *     IPMODE  ENTIER    (S)  POINTEUR DE L'OBJET 'SOLUTION' CONTENANT
  31. *                            LE MODE PROPRE TROUVE.
  32. *    +W2A     REEL DP   (E)  1ERE BORNE DE L'INTERVALLE ENCADRANT LA
  33. *                            PULSATION PROPRE AU CARRE.
  34. *    +W2B     REEL DP   (E)  2EME BORNE DE L'INTERVALLE ENCADRANT LA
  35. *                            PULSATION PROPRE AU CARRE.
  36. *
  37. *     + = PARAMETRE PASSE DANS LE COMMUN "CINTVA".
  38. *
  39. * LEXIQUE: (ORDRE ALPHABETIQUE)
  40. * --------
  41. *
  42. *     CONVRG  LOGIQUE   VOIR LE SOUS-PROGRAMME "ITINV".
  43. *     FREQPP  REEL DP   FREQUENCE PROPRE CALCULEE.
  44. *     IPKW2M  ENTIER    POINTEUR DE LA 'RIGIDITE' "DECALEE"  K - W2.M
  45. *     IPVECP  ENTIER    POINTEUR DU 'CHPOINT' QUI CONTIENT DES NOMBRES
  46. *                       ALEATOIRES, PUIS UN VECTEUR PROPRE.
  47. *     ITERMX  ENTIER    VOIR LE SOUS-PROGRAMME "ITINV".
  48. *     JREPET  ENTIER    NOMBRE DE FOIS QUE L'ON EFFECTUE UNE SEQUENCE
  49. *                       D'ITERATIONS INVERSES, AU MAXIMUM.
  50. *     NUMACC  ENTIER    VOIR LE SOUS-PROGRAMME "ITINV".
  51. *     OMEGA2  REEL DP   PULSATION PROPRE TROUVEE AU CARRE.
  52. *     PRECI1  REEL SP   VOIR LE SOUS-PROGRAMME "ITINV".
  53. *     PRECI2  REEL SP   VOIR LE SOUS-PROGRAMME "ITINV".
  54. *     PROPRE  REEL DP   VOIR LE SOUS-PROGRAMME "ITINV".
  55. *     W2      REEL DP   PULSATION AU CARRE A APPROCHER.
  56. *
  57. * MODE DE FONCTIONNEMENT:
  58. * -----------------------
  59. *
  60. *     LE CALCUL D'UN VECTEUR PROPRE SE FAIT PAR LA METHODE DES
  61. *     ITERATIONS INVERSES (DITE AUSSI DE LA PUISSANCE INVERSE), AVEC
  62. *     DECALAGE INITIAL ("SHIFTING") ET AJUSTEMENT DU DECALAGE TOUTES
  63. *     LES "ITERMX" ITERATIONS.
  64. *     DANS LE CAS DE MODES MULTIPLES, IL EST INUTILE DE FAIRE TOUTES
  65. *     LES ITERATIONS PUISQU'ON CONNAIT LA FREQUENCE ET QU'ON RISQUE
  66. *     D'ITERER SUR DES COMBINAISONS LINEAIRES DES MODES MULTIPLES.
  67. *
  68. *
  69. * SOUS-PROGRAMMES APPELES:
  70. * ------------------------
  71. *
  72. *     ALEAT1, CREMOD, DECALE, DIAGN1, DTRIGI, ECCHPO, ECMODE, ITINV,
  73. *     W2FREQ.
  74. *
  75. * AUTEUR, DATE DE CREATION:
  76. * -------------------------
  77. *
  78. *     PASCAL MANIGOT     24 DECEMBRE 1984
  79. *
  80. * LANGAGE:
  81. * --------
  82. *
  83. *     FORTRAN77
  84. *
  85. ************************************************************************
  86. *
  87.       IMPLICIT INTEGER(I-N)
  88.       IMPLICIT REAL*8 (A-H,O-Z)
  89. -INC CCREEL
  90.  
  91. -INC PPARAM
  92. -INC CCOPTIO
  93. *
  94. *     REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:
  95.       COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,
  96.      &     NUMW2B  ,IUN
  97. *
  98.       LOGICAL CONVRG,LIMAGE
  99. *
  100.       PARAMETER (LPROPR = 5)
  101. *
  102.       REAL*8 PROPRE(LPROPR),DEUXPI
  103. *
  104.       PARAMETER (JREPET = 4)
  105.       PARAMETER (ITERMX = 30)
  106.       PARAMETER (PRECI1 = 1.D-5)
  107.       PARAMETER (PRECI2 = 1.D-5)
  108.       PARAMETER (DEUXPI = (2.D0*XPI))
  109.       PARAMETER (NUMACC = 5)
  110. *
  111. *
  112.       W2AA = W2A
  113.       W2BB = W2B
  114. *
  115.       IF(IMULTP.EQ.1) THEN
  116.          JREPE1=1
  117.          ITRMX1=10
  118.       ELSE
  119.          JREPE1=JREPET
  120.          ITRMX1=ITERMX
  121.       ENDIF
  122. *
  123. *
  124.       DO 100 IB100=1,JREPE1
  125. *****************************************************
  126.          IF(IIMPI.EQ.30) WRITE(IOIMP,1000) IB100,JREPE1,ITRMX1,IMULTP
  127.  1000    FORMAT(/10X,'SBR INTVA3 IB100,JREPE1,ITRMX1,IMULTP',
  128.      C        4(I5,1X))
  129. *****************************************************
  130. *
  131. *        -- CREATION DE (K-W2M) --
  132. *
  133.          W2 = (W2AA + W2BB) / 2.D0
  134.          IF (IIMPI .EQ. 30) THEN
  135.             FREQ = SQRT(W2) / DEUXPI
  136.             WRITE (IOIMP,2010) W2,FREQ
  137.  2010       FORMAT (//,' DECALAGE DE LA MATRICE DE RIGIDITE ',
  138.      &           'CORRESPONDANT A LA PULSATION AU CARRE ',1PE12.5,
  139.      &           ' (FREQUENCE: ',1PE12.5,').'///)
  140.          END IF
  141.          CALL DECALE (IPRIGI,IPMASS,W2,  IPKW2M)
  142.          IF (IERR .NE. 0) RETURN
  143. *
  144. *        -- INITIALISATION DES ITERATIONS: CREATION D'UN 'CHPOINT'
  145. *        ALEATOIRE --
  146. *
  147.          IF (IB100 .EQ. 1) THEN
  148.             IF (IALEAT.EQ.0) CALL ALEAT1 (IPKW2M,IALEAT)
  149.             CALL COPIE2(IALEAT,IPVECP)
  150. *
  151. *         CALCUL DE M*X
  152. *
  153.             CALL MUCPRI(IPVECP,IPMASS,IPM1)
  154.             IF (IERR .NE. 0) RETURN
  155. *
  156.          END IF
  157. *
  158. *          DUPLIQUER IPMX QUI EST DETRUIT DANS ITINV
  159. *
  160.          CALL ECRCHA('GEOM')
  161.          CALL ECROBJ('CHPOINT ',IPM1)
  162.          CALL COPIER
  163.          IF(IERR.NE.0) RETURN
  164.          ICODE=1
  165.          CALL LIROBJ('CHPOINT ',IPMX,ICODE,IRETOU)
  166.          IF(IERR.NE.0) RETURN
  167.  
  168. *
  169. *        -- RESOLUTION PAR ITERATIONS INVERSES --
  170. *
  171.          CALL ITINV (IPKW2M,IPMASS,IPVECP,PROPRE,CONVRG,ITRMX1,NUMACC
  172.      &        ,PRECI1,PRECI2,IPMX)
  173.          IF (IERR .NE. 0) RETURN
  174.          IF (CONVRG) THEN
  175. *           --> SORTIE DE BOUCLE N.100
  176.             GOTO 102
  177.          ELSE IF (IB100 .LT. JREPE1) THEN
  178. **          MESSAGE POUR ANNONCER QUE L'ON DEPASSE "ITRMX1" ITERATIONS
  179. **          ??????????????????????????????????????????????????????????
  180.             CALL DIAGN1 (IPKW2M,  NUMW2)
  181.             IF (IERR .NE. 0) RETURN
  182. *           AJUSTEMENT DU DECALAGE:
  183.             IF (NUMW2 .EQ. NUMW2A) THEN
  184.                W2AA = W2
  185.             ELSE
  186. *              RQ: NUMW2 VAUT NUMW2B
  187.                W2BB = W2
  188.             END IF
  189.             CALL DTRIGI (IPKW2M)
  190.          END IF
  191. *
  192.  100  CONTINUE
  193. *     END DO
  194.  102  CONTINUE
  195. *     CALL DTCHPO(IPM1)
  196. *
  197.       IF (.NOT.CONVRG) THEN
  198.          INTERR(1) = ITRMX1 * JREPE1
  199.          NUMERR = 151
  200.          CALL ERREUR (NUMERR)
  201.       END IF
  202. *
  203. *     -- FREQUENCE PROPRE --
  204. *
  205.       CALL W2FREQ (PROPRE(1),W2,  OMEGA2,FREQPP,LIMAGE)
  206.       IF (IERR .NE. 0) RETURN
  207.       PROPRE(1) = FREQPP
  208. *
  209.       IF (IIMPI .EQ. 747) THEN
  210.          WRITE (IOIMP,*) 'FREQUENCE PROPRE CALCULEE = ',FREQPP
  211.          WRITE (IOIMP,*) '-------------------------'
  212.          WRITE (IOIMP,*) 'CHPOINT PROPRE:'
  213.          CALL ECCHPO (IPVECP,0)
  214.       END IF
  215. *
  216. *     RQ: LE MODE PROPRE CORRESPOND AU COUPLE (FREQPP,IPVECP),
  217. *         "IPVECP" ETANT UN POINTEUR SUR UN SEGMENT DE 'CHPOINT'.
  218. *
  219. *     -- CREATION DE L'OBJET REPRESENTANT LE MODE --
  220. *
  221.       FREQ = SQRT(ABS(W2)) / DEUXPI
  222.       IF(LIMAGE) THEN
  223.          FREQ = SIGN (FREQ,W2)
  224.       ENDIF
  225.       NUMOD2 = 0
  226. c      CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ,NUMOD2,IPMODE)
  227.       CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,NUMOD2,IPMODE)
  228.       IF (IERR .NE. 0) RETURN
  229. *
  230. *     IMPRESSION DU MODE( ON N'IMPRIME PAS LE CHPOINT)
  231.       IF (IIMPI.EQ.2) THEN
  232.          WRITE (IOIMP,2000)
  233.  2000    FORMAT ('1MODE PROPRE CALCULE:'/' --------------------'//)
  234.          CALL ECMODE (IPMODE)
  235.       ENDIF
  236. *
  237. *     -- SUPPRESSION DES OBJETS DE TRAVAIL --
  238. *
  239.       CALL DTRIGI (IPKW2M)
  240. *
  241.       END
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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