Télécharger excha1.eso

Retour à la liste

Numérotation des lignes :

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

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