Télécharger excha1.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCHA1 SOURCE CB215821 20/11/04 21:16:51 10766
  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 NOMVXT,NOMVYT,LNOMCH(NNOMCH)
  35. CHARACTER*(LOCOMP) NOMCHT
  36. CHARACTER*4 MOTSIM
  37. DATA MOTSIM / 'SIMU' /
  38. DATA LNOMCH / 'TRAC ','EVOL ','COMP ','FLXY ',
  39. & 'FLXZ ','CISY ','CISZ ','JDA ',
  40. & 'EM0 ','EM1 ','EM2 ','EM3 ',
  41. & 'EM4 ','EM5 ','EM6 ','EM7 ',
  42. & 'EM8 ','MONP ','MONN ','MONO ',
  43. & 'COEV ','TREV ','TRAS ','TRAT ',
  44. $ 'PULO ','ECRO '/
  45. ICAS = 1
  46. IF (CMOT.EQ.'COVA') ICAS = 2
  47.  
  48. *------------- activation de la liste de MOTS ------------------------
  49.  
  50. JGM = 20
  51. JGN = 8
  52. SEGINI MLMOT1
  53. ITE1 = 0
  54.  
  55. MCHELM = ICHAM
  56. CALL ACTOBJ('MCHAML ',MCHELM,1)
  57. C SEGACT MCHELM
  58. NSOUS = ICHAML(/1)
  59.  
  60. *------------------ boucle sur les sous chamelem ---------------------
  61.  
  62. DO 1 I1=1,NSOUS
  63. MCHAML = ICHAML(I1)
  64. C SEGACT MCHAML
  65. NCOMP = NOMCHE(/2)
  66.  
  67. *-------------------- boucle sur les composantes ---------------------
  68.  
  69. DO 2 I2=1,NCOMP
  70. IF (TYPCHE(I2).EQ.'REAL*8 ') THEN
  71. GOTO 2
  72. ELSE IF (TYPCHE(I2).EQ.'POINTEURPOINT ') THEN
  73. GOTO 2
  74. ELSE IF (TYPCHE(I2).EQ.'POINTEURMAILLAGE') THEN
  75. GOTO 2
  76. ELSE IF (TYPCHE(I2).EQ.'POINTEURMCHAML ') THEN
  77. GOTO 2
  78. ELSE IF (TYPCHE(I2).EQ.'POINTEURCHPOINT ') THEN
  79. GOTO 2
  80. ELSE IF (TYPCHE(I2).EQ.'POINTEURMMODEL ') THEN
  81. GOTO 2
  82. ELSE IF (TYPCHE(I2).EQ.'POINTEURLISTREEL') THEN
  83. GOTO 2
  84. ELSE IF (TYPCHE(I2).EQ.'POINTEURNUAGE ') THEN
  85. NOMCHT = NOMCHE(I2)(1:8)
  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)(1:8)
  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)(1:8)
  316. CALL ERREUR(953)
  317. GOTO 9000
  318. ENDIF
  319. MLMOT2=IELCHE(1,1)
  320. C SEGACT,MLMOT2
  321. JESIMU=0
  322. IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN
  323. JESIMU=1
  324. ENDIF
  325. NPARA=MLMOT2.MOTS(/2)-JESIMU
  326. IF (ITE1.EQ.0) THEN
  327. ITE1=NPARA
  328. IF (ITE1.GT.JGM) THEN
  329. JGM=NPARA
  330. SEGADJ,MLMOT1
  331. ENDIF
  332. DO 19 IP=1,NPARA
  333. JP=IP+JESIMU
  334. MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP)
  335. 19 CONTINUE
  336. ELSE
  337. DO 20 IP=1,NPARA
  338. NOMCHT = MLMOT2.MOTS(IP+JESIMU)
  339. DO 21 IU=1,ITE1
  340. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 20
  341. 21 CONTINUE
  342. ITE1=ITE1+1
  343. IF (ITE1.GT.JGM) THEN
  344. JGM=JGM+20
  345. SEGADJ,MLMOT1
  346. ENDIF
  347. MLMOT1.MOTS(ITE1)=NOMCHT
  348. 20 CONTINUE
  349. ENDIF
  350. C SEGDES,MLMOT2
  351. C SEGDES,MELVAL
  352. C
  353. ELSE IF (ICAS.EQ.2) THEN
  354. C
  355. NOMCHT = NOMCHE(I2)(1:8)
  356. DO 22 IU=1,ITE1
  357. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 23
  358. 22 CONTINUE
  359. ITE1=ITE1+1
  360. IF (ITE1.GT.JGM) THEN
  361. JGM=JGM+20
  362. SEGADJ,MLMOT1
  363. ENDIF
  364. MLMOT1.MOTS(ITE1)=NOMCHT
  365. 23 CONTINUE
  366. C
  367. ENDIF
  368. C
  369. *-------- Cas d'une table
  370. ELSE IF (TYPCHE(I2).EQ.'POINTEURTABLE') THEN
  371. C
  372. IF (ICAS.EQ.1) THEN
  373. C
  374. MELVAL=IELVAL(I2)
  375. C SEGACT,MELVAL
  376. N2PTEL=IELCHE(/1)
  377. N2EL=IELCHE(/2)
  378. C
  379. C La Table contient un LISTMOTS qui donne les
  380. C noms des variables dont depend
  381. C la composante, dans l'optique d'une evaluation de la
  382. C composante par une fonction externe.
  383. C HYPOTHESE de CHAMP UNIFORME : la composante depend
  384. C des memes variables en tout point d'integration de
  385. C tout element de la sous-zone.
  386. C Cette hypothese est necessaire car la composante ne
  387. C peut etre associee qu'a une seule fonction externe.
  388. C EN CONFORMITE AVEC VARINU.eso
  389. C
  390. IF (N2PTEL.NE.1.AND.N2EL.NE.1) THEN
  391. MOTERR(1:8)=NOMCHE(I2)(1:8)
  392. CALL ERREUR(953)
  393. GOTO 9000
  394. ENDIF
  395. MTAB1=IELCHE(1,1)
  396. SEGACT,MTAB1
  397. if (NBESC.NE.0) SEGACT IPILOC
  398. C Recherche de la liste de mots a ouvrir
  399. ivar = 0
  400. DO 630 IN=1,MTAB1.MLOTAB
  401. if (mtab1.mtabti(in).ne.'MOT') goto 630
  402. IP=MTAB1.MTABII(IN)
  403. IDEBCH=IPCHAR(IP)
  404. IFINCH=IPCHAR(IP+1)-1
  405. IF (ICHARA(IDEBCH:IFINCH).EQ.'VARIABLES') IVAR=IN
  406. 630 CONTINUE
  407. if (ivar.eq.0) GOTO 631
  408. MLMOT2=MTAB1.MTABIV(IVAR)
  409. SEGACT,MLMOT2
  410. JESIMU=0
  411. IF(MLMOT2.MOTS(1)(1:4).EQ.MOTSIM) THEN
  412. JESIMU=1
  413. ENDIF
  414. NPARA=MLMOT2.MOTS(/2)-JESIMU
  415. IF (ITE1.EQ.0) THEN
  416. ITE1=NPARA
  417. IF (NPARA.GT.JGM) THEN
  418. JGM=NPARA
  419. SEGADJ,MLMOT1
  420. ENDIF
  421. DO 29 IP=1,NPARA
  422. JP=IP+JESIMU
  423. MLMOT1.MOTS(IP)=MLMOT2.MOTS(JP)
  424. 29 CONTINUE
  425. ELSE
  426. DO 30 IP=1,NPARA
  427. NOMCHT = MLMOT2.MOTS(IP+JESIMU)
  428. DO 31 IU=1,ITE1
  429. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 30
  430. 31 CONTINUE
  431. ITE1=ITE1+1
  432. IF (ITE1.GT.JGM) THEN
  433. JGM=JGM+20
  434. SEGADJ,MLMOT1
  435. ENDIF
  436. MLMOT1.MOTS(ITE1)=NOMCHT
  437. 30 CONTINUE
  438. ENDIF
  439. C SEGDES,MLMOT2
  440. 631 CONTINUE
  441. if (NBESC.NE.0) SEGDES,IPILOC
  442. SEGDES,MTAB1
  443. C SEGDES,MELVAL
  444. C
  445. ELSE IF (ICAS.EQ.2) THEN
  446. C
  447. NOMCHT =NOMCHE(I2)(1:8)
  448. DO 32 IU=1,ITE1
  449. IF (MLMOT1.MOTS(IU).EQ.NOMCHT) GO TO 33
  450. 32 CONTINUE
  451. ITE1=ITE1+1
  452. IF (ITE1.GT.JGM) THEN
  453. JGM=JGM+20
  454. SEGADJ,MLMOT1
  455. ENDIF
  456. MLMOT1.MOTS(ITE1)=NOMCHT
  457. 33 CONTINUE
  458. C
  459. ENDIF
  460. C
  461. *-------- Cas d'un CHARGEMENT (DEVA = TEMP, COVA = "nom composante")
  462. ELSE IF (TYPCHE(I2).EQ.'POINTEURCHARGEME') THEN
  463. C
  464. IF (ICAS.EQ.1) THEN
  465. NOMCHT = 'TEMP'
  466. ELSE IF (ICAS.EQ.2) THEN
  467. NOMCHT = NOMCHE(I2)(1:8)
  468. ENDIF
  469. C
  470. C On verifie si NOMCHT pas deja dans la liste :
  471. DO 40 IU=1,ITE1
  472. IF( MLMOT1.MOTS(IU).EQ.NOMCHT) GOTO 41
  473. 40 CONTINUE
  474. ITE1 = ITE1+1
  475. IF (ITE1.GT.JGM) THEN
  476. JGM = JGM + 20
  477. SEGADJ MLMOT1
  478. ENDIF
  479. MLMOT1.MOTS(ITE1) = NOMCHT
  480. 41 CONTINUE
  481. C
  482. *-------- le type de la composante du mchaml est incorrect ----------
  483. ELSE
  484. MOTERR(1:8) = NOMCHE(I2)(1:8)
  485. CALL ERREUR(679)
  486. GOTO 9000
  487. END IF
  488.  
  489. 2 CONTINUE
  490. C SEGDES MCHAML
  491. 1 CONTINUE
  492.  
  493. IF (ITE1.NE.JGM) THEN
  494. JGM = ITE1
  495. SEGADJ MLMOT1
  496. ENDIF
  497.  
  498. 9000 CONTINUE
  499. IF (IERR.NE.0) THEN
  500. SEGSUP,MLMOT1
  501. ILISR = 0
  502. ELSE
  503. SEGDES,MLMOT1
  504. ILISR = MLMOT1
  505. ENDIF
  506. C SEGDES MCHELM
  507.  
  508. RETURN
  509. END
  510.  
  511.  

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