Télécharger work.eso

Retour à la liste

Numérotation des lignes :

  1. C WORK SOURCE CB215821 19/08/01 21:16:46 10279
  2. SUBROUTINE WORK
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C
  7. C DENSITE D'ENERGIE
  8. C CALCULE LE MCHAML PRODUIT SIGMA * GRADIENT
  9. C
  10. C SYNTAXE WORK1=WORK MODL1 SIG1 GRAD1( GRAF1)
  11. C MODL1= OBJET DE TYPE MMODEL
  12. C SIG1 = CHAMP DE CONTRAINTE (TYPE MCHAML)
  13. C GRAD1= CHAMP DE GRADIENT (TYPE MCHAML)
  14. C GRAF1= CHAMP DE GRADIENT DE FLEXION (TYPE MCHAML)
  15. C WORK1=CHAMP DE DENSITE D'ENERGIE (TYPE MCHAML)
  16. C CODE DE SUO X.Z.
  17. C PASSAGE AUX NOUVEAUX CHAMELEMS PAR P. DOWLATYARI LE 25/4/91
  18. C=======================================================================
  19. C
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. C
  24. IPMODL=0
  25. IPCHE1=0
  26. IPCHE2=0
  27. IPCHE3=0
  28. IPCHE4=0
  29. C
  30. C LECTURE D'UN OBJET MMODEL
  31. C
  32. CALL LIROBJ('MMODEL ',IPMODL,1,IRET)
  33. CALL ACTOBJ('MMODEL ',IPMODL,1)
  34. IF(IERR.NE.0)RETURN
  35. C
  36. C **** LECTURE DU PREMIER CHAMP/ELEMENT
  37. C
  38. CALL LIROBJ('MCHAML ',IPIN,1,IRET)
  39. CALL ACTOBJ('MCHAML ',IPIN,1)
  40. IF(IERR.NE.0)RETURN
  41. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  42. IF(IR .NE. 1) CALL ERREUR(KER)
  43. IF(IERR .NE. 0) RETURN
  44. C
  45. C **** LECTURE DU DEUXIEME CHAMP/ELEMENT
  46. C
  47. CALL LIROBJ('MCHAML ',IPIN,1,IRET)
  48. CALL ACTOBJ('MCHAML ',IPIN,1)
  49. IF(IERR.NE.0) RETURN
  50. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  51. IF(IR .NE. 1) CALL ERREUR(KER)
  52. IF(IERR .NE. 0) RETURN
  53. C
  54. C
  55. C **** LECTURE DU TROISIEME CHAMP SI COQUE , QUI DOIT ETRE GRAF
  56. C
  57. CALL LIROBJ('MCHAML ',IPIN,0,IRET)
  58. IF(IERR.NE.0)RETURN
  59. IPCHE3=0
  60. IF (IRET .EQ. 1) THEN
  61. CALL ACTOBJ('MCHAML ',IPIN,1)
  62. CALL REDUAF(IPIN,IPMODL,IPCHE3,0,IR,KER)
  63. IF(IR .NE. 1) CALL ERREUR(KER)
  64. IF(IERR .NE. 0) RETURN
  65. ENDIF
  66. C
  67. CALL WORKP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IRET)
  68. C
  69. IF(IRET.NE.0) THEN
  70. CALL ACTOBJ('MCHAML ',IPCHE4,1)
  71. CALL ECROBJ('MCHAML ',IPCHE4)
  72. ENDIF
  73.  
  74. END
  75.  
  76.  
  77.  

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