Télécharger grad.eso

Retour à la liste

Numérotation des lignes :

grad
  1. C GRAD SOURCE CB215821 22/06/23 21:15:02 11392
  2.  
  3. C=======================================================================
  4. C= G R A D =
  5. C= ------- =
  6. C= =
  7. C= OPERATEUR CAST3M "GRAD" DE CALCUL DU GRADIENT D'UN CHAMP : =
  8. C= ---------------------------------------------------------- =
  9. C= GRA1 = 'GRAD' MODL1 CHP1 ou CHE1 ( CAR1 ) ; =
  10. C= =
  11. C= Cet operateur calcule le gradient d'un champ de temperatures ou =
  12. C= de deplacements. =
  13. C= =
  14. C= ARGUMENTS : =
  15. C= ----------- =
  16. C= MODL1 (MMODEL) Modele associe a la structure etudiee =
  17. C= CHP1 (CHPOINT) | Champ de deplacements (NOEUDS) =
  18. C= CHE1 (MCHAML) | ou de temperatures (ELEMENT) =
  19. C= CAR1 (MCHAML) Caracteristiques geometriques (facultatif) =
  20. C= Sous-type 'CARACTERISTIQUES' =
  21. C= =
  22. C= RESULTAT : =
  23. C= ---------- =
  24. C= GRA1 (MCHAML) Champ de gradients sur la structure =
  25. C= =
  26. C= SUO X.Z., le 16 novemebre 1986. =
  27. C= Christian LE BRETON et Denis ROBERT-MOUGIN, le 31 juillet 1989. =
  28. C= Modifications aux nouvelles normes par I. MONNIER, le 28 mai 1990. =
  29. C=======================================================================
  30.  
  31. SUBROUTINE GRAD
  32.  
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8 (A-H,O-Z)
  35. INTEGER ZERO
  36.  
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMCHAML
  41. -INC CCHAMP
  42. -INC SMCOORD
  43.  
  44. CHARACTER*4 MOCONS(1)
  45. DATA MOCONS/'CONS'/
  46.  
  47.  
  48. C On a besoin du MCOORD plus loin
  49. SEGACT,MCOORD
  50.  
  51. C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
  52. C ==========================================
  53. C 1.1 - Lecture OBLIGATOIRE du modele (IPMODL)
  54. C =====
  55. CALL LIROBJ('MMODEL ',IPMODL,1,IRET)
  56. CALL ACTOBJ('MMODEL ',IPMODL,1)
  57. IF (IERR.NE.0) RETURN
  58. C =====
  59. C 1.2 - Syntaxe 1 : lecture d'un CHPOINT de depl. ou T (IPCHP1)
  60. C Transformation du CHPOINT en MCHAML aux noeuds (IPCHE2)
  61. C =====
  62. ZERO=0
  63. IRET1=0
  64. CALL LIROBJ('CHPOINT ',IPCHP1,0,IRET1)
  65. IF (IERR.NE.0) RETURN
  66. IRET2=0
  67. IF (IRET1.NE.0) THEN
  68. CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  69. IPCHL1=IPCHP1
  70. CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE2,1)
  71. IF (IERR.NE.0) RETURN
  72. C =====
  73. C 1.3 - Syntaxe 3 : lecture d'un MCHAML de depl. ou T (IPCHE2)
  74. C ERREUR si le mode de calcul est "generalise"
  75. C =====
  76. ELSE
  77. IF (IFOUR.EQ.-3.OR.
  78. . (IFOUR.GE.7.AND.IFOUR.LE.11).OR.IFOUR.EQ.14) THEN
  79. MOTERR(1:8)='CHPOINT '
  80. CALL ERREUR(37)
  81. RETURN
  82. ENDIF
  83. IPCHL1=0
  84. CALL LIROBJ('MCHAML ',IPIN,1,IRET2)
  85. CALL ACTOBJ('MCHAML ',IPIN,1)
  86. IF (IERR.NE.0) RETURN
  87. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  88. IF (IR.NE.1) CALL ERREUR(KER)
  89. IF(IERR.NE.0) RETURN
  90. ENDIF
  91. C =====
  92. C 1.4 - Lecture FACULTATIVE des caracteristiques geometriques (IPCHE1)
  93. C =====
  94. IRET3=0
  95. CALL LIROBJ('MCHAML ',IPCHE1,0,IRET3)
  96. IF(IRET3 .EQ. 1) CALL ACTOBJ('MCHAML ',IPCHE1,1)
  97. IF (IERR.NE.0) RETURN
  98. IPCH1=0
  99. IF (IRET3.NE.0.AND.IRET2.NE.0) THEN
  100. CALL ACTOBJ('MCHAML ',IPCHE1,1)
  101. CALL RNGCHA(IPCHE1,IPCHE2,'CARACTERISTIQUES',
  102. . 'DEPLACEMENTS',IPCHA1,IPCHA2)
  103. IF (IPCHA1.EQ.0.OR.IPCHA2.EQ.0) THEN
  104. CALL ERREUR(805)
  105. RETURN
  106. ENDIF
  107. IPCHE1=IPCHA1
  108. IPCHE2=IPCHA2
  109. CALL REDUAF(IPCHE1,IPMODL,IPCH1,0,IR,KER)
  110. IF (IR.NE.1) CALL ERREUR(KER)
  111. IF(IERR.NE.0) RETURN
  112. IPCHE1 = IPCH1
  113. ENDIF
  114.  
  115. C =====
  116. C 1.5 - Lecture FACULTATIVE du mot 'CONS'
  117. C =====
  118. ISCA=0
  119. CALL LIRMOT(MOCONS,1,ISCA,0)
  120.  
  121. IF (ISCA.EQ.0) THEN
  122. CALL GRAD1(IPMODL,ZERO,IPCHE2,IPCHE1,IPCHL1,IRET)
  123. IF(IERR.NE.0) RETURN
  124. ELSE
  125. CALL GRAD2(IPMODL,IPCHE2,IPCHE1,IPCHL1,IRET)
  126. IF(IERR.NE.0) RETURN
  127. ENDIF
  128.  
  129. IF (IRET.EQ.1) THEN
  130. CALL ACTOBJ('MCHAML ',IPCHL1,1)
  131. CALL ECROBJ('MCHAML ',IPCHL1)
  132. ENDIF
  133.  
  134. END
  135.  
  136.  

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