Télécharger hotan.eso

Retour à la liste

Numérotation des lignes :

  1. C HOTAN SOURCE CB215821 16/12/05 21:39:34 9237
  2. SUBROUTINE HOTAN
  3. *_____________________________________________________________________
  4. *
  5. * creation d'un mchaml de matrice de hooke tangente
  6. *
  7. *
  8. *
  9. * ho1=hotan mod1 si1 va1 ( ca1 ) (xprec) (flo1) (dt) (flo2) ;
  10. *
  11. * mod1 modele de calcul, type mmodel
  12. * si1 champ par element de contraintes,type mchaml
  13. * va1 champ par element de variables internes,type mchaml
  14. * ca1 champ par element de caracteristiques ( materielle
  15. * et/ou geometriques ),type mchaml
  16. * flo1 flottant (1.d-3 par defaut)
  17. * ho1 champ par element resultat, de type mchaml et de sous
  18. * type matrice de hooke tangent
  19. *
  20. *
  21. *_____________________________________________________________________
  22. *
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25. -INC CCOPTIO
  26. *
  27. CHARACTER*4 DEUXMOT(2)
  28. * on lit un ou deux flottants xprec et dt
  29. DATA DEUXMOT/'PREC','DT '/
  30. XPREC=1.D-3
  31. DTPS=0.D0
  32. 1 CONTINUE
  33. CALL LIRMOT(DEUXMOT,2,IVAL,0)
  34. IF ( IVAL .EQ. 1) THEN
  35. CALL LIRREE(XPREC,1,IRTFLO)
  36. GOTO 1
  37. ELSE IF ( IVAL .EQ. 2) THEN
  38. CALL LIRREE(DTPS,1,IRTFLO)
  39. GOTO 1
  40. ENDIF
  41. *
  42. * lecture d'un model
  43. *
  44. CALL LIROBJ('MMODEL',IPMODL,0,IRTM)
  45. IF(IERR.NE.0) GOTO 666
  46. *
  47. * lecture du mchaml de contraintes
  48. *
  49. CALL LIROBJ('MCHAML',IPIN,1,IRT1)
  50. IF(IERR.NE.0) GOTO 666
  51. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  52. IF(IR .NE. 1) CALL ERREUR(KER)
  53. IF(IERR .NE. 0) RETURN
  54. *
  55. * lecture du mchaml de variables internes
  56. *
  57. CALL LIROBJ('MCHAML',IPIN,1,IRT2)
  58. IF(IERR.NE.0) GOTO 666
  59. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  60. IF(IR .NE. 1) CALL ERREUR(KER)
  61. IF(IERR .NE. 0) RETURN
  62. *
  63. * lecture du mchaml de caracteristiques
  64. *
  65. CALL LIROBJ('MCHAML',IPIN,1,IRT3)
  66. IF(IERR.NE.0) GOTO 666
  67. CALL REDUAF(IPIN,IPMODL,IPCHE3,0,IR,KER)
  68. IF(IR .NE. 1) CALL ERREUR(KER)
  69. IF(IERR .NE. 0) RETURN
  70. *
  71. CALL HOTANP(IPMODL,IPCHE1,IPCHE2,IPCHE3,XPREC,DTPS,IPCHOT,IRET)
  72. IF(IERR .NE. 0) RETURN
  73. *
  74. * ecriture du champs par element de matrice de hooke
  75. *
  76. IF (IRET.EQ.1) THEN
  77. CALL ECROBJ('MCHAML',IPCHOT)
  78. ENDIF
  79. 666 CONTINUE
  80. RETURN
  81. END
  82.  
  83.  
  84.  

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