Télécharger extra7.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTRA7 SOURCE CHAT 05/01/12 23:53:19 5004
  2. SUBROUTINE EXTRA7 (IPBASE,MOT, IPTR)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * E X T R A 7
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * SOUS-PROGRAMME POUR EXTRAIRE D'UNE BASE MODALE
  14. * UNE 'RIGIDITE',
  15. * OU L'OBJET SOLUTION DE SOUS-TYPE 'MODE ',
  16. * OU L'OBJET SOLUTION DE SOUS_TYPE 'SOLUSTAT',
  17. * OU L'OBJET SOLUTION DE SOUS_TYPE 'PSEUMODE'.
  18. *
  19. * MODULES UTILISES:
  20. * -----------------
  21. *
  22. -INC CCOPTIO
  23. -INC SMBASEM
  24. -INC SMSTRUC
  25. *
  26. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  27. * -----------
  28. *
  29. * IPBASE (E) POINTEUR SUR LE SEGMENT MBASEM
  30. * MOT (E) MOT-CLE : 'RIGI', OU 'MASS',
  31. * OU 'MODE', OU 'STAT', 'PSMO'.
  32. * IPTR (S) POINTEUR SUR UN OBJET RIGIDITE SI 'RIGI' OU 'MASS'
  33. * POINTEUR SUR UN OBJET SOLUTION
  34. * SI 'MODE' OU 'STAT' OU 'PSMO'.
  35. *
  36. CHARACTER*4 MOT
  37. *
  38. * MODE DE FONCTIONNEMENT :
  39. * ------------------------
  40. *
  41. * ON SUPPOSE QUE LE PROGRAMME APPELANT A VERIFIE QUE LE
  42. * MOT-CLE SOIT CORRECT.
  43. *
  44. * AUTEUR, DATE DE CREATION:
  45. * -------------------------
  46. *
  47. * LIONEL VIVAN 4 MARS 1988
  48. *
  49. * LANGAGE:
  50. * --------
  51. *
  52. * ESOPE + FORTRAN77
  53. *
  54. ************************************************************************
  55. *
  56. IF (MOT.EQ.'MODE' .OR. MOT.EQ.'STAT' .OR. MOT.EQ.'PSMO') THEN
  57. MBASEM=IPBASE
  58. SEGACT,MBASEM
  59. NBAS=LISBAS(/1)
  60. DO 10 I=1,NBAS
  61. MSOBAS=LISBAS(I)
  62. SEGACT,MSOBAS
  63. IF (I.EQ.1) THEN
  64. IF (MOT.EQ.'MODE') THEN
  65. IPTM1=IBSTRM(2)
  66. ELSE IF (MOT.EQ.'STAT') THEN
  67. IPTM1=IBSTRM(3)
  68. ELSE
  69. IPTM1=IBSTRM(5)
  70. ENDIF
  71. ELSE
  72. IF (MOT.EQ.'MODE') THEN
  73. IPTM2=IBSTRM(2)
  74. ELSE IF (MOT.EQ.'STAT') THEN
  75. IPTM2=IBSTRM(3)
  76. ELSE
  77. IPTM2=IBSTRM(5)
  78. ENDIF
  79. CALL FUSOLU(IPTM1,IPTM2,IPTM3)
  80. IF (IERR.NE.0) RETURN
  81. CALL DTSOLU(IPTM1)
  82. IF (IERR.NE.0) RETURN
  83. IPTM1=IPTM3
  84. ENDIF
  85. SEGDES,MSOBAS
  86. 10 CONTINUE
  87. SEGDES,MBASEM
  88. IPTR=IPTM1
  89. *
  90. ELSE IF (MOT.EQ.'MASS' .OR. MOT.EQ.'RIGI') THEN
  91. MBASEM=IPBASE
  92. SEGACT,MBASEM
  93. NBAS=LISBAS(/1)
  94. DO 20 I=1,NBAS
  95. MSOBAS=LISBAS(I)
  96. SEGACT,MSOBAS
  97. MSOSTU=IBSTRM(1)
  98. SEGDES,MSOBAS
  99. SEGACT,MSOSTU
  100. IF (I.EQ.1) THEN
  101. IF (MOT.EQ.'MASS') THEN
  102. IPTR1=ISMASS
  103. ELSE
  104. IPTR1=ISRAID
  105. ENDIF
  106. ELSE
  107. IF (MOT.EQ.'MASS') THEN
  108. IPTR2=ISMASS
  109. ELSE
  110. IPTR2=ISRAID
  111. ENDIF
  112. CALL FUSRIG(IPTR1,IPTR2,IPTR3)
  113. IF (IERR.NE.0) RETURN
  114. CALL DTRIGI(IPTR1)
  115. IF (IERR.NE.0) RETURN
  116. IPTR1=IPTR3
  117. ENDIF
  118. SEGDES,MSOSTU
  119. 20 CONTINUE
  120. SEGDES,MBASEM
  121. IPTR=IPTR1
  122. ENDIF
  123. *
  124. END
  125.  
  126.  

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