Télécharger hooke.eso

Retour à la liste

Numérotation des lignes :

  1. C HOOKE SOURCE CB215821 19/08/01 21:16:05 10279
  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. -INC CCOPTIO
  26. C
  27. CHARACTER*4 MOREFE(1)
  28. DATA MOREFE/'REFE'/
  29. IPCHE1=0
  30. IPCHE2=0
  31. *
  32. * LECTURE DU MOT REFE EVENTUELLEMENT
  33. *
  34. CALL LIRMOT(MOREFE,1,LASURF,0)
  35. IF (IERR.NE.0) RETURN
  36. C
  37. C LECTURE DU MODELE
  38. C
  39. CALL LIROBJ('MMODEL ',IPMODL,0,IRT1)
  40. IF(IRT1 .EQ. 1) CALL ACTOBJ('MMODEL ',IPMODL,1)
  41. IF (IERR.NE.0) RETURN
  42. C
  43. C LECTURE DU MCHAML DE CARACTERISTIQUES GEOMETRIQUES ET MATERIELLE
  44. C
  45. CALL LIROBJ('MCHAML ',IPIN,1,IRT1)
  46. CALL ACTOBJ('MCHAML ',IPIN,1)
  47. IF (IERR.NE.0) RETURN
  48. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  49. IF(IR .NE. 1) CALL ERREUR(KER)
  50. IF(IERR .NE. 0) RETURN
  51. C
  52. C LECTURE DU MCHAML DE VARIABLES INTERNES
  53. C
  54. CALL LIROBJ('MCHAML ',IPIN,0,IRT2)
  55. IF (IERR.NE.0) RETURN
  56. IPCHE2=0
  57. IF (IRT2 .EQ. 1) THEN
  58. CALL ACTOBJ('MCHAML ',IPIN,1)
  59. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  60. IF(IR .NE. 1) CALL ERREUR(KER)
  61. IF(IERR .NE. 0) RETURN
  62. ENDIF
  63. C
  64. C CALCUL DE LA MATRICE DE HOOKE
  65. C
  66. CALL HOOK2P(IPMODL,IPCHE1,IPCHE2,LASURF,IPCHOO,IRT1)
  67. IF(IERR .NE. 0) RETURN
  68. IF(IRT1.EQ.0) GOTO 666
  69. C
  70. C ECRITURE DU RESULTAT
  71. C
  72. CALL ACTOBJ('MCHAML ',IPCHOO,1)
  73. CALL ECROBJ('MCHAML ',IPCHOO)
  74. 666 CONTINUE
  75. END
  76.  
  77.  
  78.  

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