Télécharger intva2.eso

Retour à la liste

Numérotation des lignes :

  1. C INTVA2 SOURCE CHAT 05/01/13 00:41:46 5004
  2. SUBROUTINE INTVA2 (IPRIGI,IPMASS,NBFREQ,INF0,IPSOLU,LIMAGE,LMULT)
  3. ************************************************************************
  4. *
  5. * I N T V A 2
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * ISOLATION DES PULSATIONS PROPRES CONTENUES DANS UN INTERVALLE
  12. * DONNE ET CALCUL DES MODES PROPRES CORRESPONDANTS.
  13. *
  14. * MODE D'APPEL:
  15. * -------------
  16. *
  17. * CALL INTVA2 (IPRIGI,IPMASS,NBFREQ,INF0,IPSOLU)
  18. *
  19. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  20. * -----------
  21. *
  22. * IPRIGI ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'.
  23. * IPMASS ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'.
  24. * NBFREQ ENTIER (E) NOMBRE MAXIMAL DE MODES PROPRES DEMANDES.
  25. * IPSOLU ENTIER (S) POINTEUR SUR LA 'SOLUTION' CONTENANT LES
  26. * MODES PROPRES.
  27. *
  28. * VOIR AUSSI LE PARAGRAPHE "COMMUN CINTVA".
  29. *
  30. * COMMUN "CINTVA":
  31. * ----------------
  32. *
  33. * IMULTP ENTIER MIS A 1 SI INTERVALLE A DETECTE UN MODE
  34. * MULTIPLE (=0 SINON) (8 AVRIL 86)
  35. * IPW2 ENTIER POINTEUR SUR LE 'LISTREEL' REPRESENTANT LA
  36. * PARTITION DE L'INTERVALLE DE PULSATIONS AU
  37. * CARRE.
  38. * W2A REEL DP AVANT DERNIERE VALEUR DANS LE 'LISTREEL' DE
  39. * POINTEUR "IPW2".
  40. * W2B REEL DP DERNIERE VALEUR DANS LE 'LISTREEL' DE POINTEUR
  41. * "IPW2".
  42. * W2I REEL DP MILIEU DU SOUS-INTERVALLE (W2A,W2B).
  43. * NBW2 ENTIER NOMBRE DE SOUS-INTERVALLES PLUS 1 DE LA
  44. * PARTITION.
  45. * IPNUM ENTIER POINTEUR SUR LE 'LISTENTI' CONTENANT LA
  46. * COLLECTION DES NOMBRES DE PULSATIONS PROPRES AU
  47. * CARRE INFERIEURES AUX PULSATIONS AU CARRE
  48. * COLLECTEES DANS LE 'LISTREEL' DE POINTEUR
  49. * "IPW2".
  50. * NUM... ENTIER NOMBRE DE PULSATIONS PROPRES AU CARRE
  51. * INFERIEURES A ... ("..." REPRESENTANT "W2A",
  52. * "W2B" OU "W2I") A UNE CONSTANTE PRES ,DEPENDANT
  53. * DE LA 'RIGIDITE' DE POINTEUR "IPRIGI".
  54. * IUN ENTIER = +1 SI LA SUITE DE PULSATIONS DEFINISSANT LA
  55. * PARTITION DE L'INTERVALLE EST EN ORDRE
  56. * DECROISSANT,
  57. * = -1 SINON.
  58. *
  59. * A L'ENTREE DANS "INTVA2", LES VALEURS SUIVANTES DU COMMUN "CINTVA"
  60. * ONT ETE INITIALISEES OU FIXEES PAR LE PROGRAMME APPELANT:
  61. * INITIALISEES: W2A, W2B, NBW2, NUMW2A, NUMW2B.
  62. * FIXEES: IPW2, IPNUM, IUN.
  63. *
  64. * SOUS-PROGRAMMES APPELES:
  65. * ------------------------
  66. *
  67. * DESOLU, FUSOLU, INTVA3, INTVA4, INTVA5, INTVA6, VRFINT.
  68. *
  69. * AUTEUR, DATE DE CREATION:
  70. * -------------------------
  71. *
  72. * PASCAL MANIGOT 2 JANVIER 1985
  73. *
  74. * LANGAGE:
  75. * --------
  76. *
  77. * FORTRAN77
  78. * LES ' GOTO 105 ' ONT ETE AJOUTES EN RAISON D'UNE ERREUR DE
  79. * COMPILATEUR LE 8 AVRIL 86
  80. *
  81. ************************************************************************
  82. *
  83. IMPLICIT INTEGER(I-N)
  84. IMPLICIT REAL*8 (A-H,O-Z)
  85. -INC CCREEL
  86. -INC CCOPTIO
  87. -INC SMSOLUT
  88. *
  89. * REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:
  90. COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,
  91. & NUMW2B ,IUN
  92. *
  93. LOGICAL NONVID,LIMAGE,LMULT
  94. *
  95. PARAMETER (SMALL = 1.D-2 , SMALS2 = SMALL/2.D0)
  96. PARAMETER (DEUXPI = (2.D0*XPI))
  97. *
  98. NONVID = .TRUE.
  99. IFREQ = 0
  100. IMULTP=0
  101. IALEAT=0
  102. INSYM=0
  103. IBID1=0
  104. IBID2=0
  105. *
  106. * /FAIRE TANT QUE .../
  107. 105 CONTINUE
  108. IF (NONVID .AND. (IFREQ .LT. NBFREQ) ) THEN
  109. *
  110. IF (IIMPI.EQ.2) CALL VRFINT(LIMAGE)
  111. *
  112. IF (NUMW2A .EQ. NUMW2B) THEN
  113. *
  114. * ON RACCOURCIT L'INTERVALLE EN SUPPRIMANT LA PARTIE (W2A,W2B)
  115. CALL INTVA6 (NONVID)
  116. IF (IERR .NE. 0) RETURN
  117. GOTO 105
  118. *
  119. ELSE IF (NUMW2A .EQ. (NUMW2B + IUN)
  120. & .OR. ABS( (W2A-W2B) / (W2A+W2B) ) .LT. SMALS2) THEN
  121. *
  122. IF (NUMW2A .NE. (NUMW2B + IUN) ) THEN
  123. IF (.NOT.LMULT) THEN
  124. IF (IIMPI.EQ.2) WRITE (IOIMP,2000) SMALL,W2A,W2B
  125. 2000 FORMAT (//,' ***** ATTENTION: MODES PROPRES DE MEME '
  126. & ,'PULSATION OU DE PULSATIONS AU CARRE VOISINES '/
  127. & ,' ***** A MOINS DE ',1PE8.1,' (ECART RELATIF)'
  128. & ,' DANS L''INTERVALLE (',1PE12.5,',',1PE12.5,').'/
  129. & ,' ***** ON NE RECHERCHE QU''UN SEUL MODE DANS CET'
  130. & ,' INTERVALLE.'///)
  131. IMULTP=1
  132. ENDIF
  133. END IF
  134. *
  135. * RECHERCHE DE MODE PROPRE:
  136. **********************************************************************
  137. *
  138. * -- RECHERCHE DES MODES PROPRES MULTIPLES MISE EN PLACE
  139. * LE 29/08/94 . --
  140. *
  141. **********************************************************************
  142.  
  143. NBMOD = NUMW2A - NUMW2B
  144.  
  145. IF ( (NBMOD .EQ. 1) .OR. ( .NOT. LMULT ) ) THEN
  146. ******
  147. * -- AVANT L'AJOUT DES MODES MULTIPLES --
  148. ***
  149. CALL INTVA3 (IPRIGI,IPMASS,INF0,IPMODE,IALEAT,LIMAGE)
  150. ELSE
  151. ******
  152. * -- APRES L'AJOUT DES MODES MULTIPLES --
  153. ***
  154. W2 = ( W2A + W2B ) / 2.D0
  155. FREQ = SQRT( ABS(W2) ) / DEUXPI
  156. FREQ = SIGN( FREQ, W2 )
  157. CALL PROCH3(FREQ,NBMOD,IPRIGI,IPMASS,INF0,IPMODE,LIMAGE
  158. $ , INSYM,IBID1,IBID2)
  159. ENDIF
  160.  
  161. ******
  162. * -- FIN DE LA MODIFICATION --
  163. ***
  164. IMULTP=0
  165. IF (IERR .NE. 0) RETURN
  166. IFREQ = IFREQ + 1
  167. *
  168. * AJOUT DU MODE A L'ENSEMBLE DES MODES:
  169. IF (IFREQ .EQ. 1) THEN
  170. IPSOLU = IPMODE
  171. ELSE
  172. CALL FUSOLU (IPSOLU,IPMODE, IPSOL1)
  173. IF (IERR .NE. 0) RETURN
  174. CALL DESOLU (IPMODE)
  175. CALL DESOLU (IPSOLU)
  176. IPSOLU = IPSOL1
  177. END IF
  178. *
  179. * ON RACCOURCIT L'INTERVALLE EN SUPPRIMANT LA PARTIE (W2A,W2B)
  180. CALL INTVA6 (NONVID)
  181. IF (IERR .NE. 0) RETURN
  182. GOTO 105
  183. *
  184. ELSE IF ( (IUN*(NUMW2A -NUMW2B) ) .GT. 0) THEN
  185. *
  186. W2I = (W2A + W2B) / 2.D0
  187. CALL NBVALP (IPRIGI,IPMASS,W2I, NUMW2I)
  188. IF (IERR .NE. 0) RETURN
  189. *
  190. IF (NUMW2I .EQ. NUMW2B) THEN
  191. * ON RACCOURCIT L'INTERVALLE EN REMPLACANT "W2B" PAR "W2I":
  192. CALL INTVA5
  193. IF (IERR .NE. 0) RETURN
  194. ELSE
  195. * ON INSERE "W2I" AVANT "W2B" DANS LA PARTITION:
  196. CALL INTVA4
  197. IF (IERR .NE. 0) RETURN
  198. END IF
  199. *
  200. ELSE
  201. *
  202. NUMERR = 185
  203. CALL ERREUR (NUMERR)
  204. RETURN
  205. *
  206. END IF
  207. *
  208. GOTO 105
  209. END IF
  210. * /FIN FAIRE/
  211. *
  212. IF(IALEAT.NE.0) CALL DTCHPO(IALEAT)
  213. IF(IFREQ.EQ.0) THEN
  214. NIPO=0
  215. SEGINI MSOLUT
  216. ITYSOL='MODE '
  217. SEGDES MSOLUT
  218. IPSOLU=MSOLUT
  219. ENDIF
  220. END
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  

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