Télécharger la plaquette Cast3M


fr en

Télécharger extr10.eso

Retour à la liste

Numérotation des lignes : 

extr10

  1. C EXTR10    SOURCE    CHAT      05/01/12    23:51:45     5004
  2.       SUBROUTINE EXTR10(ISTR,MOT, IPTR)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. *                             E X T R 1 0
  8. *                             -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     SOUS-PROGRAMME POUR EXTRAIRE D'UNE STRUCTURE
  14. *            UNE RIGIDITE.
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMSTRUC
  23. *
  24. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  25. * -----------
  26. *
  27. *     ISTR    (E)  POINTEUR SUR L'OBJET STRUCTURE.
  28. *     MOT     (E)  MOT-CLE : 'RIGI' OU 'MASS'.
  29. *     IPTR    (S)  POINTEUR SUR L'OBJET RIGIDITE.
  30. *
  31.       CHARACTER*4 MOT
  32. *
  33. * MODE DE FONCTIONNEMENT:
  34. * -----------------------
  35. *
  36. *     ON SUPPOSE QUE LE PROGRAMME APPELANT  A VERIFIE QUE LE
  37. *        MOT-CLE SOIT CORRECT.
  38. *
  39. * AUTEUR, DATE DE CREATION:
  40. * -------------------------
  41. *
  42. *     LIONEL VIVAN       JUILLET 1988
  43. *
  44. * LANGAGE:
  45. * --------
  46. *
  47. *     ESOPE + FORTRAN77
  48. *
  49. ************************************************************************
  50. *
  51.       MSTRUC = ISTR
  52.       SEGACT MSTRUC
  53.       NSTRU = LISTRU(/1)
  54.       DO 10 IS = 1,NSTRU
  55.          MSOSTU = LISTRU(IS)
  56.          SEGACT MSOSTU
  57.          IF (IS .EQ. 1) THEN
  58.             IF (MOT .EQ. 'RIGI') THEN
  59.                IPT1 = ISRAID
  60.             ELSE
  61.                IPT1 = ISMASS
  62.             ENDIF
  63.          ELSE
  64.             IF (MOT .EQ. 'RIGI') THEN
  65.                IPT2 = ISRAID
  66.             ELSE
  67.                IPT2 = ISMASS
  68.             ENDIF
  69.             CALL FUSRIG(IPT1,IPT2,IPT3)
  70.             IF (IERR.NE.0) RETURN
  71.             CALL DTRIGI(IPT1)
  72.             IF (IERR.NE.0) RETURN
  73.             IPT1 = IPT3
  74.          ENDIF
  75.          SEGDES MSOSTU
  76. 10    CONTINUE
  77.       SEGDES MSTRUC
  78.       IPTR = IPT1
  79. *
  80.       END
  81.  
  82.  

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