Télécharger la plaquette Cast3M


fr en

Télécharger hooke.eso

Retour à la liste

Numérotation des lignes : 

hooke

  1. C HOOKE     SOURCE    PV        20/03/30    21:19:48     10567          
  2.       SUBROUTINE HOOKE
  3. C_______________________________________________________________________
  4. C
  5. C     Op{rateur de cr{ation d'un MCHAML de matrice de HOOKE
  6. C
  7. C     Nouvelle syntaxe:
  8. C     _________________
  9. C
  10. C       HO1=HOOKE MOD1 CAR1 ( VA1 ) ;
  11. C
  12. C          MOD1 Pointeur sur un MMODEL
  13. C          CAR1 Pointeur sur un MCHAML de caract{ristiques
  14. C          VA1  Pointeur sur un MCHAML de variables internes(facultatif)
  15. C          HO1  Pointeur sur un MCHAML de MATRICE DE HOOKE
  16. C
  17. C
  18. C     CODE L.EBERSOLT MAI 84
  19. C
  20. C     Passage aux nouveaux CHAMELEMs par I.Monnier le 15.06.90
  21. C
  22. C_______________________________________________________________________
  23. C
  24.       IMPLICIT INTEGER(I-N)
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMCOORD
  29. C
  30.       CHARACTER*4 MOREFE(1)
  31.       DATA MOREFE/'REFE'/
  32.       segact mcoord
  33.       IPCHE1=0
  34.       IPCHE2=0
  35. *
  36. *  LECTURE DU MOT REFE EVENTUELLEMENT
  37. *
  38.       CALL LIRMOT(MOREFE,1,LASURF,0)
  39.       IF (IERR.NE.0) RETURN
  40. C
  41. C     LECTURE DU MODELE
  42. C
  43.       CALL LIROBJ('MMODEL  ',IPMODL,0,IRT1)
  44.       IF(IRT1 .EQ. 1) CALL ACTOBJ('MMODEL  ',IPMODL,1)
  45.       IF (IERR.NE.0) RETURN
  46. C
  47. C       LECTURE DU MCHAML DE CARACTERISTIQUES GEOMETRIQUES ET MATERIELLE
  48. C
  49.       CALL LIROBJ('MCHAML  ',IPIN,1,IRT1)
  50.       CALL ACTOBJ('MCHAML  ',IPIN,1)
  51.       IF (IERR.NE.0) RETURN
  52.       CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  53.       IF(IR   .NE. 1) CALL ERREUR(KER)
  54.       IF(IERR .NE. 0) RETURN
  55. C
  56. C       LECTURE DU MCHAML DE VARIABLES INTERNES
  57. C
  58.       CALL LIROBJ('MCHAML  ',IPIN,0,IRT2)
  59.       IF (IERR.NE.0) RETURN
  60.       IPCHE2=0
  61.       IF (IRT2 .EQ. 1) THEN
  62.         CALL ACTOBJ('MCHAML  ',IPIN,1)
  63.         CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  64.         IF(IR   .NE. 1) CALL ERREUR(KER)
  65.         IF(IERR .NE. 0) RETURN
  66.       ENDIF
  67. C
  68. C     CALCUL DE LA MATRICE DE HOOKE
  69. C
  70.       CALL HOOK2P(IPMODL,IPCHE1,IPCHE2,LASURF,IPCHOO,IRT1)
  71.       IF(IERR .NE. 0) RETURN
  72.       IF(IRT1.EQ.0) GOTO 666
  73. C
  74. C     ECRITURE DU RESULTAT
  75. C
  76.         CALL ACTOBJ('MCHAML  ',IPCHOO,1)
  77.         CALL ECROBJ('MCHAML  ',IPCHOO)
  78.   666 CONTINUE
  79.       END
  80.  
  81.  
  82.  
  83.  

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