Télécharger crit.eso

Retour à la liste

Numérotation des lignes :

  1. C CRIT SOURCE CB215821 19/07/30 21:15:47 10273
  2. SUBROUTINE CRIT
  3. C=======================================================================
  4. C
  5. C OPERATEUR CRITERE
  6. C
  7. C SCA = CRIT MODL SIG VAR CAR
  8. C
  9. C MMODEL | MODL OBJET MODELE
  10. C
  11. C | SIG CONTRAINTES
  12. C MCHAMLS | VAR VARIABLES INTERNES
  13. C | CAR CONSTANTES DU MATERIAU ET CARACTERISTIQUES
  14. C | GEOMETRIQUES ( SELON LES ELEMENTS )
  15. C | SCA CRITERE RESULTAT
  16. C
  17. C=======================================================================
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8(A-H,O-Z)
  20. *
  21. -INC CCOPTIO
  22. -INC SMCHAML
  23. *
  24. IPCHE1=0
  25. IPCHE2=0
  26. IPCAR=0
  27. *
  28. * LECTURE D'UN MODEL
  29. *
  30. CALL LIROBJ('MMODEL ',IPMODL,1,IRT)
  31. CALL ACTOBJ('MMODEL ',IPMODL,1)
  32. IF(IERR.NE.0)RETURN
  33. *
  34. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  35. CALL ACTOBJ('MCHAML ',IPIN,1)
  36. IF(IERR.NE.0)RETURN
  37. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  38. IF(IR .NE. 1) CALL ERREUR(KER)
  39. IF(IERR .NE. 0) RETURN
  40.  
  41. MCHELM=IPCHE1
  42. IF(TITCHE.NE.'CONTRAINTES')THEN
  43. MOTERR(1:8)='CONTRAIN'
  44. CALL ERREUR(109)
  45. RETURN
  46. ENDIF
  47. *
  48. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  49. CALL ACTOBJ('MCHAML ',IPIN,1)
  50. IF(IERR.NE.0)RETURN
  51. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  52. IF(IR .NE. 1) CALL ERREUR(KER)
  53. IF(IERR .NE. 0) RETURN
  54.  
  55. MCHELM=IPCHE2
  56. IF(TITCHE.NE.'VARIABLES INTERNES')THEN
  57. MOTERR(1:8)='VARINTER'
  58. CALL ERREUR(109)
  59. RETURN
  60. ENDIF
  61. *
  62. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  63. CALL ACTOBJ('MCHAML ',IPIN,1)
  64. IF(IERR.NE.0)RETURN
  65. CALL REDUAF(IPIN,IPMODL,IPCAR,0,IR,KER)
  66. IF(IR .NE. 1) CALL ERREUR(KER)
  67. IF(IERR .NE. 0) RETURN
  68.  
  69. MCHELM=IPCAR
  70. IF(TITCHE.NE.'CARACTERISTIQUES')THEN
  71. MOTERR(1:8)='CARACTER'
  72. CALL ERREUR(109)
  73. RETURN
  74. ENDIF
  75. *
  76. CALL CRITP(IPMODL,IPCHE1,IPCHE2,IPCAR,IPCHES)
  77. IF(IERR .NE. 0) RETURN
  78.  
  79. CALL ACTOBJ('MCHAML ',IPCHES,1)
  80. CALL ECROBJ('MCHAML ',IPCHES)
  81.  
  82. END
  83.  
  84.  
  85.  

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