Télécharger excha1.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCHA1 SOURCE PASCAL 20/03/02 21:15:10 10541
  2. SUBROUTINE EXCHA1(ICHAM,ILISR,CMOT)
  3.  
  4. ************************************************************************
  5. *
  6. * EXTRACTION DES VARIABLES DONT DEPENDENT LES PARAMETRES DU
  7. * MATERIAU.
  8. *
  9. * ICHAM (E) INTEGER POINTEUR SUR LE MCHAML
  10. * ILISR (S) INTEGER POINTEUR SUR UN OBJET DE TYPE SMLMOTS
  11. * CONTENANT LES NOMS DES VARIABLES
  12. * CMOT (E)
  13. *
  14. ************************************************************************
  15.  
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8(A-H,O-Z)
  18.  
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC CCNOYAU
  23. -INC CCASSIS
  24.  
  25. -INC SMCHAML
  26. -INC SMLMOTS
  27. -INC SMNUAGE
  28. -INC SMEVOLL
  29. -INC SMTABLE
  30. c cccccc
  31. PARAMETER ( NNOMCH=26 )
  32. c cccccc
  33. CHARACTER*(*) CMOT
  34. CHARACTER*8 NOMCHT,NOMVXT,NOMVYT,LNOMCH(NNOMCH)
  35. CHARACTER*4 MOTSIM
  36. DATA MOTSIM / 'SIMU' /
  37. DATA LNOMCH / 'TRAC ','EVOL ','COMP ','FLXY ',
  38. & 'FLXZ ','CISY ','CISZ ','JDA ',
  39. & 'EM0 ','EM1 ','EM2 ','EM3 ',
  40. & 'EM4 ','EM5 ','EM6 ','EM7 ',
  41. & 'EM8 ','MONP ','MONN ','MONO ',
  42. & 'COEV ','TREV ','TRAS ','TRAT ',
  43. $ 'PULO ','ECRO'/
  44. ICAS = 1
  45. IF (CMOT.EQ.'COVA') ICAS = 2
  46.  
  47. *------------- activation de la liste de MOTS ------------------------
  48.  
  49. JGM = 20
  50. JGN = 8
  51. SEGINI MLMOT1
  52. ITE1 = 0
  53.  
  54. MCHELM = ICHAM
  55. CALL ACTOBJ('MCHAML ',MCHELM,1)
  56. C SEGACT MCHELM
  57. NSOUS = ICHAML(/1)
  58.  
  59. *------------------ boucle sur les sous chamelem ---------------------
  60.  
  61. DO 1 I1=1,NSOUS
  62. MCHAML = ICHAML(I1)
  63. C SEGACT MCHAML
  64. NCOMP = NOMCHE(/2)
  65.  
  66. *-------------------- boucle sur les composantes ---------------------
  67.  
  68. DO 2 I2=1,NCOMP
  69. IF (TYPCHE(I2).EQ.'REAL*8 ') THEN
  70. GOTO 2
  71. ELSE IF (TYPCHE(I2).EQ.'POINTEURPOINT ') THEN
  72. GOTO 2
  73. ELSE IF (TYPCHE(I2).EQ.'POINTEURMAILLAGE') THEN
  74. GOTO 2
  75. ELSE IF (TYPCHE(I2).EQ.'POINTEURMCHAML ') THEN
  76. GOTO 2
  77. ELSE IF (TYPCHE(I2).EQ.'POINTEURCHPOINT ') THEN
  78. GOTO 2
  79. ELSE IF (TYPCHE(I2).EQ.'POINTEURMMODEL ') THEN
  80. GOTO 2
  81. ELSE IF (TYPCHE(I2).EQ.'POINTEURLISTREEL') THEN
  82. GOTO 2
  83.  
  84. ELSE IF (TYPCHE(I2).EQ.'POINTEURNUAGE ') THEN
  85. NOMCHT = NOMCHE(I2)
  86. IF (ICAS.EQ.1) THEN
  87. CALL PLACE(LNOMCH,NNOMCH,iplac,NOMCHT)
  88. MELVAL = IELVAL(I2)
  89. C SEGACT MELVAL
  90. NOE = IELCHE(/1)
  91. NEL = IELCHE(/2)
  92. DO 3 I3=1,NEL
  93. DO 4 I4=1,NOE
  94. MNUAGE = IELCHE(I4,I3)
  95. IF (MNUAGE.EQ.0) THEN
  96. MOTERR(1:8) = 'MCHAML'
  97. INTERR = MCHAML
  98. CALL ERREUR(356)
  99. RETURN
  100. ENDIF
  101. SEGACT MNUAGE
  102. NVAR = NUANOM(/2)
  103. IPOSI = 0
  104. DO 5 I5 = 1,NVAR
  105. IF (NUANOM(I5).EQ.NOMCHT) IPOSI = I5
  106. 5 CONTINUE
  107. IF (IPOSI.NE.0) THEN
  108. DO 6 I6 = 1,NVAR
  109. IF (I6.EQ.IPOSI) THEN
  110. IF (iplac.EQ.0) THEN
  111. IF (NUATYP(I6).EQ.'EVOLUTIO') THEN
  112. NUAVIN=NUAPOI(I6)
  113. SEGACT NUAVIN
  114. MEVOL1=NUAINT(1)
  115. C SEGDES NUAVIN
  116. SEGACT MEVOL1
  117. N1=MEVOL1.IEVOLL(/1)
  118. C
  119. C ON TESTE L'OBJET EVOLUTION
  120. C
  121. IF(N1.NE.1) THEN
  122. MOTERR(1:8)='EVOLUTIO'
  123. INTERR(1)=MEVOL1
  124. CALL ERREUR(110)
  125. C SEGDES MEVOL1
  126. C SEGDES MNUAGE
  127. C SEGDES MELVAL
  128. C SEGDES MCHAML
  129. GOTO 9000
  130. ENDIF
  131. IF(MEVOL1.ITYEVO.NE.'REEL') THEN
  132. MOTERR(1:8)='EVOLUTIO'
  133. MOTERR(9:16)='REEL '
  134. CALL ERREUR(79)
  135. C SEGDES MEVOL1
  136. C SEGDES MNUAGE
  137. C SEGDES MELVAL
  138. C SEGDES MCHAML
  139. GOTO 9000
  140. ENDIF
  141. KEVOL1=MEVOL1.IEVOLL(1)
  142. C SEGDES MEVOL1
  143. SEGACT KEVOL1
  144. IF(KEVOL1.TYPX.NE.'LISTREEL'.OR.
  145. & KEVOL1.TYPY.NE.'LISTREEL')THEN
  146. MOTERR(1:8)='EVOLUTIO'
  147. MOTERR(9:16)='LISTREEL'
  148. INTERR(1)=MEVOL1
  149. CALL ERREUR(630)
  150. C SEGDES KEVOL1
  151. C SEGDES MNUAGE
  152. C SEGDES MELVAL
  153. C SEGDES MCHAML
  154. GOTO 9000
  155. ENDIF
  156. NOMVXT=KEVOL1.NOMEVX(1:8)
  157. C SEGDES KEVOL1
  158. DO 7 IU=1,ITE1
  159. IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 8
  160. 7 CONTINUE
  161. ITE1 = ITE1 + 1
  162. IF (ITE1.GT.JGM) THEN
  163. JGM = JGM + 20
  164. SEGADJ MLMOT1
  165. ENDIF
  166. MLMOT1.MOTS(ITE1) = NOMVXT
  167. 8 CONTINUE
  168. ENDIF
  169. ENDIF
  170. ELSE
  171. NOMVXT = NUANOM(I6)
  172. DO 9 IU=1,ITE1
  173. IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 10
  174. 9 CONTINUE
  175. ITE1 = ITE1 + 1
  176. IF (ITE1.GT.JGM) THEN
  177. JGM = JGM + 20
  178. SEGADJ MLMOT1
  179. ENDIF
  180. MLMOT1.MOTS(ITE1) = NOMVXT
  181. 10 CONTINUE
  182. ENDIF
  183. 6 CONTINUE
  184. ELSE IF (nvar.gt.2) THEN
  185. goto 1
  186. ELSE
  187. *--------- un parametre du mchaml ne correspond a aucun -----------
  188. *------------------- nom de composante du NUAGE ---------------------
  189. MOTERR(1:8) = NOMCHT
  190. CALL ERREUR(677)
  191. C SEGDES MNUAGE
  192. C SEGDES MELVAL
  193. C SEGDES MCHAML
  194. GOTO 9000
  195. ENDIF
  196. C SEGDES MNUAGE
  197. 4 CONTINUE
  198. 3 CONTINUE
  199. C SEGDES MELVAL
  200. ELSE IF (ICAS.EQ.2) THEN
  201. DO 11 IU=1,ITE1
  202. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 12
  203. 11 CONTINUE
  204. ITE1 = ITE1+1
  205. IF (ITE1.GT.JGM) THEN
  206. JGM= JGM+20
  207. SEGADJ MLMOT1
  208. ENDIF
  209. MLMOT1.MOTS(ITE1) = NOMCHT
  210. 12 CONTINUE
  211. ENDIF
  212.  
  213. ELSE IF (TYPCHE(I2).EQ.'POINTEUREVOLUTIO') THEN
  214. NOMCHT = NOMCHE(I2)
  215. CALL PLACE(LNOMCH,NNOMCH,iplac,NOMCHT)
  216. IF (iplac.NE.0) GOTO 2
  217. IF (ICAS.EQ.1) THEN
  218. MELVAL = IELVAL(I2)
  219. C SEGACT MELVAL
  220. NOE = IELCHE(/1)
  221. NEL = IELCHE(/2)
  222. DO 13 I13=1,NEL
  223. DO 14 I14=1,NOE
  224. MEVOLL = IELCHE(I14,I13)
  225. IF (MEVOLL.EQ.0) THEN
  226. MOTERR(1:8) = 'MCHAML'
  227. INTERR = MCHAML
  228. CALL ERREUR(356)
  229. RETURN
  230. ENDIF
  231. SEGACT MEVOLL
  232. KEVOLL = IEVOLL(1)
  233. C SEGDES MEVOLL
  234. IF (KEVOLL.EQ.0) THEN
  235. MOTERR(1:8) = 'MCHAML'
  236. INTERR = MCHAML
  237. CALL ERREUR(356)
  238. RETURN
  239. ENDIF
  240. SEGACT KEVOLL
  241. NOMVYT=NOMEVY(1:8)
  242. IF (NOMCHT.EQ.NOMVYT) THEN
  243. NOMVXT=NOMEVX(1:8)
  244. DO 15 IU=1,ITE1
  245. IF (MLMOT1.MOTS(IU).EQ.NOMVXT) GOTO 16
  246. 15 CONTINUE
  247. ITE1 = ITE1 + 1
  248. IF (ITE1.GT.JGM) THEN
  249. JGM = JGM + 20
  250. SEGADJ MLMOT1
  251. ENDIF
  252. MLMOT1.MOTS(ITE1) = NOMVXT
  253. 16 CONTINUE
  254. ELSE IF (NOMCHT.EQ.'MOCO'.
  255. & AND.NOMVYT(1:4).EQ.'RAID') THEN
  256. *calcul frequentiel
  257. DO 151 IU=1,ITE1
  258. IF (MLMOT1.MOTS(IU).EQ.'TEMP') GOTO 161
  259. 151 CONTINUE
  260. ITE1 = ITE1 + 1
  261. IF (ITE1.GT.JGM) THEN
  262. JGM = JGM + 20
  263. SEGADJ MLMOT1
  264. ENDIF
  265. MLMOT1.MOTS(ITE1) = 'TEMP'
  266. 161 CONTINUE
  267.  
  268. ELSE
  269. * Le nom de la composante ne correspond pas a l'ordonnee de l'EVOLUTION
  270. MOTERR(1:8) = NOMCHT
  271. MOTERR(9:20) = NOMEVY
  272. CALL ERREUR(678)
  273. C SEGDES KEVOLL
  274. C SEGDES MELVAL
  275. C SEGDES MCHAML
  276. GOTO 9000
  277. END IF
  278. C SEGDES KEVOLL
  279. 14 CONTINUE
  280. 13 CONTINUE
  281. C SEGDES MELVAL
  282. ELSE IF (ICAS.EQ.2) THEN
  283. DO 17 IU=1,ITE1
  284. IF( MLMOT1.MOTS(IU) . EQ.NOMCHT) GO TO 18
  285. 17 CONTINUE
  286. ITE1 = ITE1+1
  287. IF (ITE1.GT.JGM) THEN
  288. JGM = JGM + 20
  289. SEGADJ MLMOT1
  290. ENDIF
  291. MLMOT1.MOTS(ITE1) = NOMCHT
  292. 18 CONTINUE
  293. ENDIF
  294. C
  295. ELSE IF (TYPCHE(I2).EQ.'POINTEURLISTMOTS') THEN
  296. C
  297. IF (ICAS.EQ.1) THEN
  298. C
  299. MELVAL=IELVAL(I2)
  300. C SEGACT,MELVAL
  301. N2PTEL=IELCHE(/1)
  302. N2EL=IELCHE(/2)
  303. C
  304. C Le LISTMOTS donne les noms des variables dont depend
  305. C la composante, dans l'optique d'une evaluation de la
  306. C composante par une fonction externe.
  307. C HYPOTHESE de CHAMP UNIFORME : la composante depend
  308. C des memes variables en tout point d'integration de
  309. C tout element de la sous-zone.
  310. C Cette hypothese est necessaire car la composante ne
  311. C peut etre associee qu'a une seule fonction externe.
  312. C EN CONFORMITE AVEC VARINU.eso
  313. C
  314. IF (N2PTEL.NE.1.AND.N2EL.NE.1) THEN
  315. MOTERR(1:8)=NOMCHE(I2)
  316. CALL ERREUR(953)
  317. C SEGDES,MELVAL
  318. C SEGDES,MCHAML
  319. GOTO 9000
  320. ENDIF
  321. MLMOT2=IELCHE(1,1)
  322. C SEGACT,MLMOT2
  323. JESIMU=0
  324. IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN
  325. JESIMU=1
  326. ENDIF
  327. NPARA=MLMOT2.MOTS(/2)-JESIMU
  328. IF (ITE1.EQ.0) THEN
  329. ITE1=NPARA
  330. IF (ITE1.GT.JGM) THEN
  331. JGM=NPARA
  332. SEGADJ,MLMOT1
  333. ENDIF
  334. DO 19 IP=1,NPARA
  335. JP=IP+JESIMU
  336. MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP)
  337. 19 CONTINUE
  338. ELSE
  339. DO 20 IP=1,NPARA
  340. NOMCHT = MLMOT2.MOTS(IP+JESIMU)
  341. DO 21 IU=1,ITE1
  342. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 20
  343. 21 CONTINUE
  344. ITE1=ITE1+1
  345. IF (ITE1.GT.JGM) THEN
  346. JGM=JGM+20
  347. SEGADJ,MLMOT1
  348. ENDIF
  349. MLMOT1.MOTS(ITE1)=NOMCHT
  350. 20 CONTINUE
  351. ENDIF
  352. C SEGDES,MLMOT2
  353. C SEGDES,MELVAL
  354. C
  355. ELSE IF (ICAS.EQ.2) THEN
  356. C
  357. NOMCHT = NOMCHE(I2)
  358. DO 22 IU=1,ITE1
  359. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 23
  360. 22 CONTINUE
  361. ITE1=ITE1+1
  362. IF (ITE1.GT.JGM) THEN
  363. JGM=JGM+20
  364. SEGADJ,MLMOT1
  365. ENDIF
  366. MLMOT1.MOTS(ITE1)=NOMCHT
  367. 23 CONTINUE
  368. C
  369. ENDIF
  370. C
  371. *-------- Cas d'une table
  372. ELSE IF (TYPCHE(I2).EQ.'POINTEURTABLE') THEN
  373. C
  374. IF (ICAS.EQ.1) THEN
  375. C
  376. MELVAL=IELVAL(I2)
  377. C SEGACT,MELVAL
  378. N2PTEL=IELCHE(/1)
  379. N2EL=IELCHE(/2)
  380. C
  381. C La Table contient un LISTMOTS qui donne les
  382. C noms des variables dont depend
  383. C la composante, dans l'optique d'une evaluation de la
  384. C composante par une fonction externe.
  385. C HYPOTHESE de CHAMP UNIFORME : la composante depend
  386. C des memes variables en tout point d'integration de
  387. C tout element de la sous-zone.
  388. C Cette hypothese est necessaire car la composante ne
  389. C peut etre associee qu'a une seule fonction externe.
  390. C EN CONFORMITE AVEC VARINU.eso
  391. C
  392. IF (N2PTEL.NE.1.AND.N2EL.NE.1) THEN
  393. MOTERR(1:8)=NOMCHE(I2)
  394. CALL ERREUR(953)
  395. C SEGDES,MELVAL
  396. C SEGDES,MCHAML
  397. GOTO 9000
  398. ENDIF
  399. MTAB1=IELCHE(1,1)
  400. SEGACT,MTAB1
  401. if (NBESC.NE.0) SEGACT IPILOC
  402. C Recherche de la liste de mots a ouvrir
  403. ivar = 0
  404. DO 630 IN=1,MTAB1.MLOTAB
  405. if (mtab1.mtabti(in).ne.'MOT') goto 630
  406. IP=MTAB1.MTABII(IN)
  407. IDEBCH=IPCHAR(IP)
  408. IFINCH=IPCHAR(IP+1)-1
  409. IF (ICHARA(IDEBCH:IFINCH).EQ.'VARIABLES') IVAR=IN
  410. 630 CONTINUE
  411. if (ivar.eq.0) GOTO 631
  412. MLMOT2=MTAB1.MTABIV(IVAR)
  413. SEGACT,MLMOT2
  414. JESIMU=0
  415. IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN
  416. JESIMU=1
  417. ENDIF
  418. NPARA=MLMOT2.MOTS(/2)-JESIMU
  419. IF (ITE1.EQ.0) THEN
  420. ITE1=NPARA
  421. IF (NPARA.GT.JGM) THEN
  422. JGM=NPARA
  423. SEGADJ,MLMOT1
  424. ENDIF
  425. DO 29 IP=1,NPARA
  426. JP=IP+JESIMU
  427. MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP)
  428. 29 CONTINUE
  429. ELSE
  430. DO 30 IP=1,NPARA
  431. NOMCHT = MLMOT2.MOTS(IP+JESIMU)
  432. DO 31 IU=1,ITE1
  433. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 30
  434. 31 CONTINUE
  435. ITE1=ITE1+1
  436. IF (ITE1.GT.JGM) THEN
  437. JGM=JGM+20
  438. SEGADJ,MLMOT1
  439. ENDIF
  440. MLMOT1.MOTS(ITE1)=NOMCHT
  441. 30 CONTINUE
  442. ENDIF
  443. C SEGDES,MLMOT2
  444. 631 CONTINUE
  445. if (NBESC.NE.0) SEGDES,IPILOC
  446. SEGDES,MTAB1
  447. C SEGDES,MELVAL
  448. C
  449. ELSE IF (ICAS.EQ.2) THEN
  450. C
  451. NOMCHT =NOMCHE(I2)
  452. DO 32 IU=1,ITE1
  453. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 33
  454. 32 CONTINUE
  455. ITE1=ITE1+1
  456. IF (ITE1.GT.JGM) THEN
  457. JGM=JGM+20
  458. SEGADJ,MLMOT1
  459. ENDIF
  460. MLMOT1.MOTS(ITE1)=NOMCHT
  461. 33 CONTINUE
  462. C
  463. ENDIF
  464. C
  465. *-------- Cas d'un CHARGEMENT (DEVA = TEMP, COVA = "nom composante")
  466. ELSE IF (TYPCHE(I2).EQ.'POINTEURCHARGEME') THEN
  467. C
  468. IF (ICAS.EQ.1) THEN
  469. NOMCHT = 'TEMP'
  470. ELSE IF (ICAS.EQ.2) THEN
  471. NOMCHT = NOMCHE(I2)
  472. ENDIF
  473. C
  474. C On verifie si NOMCHT pas deja dans la liste :
  475. DO 40 IU=1,ITE1
  476. IF( MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 41
  477. 40 CONTINUE
  478. ITE1 = ITE1+1
  479. IF (ITE1.GT.JGM) THEN
  480. JGM = JGM + 20
  481. SEGADJ MLMOT1
  482. ENDIF
  483. MLMOT1.MOTS(ITE1) = NOMCHT
  484. 41 CONTINUE
  485. C
  486. *-------- le type de la composante du mchaml est incorrect ----------
  487. ELSE
  488. MOTERR(1:8) = NOMCHE(I2)
  489. CALL ERREUR(679)
  490. C SEGDES MCHAML
  491. GOTO 9000
  492. END IF
  493.  
  494. 2 CONTINUE
  495. C SEGDES MCHAML
  496. 1 CONTINUE
  497.  
  498. IF (ITE1.NE.JGM) THEN
  499. JGM = ITE1
  500. SEGADJ MLMOT1
  501. ENDIF
  502.  
  503. 9000 CONTINUE
  504. IF (IERR.NE.0) THEN
  505. SEGSUP,MLMOT1
  506. ILISR = 0
  507. ELSE
  508. SEGDES,MLMOT1
  509. ILISR = MLMOT1
  510. ENDIF
  511. C SEGDES MCHELM
  512.  
  513. RETURN
  514. END
  515.  
  516.  
  517.  
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  

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