Télécharger extr20.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR20 SOURCE BP208322 16/11/18 21:16:53 9177
  2.  
  3. SUBROUTINE EXTR20 (IPCHAR,CMOT,ICHGT,LCHGT,IEC,
  4. & IPRES1,CTYP1,IPRES2,CTYP2)
  5.  
  6. C=======================================================================
  7. C
  8. C RESULTAT = EXTRAIRE CHARGEME ... ;
  9. C
  10. C 1) CHARGEME 'CHAR' (ENTIER) CHARGEME
  11. C 2) CHARGEME 'CHAM' (ENTIER) CHPOINT ou MCHAML
  12. C 3) CHARGEME 'TRAJ' (ENTIER) CHPOINT
  13. C 4) CHARGEME 'EVOL' (ENTIER) EVOLUTION
  14. C 5) CHARGEME 'VITE' (ENTIER) EVOLUTION
  15. C 6) CHARGEME 'COMP' LISTMOTS
  16. C 7) CHARGEME 'LIE ' CHARGEME
  17. C 8) CHARGEME 'LIBR' CHARGEME
  18. C 9) CHARGEME MOT 'TABLES' TABLES
  19. C 10) CHARGEME MOT CHARGEME
  20. C 11) CHARGEME LISTMOTS CHARGEME
  21. C
  22. C=======================================================================
  23.  
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC CCOPTIO
  28. -INC CCGEOME
  29.  
  30. -INC SMCHARG
  31. -INC SMEVOLL
  32. -INC SMLMOTS
  33.  
  34. CHARACTER*(4) CMOT
  35. CHARACTER*(8) CTYP1,CTYP2
  36.  
  37. CHARACTER*4 MCOMP
  38.  
  39. IPRES1 = 0
  40. CTYP1 = ' '
  41. IPRES2 = 0
  42. CTYP2 = ' '
  43.  
  44. MCHARG = IPCHAR
  45. SEGACT,MCHARG
  46. NCHAR = KCHARG(/1)
  47. C
  48. IF (NCHAR.LT.IEC) THEN
  49. INTERR(1) = IEC
  50. CALL ERREUR(690)
  51. GOTO 9999
  52. ENDIF
  53. C
  54. ICHG2 = ICHGT + 2
  55. GOTO ( 1010, 1000, 10, 20, 30, 40, 50, 60, 70, 70), ICHG2
  56. GOTO 9999
  57. C
  58. C MOT-CLE 'CHAR' ==> ICHGT = 1
  59. C----------------
  60. 10 CONTINUE
  61. N = 1
  62. SEGINI,MCHAR1
  63. MCHAR1.KCHARG(1) = KCHARG(IEC)
  64. MCHAR1.CHANOM(1) = CHANOM(IEC)
  65. MCHAR1.CHANAT(1) = CHANAT(IEC)
  66. MCHAR1.CHAMOB(1) = CHAMOB(IEC)
  67. MCHAR1.CHALIE(1) = CHALIE(IEC)
  68. SEGDES,MCHAR1
  69. IPRES1 = MCHAR1
  70. CTYP1 = 'CHARGEME'
  71. GOTO 9999
  72. C
  73. C MOT-CLE 'CHAM' ==> ICHGT = 2
  74. C----------------
  75. 20 CONTINUE
  76. ICHARG = KCHARG(IEC)
  77. SEGACT,ICHARG
  78. IF (CHATYP.EQ.'CHPOINT ' .OR. CHATYP.EQ.'MCHAML ') THEN
  79. IPRES1 = ICHPO1
  80. CTYP1 = CHATYP
  81. ELSE
  82. INTERR(1) = IEC
  83. CALL ERREUR(688)
  84. ENDIF
  85. SEGDES,ICHARG
  86. GOTO 9999
  87. C
  88. C MOT-CLE 'TRAJ' ==> ICHGT = 3
  89. C---------------
  90. 30 CONTINUE
  91. IF (CHAMOB(IEC).EQ.'TRAJ') THEN
  92. ICHARG = KCHARG(IEC)
  93. SEGACT,ICHARG
  94. IPRES1 = ICHPO4
  95. CTYP1 = 'CHPOINT'
  96. SEGDES,ICHARG
  97. ELSE
  98. INTERR(1) = IEC
  99. CALL ERREUR(900)
  100. ENDIF
  101. GOTO 9999
  102. C
  103. C MOT-CLE 'EVOL' ==> ICHGT = 4
  104. C---------------
  105. 40 CONTINUE
  106. ICHARG = KCHARG(IEC)
  107. SEGACT,ICHARG
  108. IF (CHATYP.EQ.'CHPOINT ' .OR. CHATYP.EQ.'MCHAML ') THEN
  109. SEGINI,KEVOLL
  110. NUMEVX = IDCOUL
  111. NUMEVY = 'REEL'
  112. TYPX = 'LISTREEL'
  113. TYPY = 'LISTREEL'
  114. NOMEVX = 'TEMPS'
  115. NOMEVY = CHANOM(IEC)
  116. IPROGX = ICHPO2
  117. IPROGY = ICHPO3
  118. KEVTEX = 'Evolution temporelle de '//CHANOM(IEC)
  119. SEGDES,KEVOLL
  120. N = 1
  121. SEGINI,MEVOLL
  122. ITYEVO = 'REEL'
  123. IEVTEX = 'Evolution extraite d''un CHARGEMENT'
  124. IEVOLL(1) = KEVOLL
  125. SEGDES,MEVOLL
  126. IPRES1 = MEVOLL
  127. CTYP1 = 'EVOLUTIO'
  128. ELSE
  129. INTERR(1) = IEC
  130. CALL ERREUR(689)
  131. ENDIF
  132. SEGDES,ICHARG
  133. GOTO 9999
  134. C
  135. C MOT-CLE 'VITE' ==> ICHGT = 5
  136. C---------------
  137. 50 CONTINUE
  138. IF (CHAMOB(IEC).EQ.'TRAN' .OR. CHAMOB(IEC).EQ.'ROTA') THEN
  139. ICHARG = KCHARG(IEC)
  140. SEGACT,ICHARG
  141. SEGINI,KEVOLL
  142. NUMEVX = IDCOUL
  143. NUMEVY = 'REEL'
  144. TYPX = 'LISTREEL'
  145. TYPY = 'LISTREEL'
  146. IPROGX = ICHPO6
  147. IPROGY = ICHPO7
  148. NOMEVX = 'TEMPS'
  149. NOMEVY = CHANOM(IEC)
  150. KEVTEX='Evolution temporelle de '//CHANOM(IEC)
  151. SEGDES,KEVOLL
  152. SEGDES,ICHARG
  153. N = 1
  154. SEGINI,MEVOLL
  155. ITYEVO = 'REEL'
  156. IEVTEX = 'Evolution extraite d''un CHARGEMENT'
  157. IEVOLL(1) = KEVOLL
  158. SEGDES,MEVOLL
  159. IPRES1 = MEVOLL
  160. CTYP1 = 'EVOLUTIO'
  161. ELSE
  162. INTERR(1) = IEC
  163. CALL ERREUR(901)
  164. ENDIF
  165. GOTO 9999
  166.  
  167. C MOT-CLE 'COMP' ==> ICHGT = 6
  168. C----------------
  169. 60 CONTINUE
  170. JGN = 4
  171. JGM = NCHAR
  172. SEGINI,MLMOTS
  173. MOTS(1) = CHANOM(1)
  174. NMO1 = 1
  175. DO icha = 2, NCHAR
  176. DO kcha = 1, NMO1
  177. IF (CHANOM(icha).EQ.MOTS(kcha)) GOTO 61
  178. ENDDO
  179. NMO1 = NMO1 + 1
  180. MOTS(NMO1) = CHANOM(icha)
  181. 61 CONTINUE
  182. ENDDO
  183. IF (JGM.NE.NMO1) THEN
  184. JGM = NMO1
  185. SEGADJ,MLMOTS
  186. ENDIF
  187. SEGDES,MLMOTS
  188. IPRES1 = MLMOTS
  189. CTYP1 = 'LISTMOTS'
  190. GOTO 9999
  191. C
  192. C MOT-CLE 'LIE ' OU 'LIBR' ==> ICHGT = 7 ou 8
  193. C--------------------------
  194. 70 CONTINUE
  195. N = NCHAR
  196. SEGINI,MCHAR1
  197. kcha = 0
  198. DO icha = 1, NCHAR
  199. IF (CHALIE(icha).EQ.CMOT) then
  200. kcha = kcha + 1
  201. MCHAR1.KCHARG(kcha) = KCHARG(icha)
  202. MCHAR1.CHANAT(kcha) = CHANAT(icha)
  203. MCHAR1.CHANOM(kcha) = CHANOM(icha)
  204. MCHAR1.CHAMOB(kcha) = CHAMOB(icha)
  205. MCHAR1.CHALIE(kcha) = CHALIE(icha)
  206. ENDIF
  207. ENDDO
  208. IF (kcha.LE.0) THEN
  209. SEGSUP,MCHAR1
  210. MOTERR(1:4) = CMOT
  211. CALL ERREUR(899)
  212. ELSE
  213. IF (kcha.NE.N) THEN
  214. N = kcha
  215. SEGADJ,MCHAR1
  216. ENDIF
  217. SEGDES,MCHAR1
  218. IPRES1 = MCHAR1
  219. CTYP1 = 'CHARGEME'
  220. ENDIF
  221. GOTO 9999
  222.  
  223. C COMPOSANTE MOT ou LISTMOTS ==> ICHGT = 0
  224. C----------------------------
  225. 1000 CONTINUE
  226. N = NCHAR
  227. SEGINI,MCHAR1
  228. NCOMP = 1
  229. MCOMP = CMOT
  230. MLMOTS = LCHGT
  231. IF (LCHGT.GT.0) THEN
  232. SEGACT,MLMOTS
  233. NCOMP = MLMOTS.MOTS(/2)
  234. ENDIF
  235.  
  236. kcha = 0
  237. DO icomp = 1, NCOMP
  238. IF (LCHGT.GT.0) MCOMP = MLMOTS.MOTS(icomp)
  239. kcha1 = 0
  240. DO icha = 1, NCHAR
  241. IF (CHANOM(icha).EQ.MCOMP) THEN
  242. kcha = kcha + 1
  243. MCHAR1.KCHARG(kcha) = KCHARG(icha)
  244. MCHAR1.CHANAT(kcha) = CHANAT(icha)
  245. MCHAR1.CHANOM(kcha) = CHANOM(icha)
  246. MCHAR1.CHAMOB(kcha) = CHAMOB(icha)
  247. MCHAR1.CHALIE(kcha) = CHALIE(icha)
  248. kcha1 = 1
  249. ENDIF
  250. ENDDO
  251. IF (kcha1.EQ.0) THEN
  252. MOTERR(1:4) = MCOMP
  253. CALL ERREUR(685)
  254. ENDIF
  255. ENDDO
  256. IF (LCHGT.GT.0) SEGDES,MLMOTS
  257.  
  258. IF (IERR.EQ.0) THEN
  259. IF (kcha.NE.N) THEN
  260. N = kcha
  261. SEGADJ,MCHAR1
  262. ENDIF
  263. SEGDES,MCHAR1
  264. IPRES1 = MCHAR1
  265. CTYP1 = 'CHARGEME'
  266. ELSE
  267. SEGSUP,MCHAR1
  268. ENDIF
  269. GOTO 9999
  270.  
  271. C TABLES DE CHARGEMENT DE LA COMPOSANTE CMOT ==> ICHGT = -1
  272. C--------------------------------------------
  273. 1010 CONTINUE
  274. kcha = 0
  275. DO icha = 1, NCHAR
  276. IF (CHANOM(icha).EQ.CMOT) THEN
  277. kcha = kcha + 1
  278. ICHARG = KCHARG(icha)
  279. ENDIF
  280. ENDDO
  281. IF (kcha.NE.1) THEN
  282. IF (kcha.EQ.0) THEN
  283. MOTERR(1:4) = CMOT
  284. CALL ERREUR(685)
  285. ELSE
  286. CALL ERREUR(697)
  287. CALL ERREUR(512)
  288. ENDIF
  289. ELSE
  290. SEGACT,ICHARG
  291. IPRES1 = ICHPO2
  292. CTYP1 = 'TABLE '
  293. IPRES2 = ICHPO1
  294. CTYP2 = 'TABLE '
  295. SEGDES,ICHARG
  296. * Mettre une verification sur le type de ichpo1 et ichpo2 : TABLE ?
  297. ENDIF
  298. GOTO 9999
  299.  
  300. 9999 CONTINUE
  301. SEGDES,MCHARG
  302.  
  303. RETURN
  304. END
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  

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