Télécharger intva3.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  91. *
  92. * REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:
  93. COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,
  94. & NUMW2B ,IUN
  95. *
  96. LOGICAL CONVRG,LIMAGE
  97. *
  98. PARAMETER (LPROPR = 5)
  99. *
  100. REAL*8 PROPRE(LPROPR),DEUXPI
  101. *
  102. PARAMETER (JREPET = 4)
  103. PARAMETER (ITERMX = 30)
  104. PARAMETER (PRECI1 = 1.D-5)
  105. PARAMETER (PRECI2 = 1.D-5)
  106. PARAMETER (DEUXPI = (2.D0*XPI))
  107. PARAMETER (NUMACC = 5)
  108. *
  109. *
  110. W2AA = W2A
  111. W2BB = W2B
  112. *
  113. IF(IMULTP.EQ.1) THEN
  114. JREPE1=1
  115. ITRMX1=10
  116. ELSE
  117. JREPE1=JREPET
  118. ITRMX1=ITERMX
  119. ENDIF
  120. *
  121. *
  122. DO 100 IB100=1,JREPE1
  123. *****************************************************
  124. IF(IIMPI.EQ.30) WRITE(IOIMP,1000) IB100,JREPE1,ITRMX1,IMULTP
  125. 1000 FORMAT(/10X,'SBR INTVA3 IB100,JREPE1,ITRMX1,IMULTP',
  126. C 4(I5,1X))
  127. *****************************************************
  128. *
  129. * -- CREATION DE (K-W2M) --
  130. *
  131. W2 = (W2AA + W2BB) / 2.D0
  132. IF (IIMPI .EQ. 30) THEN
  133. FREQ = SQRT(W2) / DEUXPI
  134. WRITE (IOIMP,2010) W2,FREQ
  135. 2010 FORMAT (//,' DECALAGE DE LA MATRICE DE RIGIDITE ',
  136. & 'CORRESPONDANT A LA PULSATION AU CARRE ',1PE12.5,
  137. & ' (FREQUENCE: ',1PE12.5,').'///)
  138. END IF
  139. CALL DECALE (IPRIGI,IPMASS,W2, IPKW2M)
  140. IF (IERR .NE. 0) RETURN
  141. *
  142. * -- INITIALISATION DES ITERATIONS: CREATION D'UN 'CHPOINT'
  143. * ALEATOIRE --
  144. *
  145. IF (IB100 .EQ. 1) THEN
  146. IF (IALEAT.EQ.0) CALL ALEAT1 (IPKW2M,IALEAT)
  147. CALL COPIE2(IALEAT,IPVECP)
  148. *
  149. * CALCUL DE M*X
  150. *
  151. CALL MUCPRI(IPVECP,IPMASS,IPM1)
  152. IF (IERR .NE. 0) RETURN
  153. *
  154. END IF
  155. *
  156. * DUPLIQUER IPMX QUI EST DETRUIT DANS ITINV
  157. *
  158. CALL ECRCHA('GEOM')
  159. CALL ECROBJ('CHPOINT ',IPM1)
  160. CALL COPIER
  161. IF(IERR.NE.0) RETURN
  162. ICODE=1
  163. CALL LIROBJ('CHPOINT ',IPMX,ICODE,IRETOU)
  164. IF(IERR.NE.0) RETURN
  165.  
  166. *
  167. * -- RESOLUTION PAR ITERATIONS INVERSES --
  168. *
  169. CALL ITINV (IPKW2M,IPMASS,IPVECP,PROPRE,CONVRG,ITRMX1,NUMACC
  170. & ,PRECI1,PRECI2,IPMX)
  171. IF (IERR .NE. 0) RETURN
  172. IF (CONVRG) THEN
  173. * --> SORTIE DE BOUCLE N.100
  174. GOTO 102
  175. ELSE IF (IB100 .LT. JREPE1) THEN
  176. ** MESSAGE POUR ANNONCER QUE L'ON DEPASSE "ITRMX1" ITERATIONS
  177. ** ??????????????????????????????????????????????????????????
  178. CALL DIAGN1 (IPKW2M, NUMW2)
  179. IF (IERR .NE. 0) RETURN
  180. * AJUSTEMENT DU DECALAGE:
  181. IF (NUMW2 .EQ. NUMW2A) THEN
  182. W2AA = W2
  183. ELSE
  184. * RQ: NUMW2 VAUT NUMW2B
  185. W2BB = W2
  186. END IF
  187. CALL DTRIGI (IPKW2M)
  188. END IF
  189. *
  190. 100 CONTINUE
  191. * END DO
  192. 102 CONTINUE
  193. * CALL DTCHPO(IPM1)
  194. *
  195. IF (.NOT.CONVRG) THEN
  196. INTERR(1) = ITRMX1 * JREPE1
  197. NUMERR = 151
  198. CALL ERREUR (NUMERR)
  199. END IF
  200. *
  201. * -- FREQUENCE PROPRE --
  202. *
  203. CALL W2FREQ (PROPRE(1),W2, OMEGA2,FREQPP,LIMAGE)
  204. IF (IERR .NE. 0) RETURN
  205. PROPRE(1) = FREQPP
  206. *
  207. IF (IIMPI .EQ. 747) THEN
  208. WRITE (IOIMP,*) 'FREQUENCE PROPRE CALCULEE = ',FREQPP
  209. WRITE (IOIMP,*) '-------------------------'
  210. WRITE (IOIMP,*) 'CHPOINT PROPRE:'
  211. CALL ECCHPO (IPVECP,0)
  212. END IF
  213. *
  214. * RQ: LE MODE PROPRE CORRESPOND AU COUPLE (FREQPP,IPVECP),
  215. * "IPVECP" ETANT UN POINTEUR SUR UN SEGMENT DE 'CHPOINT'.
  216. *
  217. * -- CREATION DE L'OBJET REPRESENTANT LE MODE --
  218. *
  219. FREQ = SQRT(ABS(W2)) / DEUXPI
  220. IF(LIMAGE) THEN
  221. FREQ = SIGN (FREQ,W2)
  222. ENDIF
  223. NUMOD2 = 0
  224. c CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ,NUMOD2,IPMODE)
  225. CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,NUMOD2,IPMODE)
  226. IF (IERR .NE. 0) RETURN
  227. *
  228. * IMPRESSION DU MODE( ON N'IMPRIME PAS LE CHPOINT)
  229. IF (IIMPI.EQ.2) THEN
  230. WRITE (IOIMP,2000)
  231. 2000 FORMAT ('1MODE PROPRE CALCULE:'/' --------------------'//)
  232. CALL ECMODE (IPMODE)
  233. ENDIF
  234. *
  235. * -- SUPPRESSION DES OBJETS DE TRAVAIL --
  236. *
  237. CALL DTRIGI (IPKW2M)
  238. *
  239. END
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  

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