Télécharger extr16.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR16 SOURCE GOUNAND 11/05/24 21:15:19 6976
  2. SUBROUTINE EXTR16(IRIG,IDUAL,MLMOTS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *-----------------------------------------------------------------------
  6. *
  7. * E X T R 1 6
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * EXTRAIT LES NOMS DES COMPOSANTES OU DES DUALES D'UNE RIGIDITE
  14. * ET LES RANGE DANS UN LISTMOTS MLMOTS
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19. -INC SMRIGID
  20. -INC SMLMOTS
  21. *
  22. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  23. * -----------
  24. *
  25. * IRIG (E) POINTEUR SUR LA RIGIDITE
  26. * IDUAL (E) 1 SI ON VEUT LES DUALES, 0 SINON
  27. * MLMOTS (S) POINTEUR SUR LE LISTMOTS
  28. *
  29. *-----------------------------------------------------------------------
  30. *
  31. *
  32. MRIGID = IRIG
  33. SEGACT MRIGID
  34. JGN=4
  35. JGM=0
  36. SEGINI MLMOTS
  37. IF (IRIGEL(/2).EQ.0) GO TO 90
  38. IF (IRIGEL(/1).LT.3) GO TO 90
  39. *
  40. DO 30 I=1,IRIGEL(/2)
  41. DESCR =IRIGEL(3,I)
  42. SEGACT DESCR
  43. IF (IDUAL.EQ.0) THEN
  44. NK=LISINC(/2)
  45. ELSE
  46. NK=LISDUA(/2)
  47. ENDIF
  48. DO 40 K=1,NK
  49. DO 50 J=1,JGM
  50. IF(IDUAL.EQ.0) THEN
  51. IF (MOTS(J).EQ.LISINC(K)) GOTO 40
  52. ELSE
  53. IF (MOTS(J).EQ.LISDUA(K)) GOTO 40
  54. ENDIF
  55. 50 CONTINUE
  56. JGM=JGM+1
  57. SEGADJ MLMOTS
  58. IF(IDUAL.EQ.0) THEN
  59. MOTS(JGM)=LISINC(K)
  60. ELSE
  61. MOTS(JGM)=LISDUA(K)
  62. ENDIF
  63. 40 CONTINUE
  64. SEGDES DESCR
  65. 30 CONTINUE
  66. *
  67. 90 SEGDES MLMOTS,MRIGID
  68. RETURN
  69. END
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  

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