Télécharger hooke.eso

Retour à la liste

Numérotation des lignes :

  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