Télécharger evchpo.eso

Retour à la liste

Numérotation des lignes :

  1. C EVCHPO SOURCE FANDEUR 15/09/23 21:15:01 8629
  2. SUBROUTINE EVCHPO(ICOUL)
  3. C======================================================================
  4. C OPTION CHPO DE L'OPERATEUR EVOL C
  5. C C
  6. C LA SYNTHAXE DE CETTE OPTION D'EVOL EST LA SUIVANTE : C
  7. C C
  8. C C
  9. C EV1 = EVOL (COUL) CHPO CHPT COMP LIGN; C
  10. C C
  11. C C
  12. C + COUL : COULEUR DE LA COURBE (FACULTATIVE) C
  13. C C
  14. C + CHPT : CHAMP-POINT C
  15. C C
  16. C + COMP : COMPOSANTE DU CHAMP POINT C
  17. C C
  18. C + LIGN : LIGNE DE NOEUDS. C
  19. C C
  20. C C
  21. C======================================================================
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8 (A-H,O-Z)
  24. -INC CCOPTIO
  25. -INC SMEVOLL
  26. -INC SMCHPOI
  27. -INC SMLREEL
  28. -INC SMELEME
  29. -INC SMCOORD
  30. -INC SMLMOTS
  31. -INC TMTRAV
  32. SEGMENT MVOL
  33. REAL*8 MMABS(JG)
  34. REAL*8 MMORD(JG)
  35. CHARACTER*8 NOMAB(JG)
  36. REAL*8 POSNO(JG)
  37. ENDSEGMENT
  38. SEGMENT TTRAV
  39. INTEGER ILIS(IDIMM)
  40. ENDSEGMENT
  41. CHARACTER*8 NOMQUA,NOM
  42. CHARACTER*4 CMOT
  43. CHARACTER*8 NCHPT,NMAIL
  44. CHARACTER*23 UMOT1
  45. CHARACTER*16 UMOT2
  46. CHARACTER*12 UMOT3
  47. CHARACTER*72 TITRE
  48. REAL*8 DEPA(400),PREC(3),TREPA(400),MYPOS(3),HEPOS(3)
  49. LOGICAL FIRST,SECOND,THIRD,NOMME
  50. DIMENSION ITABCH(3)
  51. CMOT=' '
  52. C LECTURE DES DIFFERENTES ENTREES
  53. C LECTURE DU CHAMP-POINT
  54. CALL LIROBJ ('CHPOINT',IBOPOI,1,IRETOC)
  55. IF (IRETOC.EQ.0) GOTO 111
  56. MCHPOI=IBOPOI
  57. C LECTURE DE LA COMPOSANTE
  58. CALL LIRCHA(CMOT,0,IRETOU)
  59. C LECTURE DE L'OBJET MAILLAGE
  60. CALL LIROBJ('MAILLAGE',IPOI,1,IRETOM)
  61. IF (IRETOM.EQ.0) GOTO 111
  62. MELEME = IPOI
  63. CALL LIGMAI(MELEME,TTRAV,1)
  64. IF(IERR.NE.0) RETURN
  65. SEGACT TTRAV
  66. NBNN=ILIS(/1)
  67. JG=NBNN
  68. SEGINI MVOL
  69. C APPEL A UNE ROUTINE DE PRESENTATION D'UN CHPOINT SOUS FORME RESUME
  70. CALL TRACHP(MCHPOI,MTRAV)
  71. SEGACT MTRAV
  72. SEGACT MCOORD
  73. ICC=0
  74. NCO=INCO(/2)
  75. *
  76. IF(IRETOU.EQ.0.AND.NCO.GT.1) THEN
  77. MOTERR(1:8)='MOT '
  78. CALL ERREUR(37)
  79. GO TO 111
  80. ENDIF
  81. *
  82. * SI LE CHAMP A UNE SEULE COMPOSANTE ET QU'ON N'A PAS LU
  83. * DE NOM DE COMPOSANTE , ON LA PREND
  84. *
  85. IF(NCO.EQ.1.AND.IRETOU.EQ.0) THEN
  86. CMOT=INCO(1)
  87. ICC=1
  88. ELSE
  89. DO 1 INC=1,NCO
  90. IF (INCO(INC).EQ.CMOT) THEN
  91. ICC=INC
  92. ENDIF
  93. 1 CONTINUE
  94. ENDIF
  95. * Pas besoin d'erreur, il suffit de mettre 0
  96. * IF (ICC.EQ.0) THEN
  97. * MOTERR(1:4)=CMOT
  98. * CALL ERREUR(181)
  99. * GOTO 111
  100. * ENDIF
  101. C BOUCLE SUR TOUS LES NOEUDS DU MAILLAGE
  102. IBAC=0
  103. IBOC=0
  104. ZMABS=0.D0
  105. DO 2 IY=1,3
  106. PREC(IY)=0.D0
  107. 2 CONTINUE
  108. DO 7 IBO=1,ILIS(/1)
  109. NN= ILIS(IBO)
  110. NCOO=0
  111. DO 3 J=1,IDIM
  112. NCOO=NCOO+1
  113. MYPOS(NCOO)=XCOOR((NN-1)*(IDIM+1)+NCOO)
  114. 3 CONTINUE
  115. TOTAL = 0.D0
  116. DO 4 IT=1,IDIM
  117. TOTAL = TOTAL + (MYPOS(IT)-PREC(IT))**2
  118. PREC(IT)=MYPOS(IT)
  119. 4 CONTINUE
  120. TOTAL = TOTAL**0.5D0
  121. ZMABS = ZMABS + TOTAL
  122. IF (IBAC.EQ.0) THEN
  123. ZMABS=0.D0
  124. ENDIF
  125. NOMME=.FALSE.
  126. CALL SKNAME(NN,NOMQUA,IRETOL,1)
  127. IF (IRETOL.EQ.1) THEN
  128. NOMME=.TRUE.
  129. NOM = NOMQUA
  130. ENDIF
  131. IF (ICC.EQ.0) THEN
  132. INDI0=1
  133. ELSE
  134. INDI0=1
  135. DO 6 KJ=1,IGEO(/1)
  136. NH=IGEO(KJ)
  137. IF(NH.EQ.NN) THEN
  138. IF (IBIN(ICC,KJ).EQ.0) THEN
  139. INDI0 = 1
  140. GOTO 6
  141. ENDIF
  142. IBAC=IBAC+1
  143. MMORD(IBAC)=BB(ICC,KJ)
  144. MMABS(IBAC)=ZMABS
  145. INDI0=0
  146. IF (NOMME) THEN
  147. IBOC=IBOC+1
  148. POSNO (IBOC)=ZMABS
  149. NOMAB (IBOC)=NOM
  150. ENDIF
  151. GOTO 7
  152. ENDIF
  153. 6 CONTINUE
  154. ENDIF
  155. IF (INDI0.EQ.1) THEN
  156. IBAC=IBAC+1
  157. MMORD(IBAC)=0.D0
  158. MMABS(IBAC)=ZMABS
  159. IF (NOMME) THEN
  160. IBOC=IBOC+1
  161. POSNO (IBOC)=ZMABS
  162. NOMAB (IBOC)=NOM
  163. ENDIF
  164. ENDIF
  165. 7 CONTINUE
  166. JG=IBAC
  167. SEGINI MLREEL,MLREE1
  168. DO 8 IT=1,IBAC
  169. PROG(IT)=MMABS(IT)
  170. MLREE1.PROG(IT)=MMORD(IT)
  171. 8 CONTINUE
  172. N=1
  173. M=IBOC
  174. IF(M.NE.0) N = 2
  175. SEGINI MEVOLL
  176. C
  177. C CREATION DU EVOL CONTENANT LES NOMS
  178. C
  179. IF(M.NE.0) THEN
  180. SEGINI KEVOLL
  181. *MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM IIIIIII
  182. * DANS NOMAB ON A LES POINTS QUALIFIES IIIIIII
  183. * IBOC LE NOMBRE DE POINTS QUALIFIES IIII
  184. * DANS POSNO LA POSITION DES POINTS QUALIFIES IIII
  185. * MLREEL : ABSCISSE DES POINTS IIII
  186. * MLREE1 : ORDONNEE DES POINTS IIIIII
  187. JGN=8
  188. JGM=IBOC
  189. SEGINI MLMOTS
  190. JG=IBOC
  191. SEGINI MLREE2
  192. IPROGX=MLREE2
  193. IPROGY=MLMOTS
  194. TYPX='LISTREEL'
  195. TYPY='LISTMOTS'
  196. IEVOLL(2)=KEVOLL
  197. NUMEVY='MARQ'
  198. NUMEVX=ICOUL
  199. NOMEVX='ABS'
  200. NOMEVY=CMOT
  201. DO 9 I=1,IBOC
  202. MOTS(I)=NOMAB(I)
  203. MLREE2.PROG(I)=POSNO(I)
  204. 9 CONTINUE
  205. KEVTEX='POINTS NOMMES APPARTENANT A LA LIGNE'
  206. SEGDES MLREE2,MLMOTS,KEVOLL
  207. ENDIF
  208. SEGINI KEVOLL
  209. IEVOLL(1)= KEVOLL
  210. ITYEVO='REEL'
  211. TYPX='LISTREEL'
  212. TYPY='LISTREEL'
  213. IPROGX= MLREEL
  214. IPROGY= MLREE1
  215. IEVTEX=TITREE
  216. NOMEVX= 'ABS'
  217. NOMEVY= CMOT
  218. NUMEVX= ICOUL
  219. NUMEVY= 'REEL'
  220. CALL SKNAME(IBOPOI,NCHPT,IRETO,0)
  221. IF (IRETO.NE.0) THEN
  222. CALL SKNAME(IPOI,NMAIL,IRETO,0)
  223. IF (IRETO.NE.0) THEN
  224. UMOT1= 'TRACE DE LA COMPOSANTE '
  225. UMOT2= ' DU CHAMP-POINT '
  226. UMOT3= ' LE LONG DE '
  227. TITRE=UMOT1//CMOT//UMOT2//NCHPT//UMOT3//NMAIL
  228. KEVTEX=TITRE
  229. ENDIF
  230. ENDIF
  231. SEGDES MEVOLL,KEVOLL
  232. SEGDES MLREEL,MLREE1
  233. CALL ECROBJ('EVOLUTIO',MEVOLL)
  234. SEGSUP MTRAV,TTRAV
  235. SEGSUP MVOL
  236. 111 RETURN
  237. END
  238.  
  239.  
  240.  

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