Télécharger la plaquette Cast3M


fr en

Télécharger intva2.eso

Retour à la liste

Numérotation des lignes : 

intva2

  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.  
  87. -INC PPARAM
  88. -INC CCOPTIO
  89. -INC SMSOLUT
  90. *
  91. *     REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:
  92.       COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,
  93.      &       NUMW2B ,IUN
  94. *
  95.       LOGICAL NONVID,LIMAGE,LMULT
  96. *
  97.       PARAMETER (SMALL = 1.D-2 , SMALS2 = SMALL/2.D0)
  98.       PARAMETER (DEUXPI = (2.D0*XPI))
  99. *
  100.       NONVID = .TRUE.
  101.       IFREQ = 0
  102.       IMULTP=0
  103.       IALEAT=0
  104.       INSYM=0
  105.       IBID1=0
  106.       IBID2=0
  107. *
  108. *     /FAIRE TANT QUE .../
  109.   105 CONTINUE
  110.       IF (NONVID .AND. (IFREQ .LT. NBFREQ) ) THEN
  111. *
  112.          IF (IIMPI.EQ.2) CALL VRFINT(LIMAGE)
  113. *
  114.          IF (NUMW2A .EQ. NUMW2B) THEN
  115. *
  116. *           ON RACCOURCIT L'INTERVALLE EN SUPPRIMANT LA PARTIE (W2A,W2B)
  117.             CALL INTVA6 (NONVID)
  118.             IF (IERR .NE. 0) RETURN
  119.             GOTO 105
  120. *
  121.          ELSE IF (NUMW2A .EQ. (NUMW2B + IUN)
  122.      &   .OR. ABS( (W2A-W2B) / (W2A+W2B) ) .LT. SMALS2) THEN
  123. *
  124.             IF (NUMW2A .NE. (NUMW2B + IUN) ) THEN
  125.              IF (.NOT.LMULT) THEN
  126.                IF (IIMPI.EQ.2) WRITE (IOIMP,2000) SMALL,W2A,W2B
  127.  2000          FORMAT (//,' ***** ATTENTION: MODES PROPRES DE MEME '
  128.      &              ,'PULSATION OU DE PULSATIONS AU CARRE VOISINES '/
  129.      &              ,' ***** A MOINS DE ',1PE8.1,' (ECART RELATIF)'
  130.      &              ,' DANS L''INTERVALLE (',1PE12.5,',',1PE12.5,').'/
  131.      &              ,' ***** ON NE RECHERCHE QU''UN SEUL MODE DANS CET'
  132.      &              ,' INTERVALLE.'///)
  133.                IMULTP=1
  134.              ENDIF
  135.             END IF
  136. *
  137. *           RECHERCHE DE MODE PROPRE:
  138. **********************************************************************
  139. *
  140. *       -- RECHERCHE DES MODES PROPRES MULTIPLES MISE EN PLACE
  141. *       LE   29/08/94 .  --
  142. *
  143. **********************************************************************
  144.  
  145.             NBMOD = NUMW2A - NUMW2B
  146.  
  147.             IF ( (NBMOD .EQ. 1) .OR. ( .NOT. LMULT ) )  THEN
  148. ******
  149. *       -- AVANT L'AJOUT DES MODES MULTIPLES --
  150. ***
  151.                CALL INTVA3 (IPRIGI,IPMASS,INF0,IPMODE,IALEAT,LIMAGE)
  152.             ELSE
  153. ******
  154. *       -- APRES L'AJOUT DES MODES MULTIPLES --
  155. ***
  156.                W2 = ( W2A + W2B ) / 2.D0
  157.                FREQ = SQRT( ABS(W2) ) / DEUXPI
  158.                FREQ = SIGN( FREQ, W2 )
  159.                CALL PROCH3(FREQ,NBMOD,IPRIGI,IPMASS,INF0,IPMODE,LIMAGE
  160.      $  , INSYM,IBID1,IBID2)
  161.             ENDIF
  162.  
  163. ******
  164. *       -- FIN DE LA MODIFICATION --
  165. ***
  166.             IMULTP=0
  167.             IF (IERR .NE. 0) RETURN
  168.             IFREQ = IFREQ + 1
  169. *
  170. *           AJOUT DU MODE A L'ENSEMBLE DES MODES:
  171.             IF (IFREQ .EQ. 1) THEN
  172.                IPSOLU = IPMODE
  173.             ELSE
  174.                CALL FUSOLU (IPSOLU,IPMODE,  IPSOL1)
  175.                IF (IERR .NE. 0) RETURN
  176.                CALL DESOLU (IPMODE)
  177.                CALL DESOLU (IPSOLU)
  178.                IPSOLU = IPSOL1
  179.             END IF
  180. *
  181. *           ON RACCOURCIT L'INTERVALLE EN SUPPRIMANT LA PARTIE (W2A,W2B)
  182.             CALL INTVA6 (NONVID)
  183.             IF (IERR .NE. 0) RETURN
  184.             GOTO 105
  185. *
  186.          ELSE IF ( (IUN*(NUMW2A -NUMW2B) ) .GT. 0) THEN
  187. *
  188.             W2I = (W2A + W2B) / 2.D0
  189.             CALL NBVALP (IPRIGI,IPMASS,W2I,  NUMW2I)
  190.             IF (IERR .NE. 0) RETURN
  191. *
  192.             IF (NUMW2I .EQ. NUMW2B) THEN
  193. *              ON RACCOURCIT L'INTERVALLE EN REMPLACANT "W2B" PAR "W2I":
  194.                CALL INTVA5
  195.                IF (IERR .NE. 0) RETURN
  196.             ELSE
  197. *              ON INSERE "W2I" AVANT "W2B" DANS LA PARTITION:
  198.                CALL INTVA4
  199.                IF (IERR .NE. 0) RETURN
  200.             END IF
  201. *
  202.          ELSE
  203. *
  204.             NUMERR = 185
  205.             CALL ERREUR (NUMERR)
  206.             RETURN
  207. *
  208.          END IF
  209. *
  210.          GOTO 105
  211.       END IF
  212. *     /FIN FAIRE/
  213. *
  214.       IF(IALEAT.NE.0) CALL DTCHPO(IALEAT)
  215.       IF(IFREQ.EQ.0) THEN
  216.          NIPO=0
  217.          SEGINI MSOLUT
  218.          ITYSOL='MODE    '
  219.          SEGDES MSOLUT
  220.          IPSOLU=MSOLUT
  221.        ENDIF
  222.       END
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  

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