Télécharger la plaquette Cast3M


fr en

Télécharger work.eso

Retour à la liste

Numérotation des lignes : 

work

  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