Télécharger intgra.eso

Retour à la liste

Numérotation des lignes :

  1. C INTGRA SOURCE GF238795 18/02/01 21:15:43 9724
  2.  
  3. C---------------------------------------------------------------------
  4. C
  5. C OPERATEUR INTG
  6. C
  7. C---------------------------------------------------------------------
  8. C
  9. C SYNTAXE 1 : RESU1 = INTG ('ELEM') MODE1 CHAM1 ( MOT2 ) ( CHAM2 );
  10. C
  11. C Integration d'une composante d'un MCHAML sur le domaine ou elle est
  12. C definie. Le resultat est soit global, soit local (i.e. sur chaque
  13. C element, option ELEM).
  14. C
  15. C ELEM : Option precisant que le resultat est donne elt par elt (MOT)
  16. C MODE1 : Modele de calcul (MMODEL)
  17. C CHAM1 : Champ par element (MCHAML)
  18. C MOT2 : Nom de la composante a integrer (MOT, facultatif si 1 comp.)
  19. C CHAM2 : Champ par element de CARACTERISTIQUE (MCHAML, facultatif)
  20. C RESU1 : FLOTTANT si l'option 'ELEM' n'est pas precisee,
  21. C Champ par element (objet MCHAML) sinon.
  22. C
  23. C---------------------------------------------------------------------
  24. C
  25. C SYNTAXE 2 : RESU1 = INTG EVOL1 ('ABS') (DEBU FIN);
  26. C
  27. C Integration d'une evolution composee d'1 ou plusieurs courbes
  28. C par la methode des trapezes (anciennement realise par SOMM)
  29. C
  30. C EVOL1 : Evolution en entree
  31. C ABS : mot cle pour integrer la valeur absolue de la fonction
  32. C DEBU/FIN : bornes d'integration
  33. C si ENTIER ou LISTENTI, indices de debut/fin
  34. C si REEL ou LISTREEL, abscisses de debut/fin
  35. C
  36. C---------------------------------------------------------------------
  37.  
  38. SUBROUTINE INTGRA
  39.  
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8 (A-H,O-Z)
  42.  
  43. -INC CCOPTIO
  44. -INC SMCHAML
  45.  
  46. CHARACTER*4 MACOMP,MOT1
  47. CHARACTER*8 CHBOR
  48. LOGICAL BDARCY
  49. INTEGER IDARC
  50.  
  51.  
  52. C---------------------------------------------------------------------
  53. C SYNTAXE 1 (par defaut)
  54. C---------------------------------------------------------------------
  55. IDARC = 0
  56. IELEM = 0
  57. IRET = 0
  58. IPIN = 0
  59. IPMODL = 0
  60. IPCHB1 = 0
  61. IPCHE2 = 0
  62. IR = 0
  63. KERRE = 0
  64. IRT3 = 0
  65. IPCHE1 = 0
  66. IPINT = 0
  67. XRET =REAL(0.D0)
  68. MOT1 =' '
  69.  
  70. C- Lecture eventuelle du mot cle 'ELEM'
  71. CALL LIRMOT('ELEM',1,IELEM,0)
  72. IF (IERR.NE.0) RETURN
  73.  
  74. C- Lecture du modele (facultative pour permettre la syntaxe 2)
  75. CALL LIROBJ('MMODEL',IPMODL,0,IRET)
  76. IF (IERR.NE.0) RETURN
  77. C---- ABSENCE DU MODELE => ON VA TESTER LA SYNTAXE 2 (INTG evol1 ...)
  78. IF(IRET.EQ.0) GOTO 100
  79.  
  80. C- Lecture du MCHAML
  81. CALL LIROBJ('MCHAML',IPIN,1,IRET)
  82. IF (IERR.NE.0) RETURN
  83. CALL REDUAF(IPIN,IPMODL,IPCHB1,0,IR,KERRE)
  84. IF(IR.NE.1) CALL ERREUR(KERRE)
  85. IF (IERR.NE.0) RETURN
  86.  
  87. C- Lecture eventuelle du nom de la composante du MCHAML a considerer
  88. CALL LIRCHA(MACOMP,0,IRT3)
  89. IF (IERR.NE.0) RETURN
  90.  
  91. C- Lecture facultative du MCHAML de CARACTERISTIQUES
  92. CALL LIROBJ('MCHAML',IPIN,0,IRET)
  93. IPCHE2=IPIN
  94. IF((IRET .EQ.1) .AND. (IDARC .EQ. 0))THEN
  95. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KERRE)
  96. IF(IR.NE.1) CALL ERREUR(KERRE)
  97. IF (IERR.NE.0) RETURN
  98. ENDIF
  99. IF (IERR.NE.0) RETURN
  100.  
  101. C- Dans le cas ou le MCHAML a plus d'une composante
  102. C- on impose la donnee du nom de la composante a traiter.
  103. IF (IRT3.EQ.0) THEN
  104. MCHELM=IPCHB1
  105. SEGACT,MCHELM
  106. N1=ICHAML(/1)
  107. DO i=1,N1
  108. MCHAML=ICHAML(I)
  109. SEGACT,MCHAML
  110. N2=IELVAL(/1)
  111. SEGDES,MCHAML
  112. IF (N2.GT.1) THEN
  113. MOTERR(1:8)=' MCHAML '
  114. INTERR(1)=N2
  115. CALL ERREUR(761)
  116. SEGDES,MCHELM
  117. RETURN
  118. ENDIF
  119. ENDDO
  120. SEGDES,MCHELM
  121. ENDIF
  122.  
  123. C- Dans le cas ou le nom de la composante du MCHAML
  124. C- a considerer est precise, on l'extrait du MCHAML.
  125. IPCHE1=IPCHB1
  126. IF (IRT3.NE.0) THEN
  127. MOT1='SCAL'
  128. CALL EXCOC1(IPCHB1,MACOMP,IPCHE1,MOT1,0)
  129. IF (IERR.NE.0) RETURN
  130. ENDIF
  131.  
  132. C- Calcul de l'integrale
  133. CALL INTGCA(IPMODL,IPCHE1,IPCHE2,IELEM,IRET,XRET,IPINT)
  134. IF (IERR.NE.0) RETURN
  135.  
  136. C- Ecriture du resultat et menage
  137. IF (IPINT.EQ.0) THEN
  138. CALL ECRREE(XRET)
  139. ELSE
  140. CALL ECROBJ('MCHAML',IPINT)
  141. ENDIF
  142.  
  143. RETURN
  144.  
  145.  
  146. C---------------------------------------------------------------------
  147. C SYNTAXE 2
  148. C---------------------------------------------------------------------
  149. 100 CONTINUE
  150.  
  151. C--- INITIALISATIONS ---
  152. IABSO=0
  153. IA=0
  154. IB=0
  155. XA=REAL(0.D0)
  156. XB=REAL(0.D0)
  157. ILENTA=0
  158. ILENTB=0
  159. CHBOR(1:8)=' '
  160. IPINT=0
  161. XINT=REAL(0.D0)
  162.  
  163. C--- LECTURE DES OBJETS EN ENTREE ---
  164.  
  165. C- Lecture eventuelle du mot cle 'ABS'
  166. CALL LIRMOT('ABS',1,IABSO,0)
  167. IF (IERR.NE.0) RETURN
  168.  
  169. C- Lecture de l'evolution
  170. CALL LIROBJ('EVOLUTIO',IPEVO,0,IRET)
  171. IF (IERR.NE.0) RETURN
  172. c---- ABSENCE DE MODELE ET D'EVOLUTION => ERREUR
  173. IF(IRET.EQ.0) GOTO 998
  174.  
  175. C- Lecture eventuelle des bornes d'integration (de meme type)
  176. C - de type ENTIER pour les indices
  177. CALL LIRENT(IA,0,IRETA)
  178. IF(IRETA.NE.0) THEN
  179. CALL LIRENT(IB,1,IRETB)
  180. CHBOR(1:6)='ENTIER'
  181. GOTO 101
  182. ENDIF
  183. C - de type FLOTTANT pour les valeurs d'abscisses
  184. CALL LIRREE(XA,0,IRETA)
  185. IF(IRETA.NE.0) THEN
  186. CALL LIRREE(XB,1,IRETB)
  187. CHBOR(1:8)='FLOTTANT'
  188. GOTO 101
  189. ENDIF
  190. C - de type LISTENTI pour une liste d'indices
  191. CALL LIROBJ('LISTENTI',ILENTA,0,IRETA)
  192. IF(IRETA.NE.0) THEN
  193. CALL LIROBJ('LISTENTI',ILENTB,1,IRETB)
  194. CHBOR(1:8)='LISTENTI'
  195. GOTO 101
  196. ENDIF
  197. C - de type LISTENTI pour une liste d'indices
  198. CALL LIROBJ('LISTREEL',ILENTA,0,IRETA)
  199. IF(IRETA.NE.0) THEN
  200. CALL LIROBJ('LISTREEL',ILENTB,1,IRETB)
  201. CHBOR(1:8)='LISTREEL'
  202. GOTO 101
  203. ENDIF
  204.  
  205.  
  206. C--- CALCUL DE L'INTEGRALE ---
  207.  
  208. 101 CONTINUE
  209. CALL INTGEV(IPEVO,IABSO,CHBOR,IA,IB,XA,XB,ILENTA,ILENTB,
  210. & XINT,IPINT)
  211. IF (IERR.NE.0) RETURN
  212.  
  213. C--- ECRITURE DU RESULTAT ET MENAGE ---
  214.  
  215. IF (IPINT.EQ.0) THEN
  216. CALL ECRREE(XINT)
  217. ELSE
  218. CALL ECROBJ('LISTREEL',IPINT)
  219. ENDIF
  220. RETURN
  221.  
  222.  
  223. C---------------------------------------------------------------------
  224. C SYNTAXE 3 et ...
  225. C---------------------------------------------------------------------
  226. C ...
  227.  
  228.  
  229. C---------------------------------------------------------------------
  230. C ERREURS
  231. C---------------------------------------------------------------------
  232.  
  233. * /!\ ERREUR : AUCUN OBJET COMPATIBLE TROUVE
  234. 998 MOTERR(1:16)='MODELE EVOLUTIO'
  235. CALL ERREUR(471)
  236. RETURN
  237.  
  238. END
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  

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