Télécharger intgra.eso

Retour à la liste

Numérotation des lignes :

  1. C INTGRA SOURCE CB215821 16/12/05 21:39:51 9237
  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.  
  50.  
  51. C---------------------------------------------------------------------
  52. C SYNTAXE 1 (par defaut)
  53. C---------------------------------------------------------------------
  54. IELEM = 0
  55. IRET = 0
  56. IPIN = 0
  57. IPMODL = 0
  58. IPCHB1 = 0
  59. IPCHE2 = 0
  60. IR = 0
  61. KERRE = 0
  62. IRT3 = 0
  63. IPCHE1 = 0
  64. IPINT = 0
  65. XRET =REAL(0.D0)
  66. MOT1 =' '
  67.  
  68. C- Lecture eventuelle du mot cle 'ELEM'
  69. CALL LIRMOT('ELEM',1,IELEM,0)
  70. IF (IERR.NE.0) RETURN
  71.  
  72. C- Lecture du modele (facultative pour permettre la syntaxe 2)
  73. CALL LIROBJ('MMODEL',IPMODL,0,IRET)
  74. IF (IERR.NE.0) RETURN
  75. C---- ABSENCE DU MODELE => ON VA TESTER LA SYNTAXE 2 (INTG evol1 ...)
  76. IF(IRET.EQ.0) GOTO 100
  77.  
  78. C- Lecture du MCHAML
  79. CALL LIROBJ('MCHAML',IPIN,1,IRET)
  80. IF (IERR.NE.0) RETURN
  81. CALL REDUAF(IPIN,IPMODL,IPCHB1,0,IR,KERRE)
  82. IF(IR.NE.1) CALL ERREUR(KERRE)
  83. IF (IERR.NE.0) RETURN
  84.  
  85. C- Lecture eventuelle du nom de la composante du MCHAML a considerer
  86. CALL LIRCHA(MACOMP,0,IRT3)
  87. IF (IERR.NE.0) RETURN
  88.  
  89. C- Lecture facultative du MCHAML de CARACTERISTIQUES
  90. CALL LIROBJ('MCHAML',IPIN,0,IRET)
  91. IPCHE2=IPIN
  92. IF((IRET .EQ.1) .AND. (IDARC .EQ. 0))THEN
  93. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KERRE)
  94. IF(IR.NE.1) CALL ERREUR(KERRE)
  95. IF (IERR.NE.0) RETURN
  96. ENDIF
  97. IF (IERR.NE.0) RETURN
  98.  
  99. C- Dans le cas ou le MCHAML a plus d'une composante
  100. C- on impose la donnee du nom de la composante a traiter.
  101. IF (IRT3.EQ.0) THEN
  102. MCHELM=IPCHB1
  103. SEGACT,MCHELM
  104. N1=ICHAML(/1)
  105. DO i=1,N1
  106. MCHAML=ICHAML(I)
  107. SEGACT,MCHAML
  108. N2=IELVAL(/1)
  109. SEGDES,MCHAML
  110. IF (N2.GT.1) THEN
  111. MOTERR(1:8)=' MCHAML '
  112. INTERR(1)=N2
  113. CALL ERREUR(761)
  114. SEGDES,MCHELM
  115. RETURN
  116. ENDIF
  117. ENDDO
  118. SEGDES,MCHELM
  119. ENDIF
  120.  
  121. C- Dans le cas ou le nom de la composante du MCHAML
  122. C- a considerer est precise, on l'extrait du MCHAML.
  123. IPCHE1=IPCHB1
  124. IF (IRT3.NE.0) THEN
  125. MOT1='SCAL'
  126. CALL EXCOC1(IPCHB1,MACOMP,IPCHE1,MOT1,0)
  127. IF (IERR.NE.0) RETURN
  128. ENDIF
  129.  
  130. C- Calcul de l'integrale
  131. CALL INTGCA(IPMODL,IPCHE1,IPCHE2,IELEM,IRET,XRET,IPINT)
  132. IF (IERR.NE.0) RETURN
  133.  
  134. C- Ecriture du resultat et menage
  135. IF (IPINT.EQ.0) THEN
  136. CALL ECRREE(XRET)
  137. ELSE
  138. CALL ECROBJ('MCHAML',IPINT)
  139. ENDIF
  140. IF (IRT3.NE.0) CALL DTCHAM(IPCHE1)
  141.  
  142. RETURN
  143.  
  144.  
  145. C---------------------------------------------------------------------
  146. C SYNTAXE 2
  147. C---------------------------------------------------------------------
  148. 100 CONTINUE
  149.  
  150. C--- INITIALISATIONS ---
  151. IABSO=0
  152. IA=0
  153. IB=0
  154. XA=REAL(0.D0)
  155. XB=REAL(0.D0)
  156. ILENTA=0
  157. ILENTB=0
  158. CHBOR(1:8)=' '
  159. IPINT=0
  160. XINT=REAL(0.D0)
  161.  
  162. C--- LECTURE DES OBJETS EN ENTREE ---
  163.  
  164. C- Lecture eventuelle du mot cle 'ABS'
  165. CALL LIRMOT('ABS',1,IABSO,0)
  166. IF (IERR.NE.0) RETURN
  167.  
  168. C- Lecture de l'evolution
  169. CALL LIROBJ('EVOLUTIO',IPEVO,0,IRET)
  170. IF (IERR.NE.0) RETURN
  171. c---- ABSENCE DE MODELE ET D'EVOLUTION => ERREUR
  172. IF(IRET.EQ.0) GOTO 998
  173.  
  174. C- Lecture eventuelle des bornes d'integration (de meme type)
  175. C - de type ENTIER pour les indices
  176. CALL LIRENT(IA,0,IRETA)
  177. IF(IRETA.NE.0) THEN
  178. CALL LIRENT(IB,1,IRETB)
  179. CHBOR(1:6)='ENTIER'
  180. GOTO 101
  181. ENDIF
  182. C - de type FLOTTANT pour les valeurs d'abscisses
  183. CALL LIRREE(XA,0,IRETA)
  184. IF(IRETA.NE.0) THEN
  185. CALL LIRREE(XB,1,IRETB)
  186. CHBOR(1:8)='FLOTTANT'
  187. GOTO 101
  188. ENDIF
  189. C - de type LISTENTI pour une liste d'indices
  190. CALL LIROBJ('LISTENTI',ILENTA,0,IRETA)
  191. IF(IRETA.NE.0) THEN
  192. CALL LIROBJ('LISTENTI',ILENTB,1,IRETB)
  193. CHBOR(1:8)='LISTENTI'
  194. GOTO 101
  195. ENDIF
  196. C - de type LISTENTI pour une liste d'indices
  197. CALL LIROBJ('LISTREEL',ILENTA,0,IRETA)
  198. IF(IRETA.NE.0) THEN
  199. CALL LIROBJ('LISTREEL',ILENTB,1,IRETB)
  200. CHBOR(1:8)='LISTREEL'
  201. GOTO 101
  202. ENDIF
  203.  
  204.  
  205. C--- CALCUL DE L'INTEGRALE ---
  206.  
  207. 101 CONTINUE
  208. CALL INTGEV(IPEVO,IABSO,CHBOR,IA,IB,XA,XB,ILENTA,ILENTB,
  209. & XINT,IPINT)
  210. IF (IERR.NE.0) RETURN
  211.  
  212. C--- ECRITURE DU RESULTAT ET MENAGE ---
  213.  
  214. IF (IPINT.EQ.0) THEN
  215. CALL ECRREE(XINT)
  216. ELSE
  217. CALL ECROBJ('LISTREEL',IPINT)
  218. ENDIF
  219. RETURN
  220.  
  221.  
  222. C---------------------------------------------------------------------
  223. C SYNTAXE 3 et ...
  224. C---------------------------------------------------------------------
  225. C ...
  226.  
  227.  
  228. C---------------------------------------------------------------------
  229. C ERREURS
  230. C---------------------------------------------------------------------
  231.  
  232. * /!\ ERREUR : AUCUN OBJET COMPATIBLE TROUVE
  233. 998 MOTERR(1:16)='MODELE EVOLUTIO'
  234. CALL ERREUR(471)
  235. RETURN
  236.  
  237. END
  238.  
  239.  
  240.  
  241.  

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