Télécharger lipil.eso

Retour à la liste

Numérotation des lignes :

  1. C LIPIL SOURCE PV 17/12/05 21:16:32 9646
  2. SUBROUTINE LIPIL (ICOLAC,IFIN,IRET,IFORM,LABEL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C BUT : LECTURE DU FICHIER FORMATE OU NON IORES DEFINI PAR:
  7. C OPTIO REST IORES ;
  8. C APPELE PAR : REST
  9. C APPELLE : LFCDIM LFCDIE LFCDI2 NOMNST ENSOLF ENTNOM
  10. C : LIPOIN LIMAIL ERREUR(12)
  11. C ECRIT PAR FARVACQUE -REPRIS PAR LENA
  12. C
  13. C HISTORIQUE : ajout des objets de type MATRAK et MATRIK par
  14. C GOUNAND (15/07/98)
  15. C
  16. C=======================================================================
  17. C TABLEAU KCOLA: VOIR LE SOUS-PROGRAMME TYPFIL
  18. C=======================================================================
  19. -INC CCOPTIO
  20. -INC SMELEME
  21. -INC SMBASEM
  22. -INC SMCOORD
  23. POINTEUR MCOOR1.MCOORD,MCOOR2.MCOORD
  24. -INC SMRIGID
  25. -INC SMELSTR
  26. -INC SMCLSTR
  27. -INC SMDEFOR
  28. -INC SMSTRUC
  29. -INC SMLREEL
  30. -INC SMLENTI
  31. -INC SMLMOTS
  32. -INC SMTEXTE
  33. -INC SMTABLE
  34. -INC SMSUPER
  35. -INC SMVECTD
  36. -INC SMCHARG
  37. -INC SMEVOLL
  38. -INC SMLCHPO
  39. -INC SMINTE
  40. -INC CCGEOME
  41. -INC TMCOLAC
  42. -INC CCFXDR
  43. -INC CCHAMP
  44. C
  45. SEGMENT JPV(MOTS(/2))
  46. C=======================================================================
  47. C ICOLAC : KCOLA : POINTEUR SUR LA PILE ITLACC
  48. C MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  49. C ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  50. C KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  51. C SORTIR
  52. C=======================================================================
  53. SEGMENT/ITBBE1/( ITABE1(NN))
  54. SEGMENT/ITBBE2/( ITABE2(NN))
  55. segment itbbc2
  56. character*4 itabc2(nn)
  57. endsegment
  58. SEGMENT/ITBBM1/( ITABM1(NM))
  59. segment itbbc1
  60. character*4 itabc1(nm)
  61. endsegment
  62. SEGMENT/ITBBM2/( ITABM2(NM2))
  63. segment itbbc3
  64. character*4 itabc3(nm2)
  65. endsegment
  66. SEGMENT/ITBBM3/( ITABM3(NM2))
  67. segment itbbc4
  68. character*4 itabc4(nm2)
  69. endsegment
  70. SEGMENT/ITBBM4/( ITABM4(NM2))
  71. segment itbbc5
  72. character*4 itabc5(nm2)
  73. endsegment
  74. SEGMENT/ITBBR1/( TABR1(L)*D)
  75. SEGMENT/NOMM1/(NOM1(NOBJN1))
  76. SEGMENT NOMM2
  77. CHARACTER*(8) NOM2(NOBJN1)
  78. ENDSEGMENT
  79. SEGMENT ITAMOT
  80. CHARACTER*(NN) ITAMO
  81. INTEGER ICOTA(NNN)
  82. ENDSEGMENT
  83. segment xmaaux
  84. real*8 reaux(laux,nelrig)
  85. endsegment
  86. C
  87. DIMENSION IPVV(2)
  88. DIMENSION ILENA(30)
  89. DIMENSION NOMM(2)
  90. CHARACTER*(8) ITYPE,CTYPE
  91. CHARACTER*72 LABEL
  92. REAL*8 XVA
  93. LOGICAL LOGI
  94. CHARACTER*(72) CHA1T
  95. CHARACTER*(512) CHA1
  96. CHARACTER*(1) CHARI
  97. REAL*4 DENSI4
  98. C--------------------------------------------------------------------
  99. minouv=0
  100. mlnouv=0
  101. mrnouv=0
  102. IQUOI=0
  103. NOMM1=0
  104. NOMM2=0
  105. ITBBM1=0
  106. ITBBM2=0
  107. ITBBM3=0
  108. ITBBM4=0
  109. ITBBE1=0
  110. ITBBE2=0
  111. ITBBR1=0
  112. IRET=0
  113. IRETOU=0
  114. NOBJN1=0
  115. CHA1T=' '
  116. SEGINI NOMM1
  117. SEGINI NOMM2
  118. SEGACT ICOLAC*MOD
  119. NBANC=XCOOR(/1)/(IDIM+1)
  120. mianc=minouv
  121. mlanc=mlnouv
  122. mranc=mrnouv
  123. C ------------------------------------------------------------------
  124. C --- BOUCLE DE LECTURE SUR UN DESCRIPTEUR-------------------------
  125. 1097 CONTINUE
  126. IRETOU=0
  127. IQUOI=0
  128. CALL LFCDES (IORES,IQUOI,IRETOU,IFORM)
  129. IF (IIMPI.EQ.5) WRITE(IOIMP,555) IQUOI,IRETOU
  130. 555 FORMAT(' ENREG DE TYPE ',I3,' CODE RETOUR DE LECTURE =',I2)
  131. IF(IRETOU.NE.0) THEN
  132. IF( IONIVE.GE.10) THEN
  133. IF(LABEL.EQ.' '.AND.CHA1T.NE.' ') THEN
  134. IRETOU=0
  135. GO TO 1001
  136. ELSE
  137. MOTERR(1:24) = LABEL
  138. CALL ERREUR (874)
  139. GO TO 1000
  140. ENDIF
  141. ELSE
  142. MOTERR(1:24) = LABEL
  143. CALL ERREUR (874)
  144. GO TO 1000
  145. ENDIF
  146. ENDIF
  147. C *** FIN DES LECTURES ********SI IQUOI=5
  148. IF(IQUOI.EQ.5) THEN
  149. IF(IONIVE.GE.10) THEN
  150. IF(IFORM.EQ.1) READ (IORES,776) CHA1T
  151. IF(IFORM.EQ.0) READ (IORES) CHA1T
  152. if (iform.eq.2) ios=IXDRSTRING( ixdrr,cha1t(1:72))
  153. 776 FORMAT(A72)
  154. WRITE (IOIMP,778) CHA1T
  155. 778 FORMAT ( 'FIN DE LECTURE DU LABEL : ',/,A72,/)
  156. mianc=minouv
  157. mlanc=mlnouv
  158. mranc=mrnouv
  159. IF(LABEL.NE.' ') THEN
  160. IF(LABEL.EQ.CHA1T ) GO TO 1001
  161. ENDIF
  162. GO TO 1097
  163. ENDIF
  164. ENDIF
  165. GO TO (999 ,5000,4000,444,1001,999 ,4001,4002 ),IQUOI
  166. C --- ERREUR
  167. 999 GO TO 1000
  168. C--------------------------------------------------------------------
  169. C ***** LECTURE DES INFORMATIONS GENERALES A METTRE DANS LES COMMONS
  170. C --- IQUOI=4
  171. 444 CONTINUE
  172. IF(IFORM.EQ.1)READ(IORES,701,END=1000,ERR=1000) NIVEAU,IARR,JDIM
  173. IF(IFORM.EQ.0)READ(IORES,END=1000,ERR=1000) NIVEAU,IARR,JDIM
  174. if (iform.eq.2) then
  175. ios=IXDRINT( ixdrr, niveau )
  176. ios=IXDRINT( ixdrr, iarr )
  177. ios=IXDRINT( ixdrr, jdim )
  178. endif
  179. IONIVE=NIVEAU
  180. 701 FORMAT(7X,I4,14X,I4,10X,I4)
  181. WRITE (IOIMP,33201) NIVEAU
  182. 33201 FORMAT (//,' NIVEAU DU FICHIER',I3)
  183. CCCCC IF (NIVEAU.NE.0) GOTO 1000
  184. IF (IFORM.EQ.1) READ(IORES,702) DENSI4
  185. IF (IFORM.EQ.0) READ(IORES) DENSI4
  186. if (iform.eq.2) ios=IXDRREAL( ixdrr, densi4 )
  187. densit = densi4
  188. 702 FORMAT(8X,E12.5)
  189. WRITE (IOIMP,201) IaRR,JDIM,DENSIT
  190. 201 FORMAT (//,' NIVEAU D''ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',
  191. 1 1PE12.5)
  192. IERMAX=MAX(IERMAX,IaRR)
  193. * IERR=0
  194. CALLGINT2
  195. IF (IDIM.EQ.0) IDIM=JDIM
  196. IF (JDIM.NE.0.AND.JDIM.NE.IDIM) CALL ERREUR(12)
  197. GOTO 1097
  198. C
  199. C **** Noms des composantes primales et duales *****************
  200. C Repris de la lecture des LISTMOTS
  201. C --- IQUOI=8
  202. 4002 CONTINUE
  203. DO I=1,2
  204. ITOTO=2
  205. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  206. IF (IRETOU.NE.0) GO TO 1000
  207. JGN = ILENA(1)
  208. JGM = ILENA(2)
  209. * SEGINI MLMOTS
  210. NN=JGN*JGM
  211. NNN=0
  212. SEGINI ITAMOT
  213. CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  214. IF(IRETOU.NE.0) GOTO 1000
  215. IF (I.EQ.1) THEN
  216. LNOMDD=MIN(JGM,1000)
  217. KNOMDD=MIN(JGN,LEN(NOMDD(1)))
  218. DO IUH = 1,LNOMDD
  219. ideb = (IUH-1)*JGN+1
  220. ifin = ideb+knomdd-1
  221. NOMDD(IUH)= ITAMO(ideb:ifin)
  222. ENDDO
  223. ELSE
  224. LNOMDU=MIN(JGM,1000)
  225. KNOMDU=MIN(JGN,LEN(NOMDU(1)))
  226. DO IUH = 1,LNOMDU
  227. ideb = (IUH-1)*JGN+1
  228. ifin = ideb+knomdu-1
  229. NOMDU(IUH)= ITAMO(ideb:ifin)
  230. ENDDO
  231. ENDIF
  232. SEGSUP ITAMOT
  233. ENDDO
  234.  
  235. GOTO 1097
  236. C
  237. C **** INFORMATIONS GENERALES CASTEM2000 *****************
  238. C --- IQUOI=7
  239. 4001 CONTINUE
  240. CALL LIINFG (IRETOU,IFORM)
  241. IF(IRETOU.NE.0) GOTO 1000
  242. GOTO 1097
  243. C
  244. C ***** LECTURE D'UN TITRE *************************************
  245. C --- IQUOI=3
  246. 4000 CONTINUE
  247. CALL LFCDIM(IORES,18,ILENA,IRETOU,IFORM)
  248. WRITE(TITREE,FMT='(18A4)')(ILENA(IY),IY=1,18)
  249. IF(IRETOU.NE.0) GOTO 1000
  250. GOTO 1097
  251. C
  252. C ***** LECTURE D'UNE PILE *************************************
  253. C --- IQUOI=2
  254. 5000 CONTINUE
  255. IF(IERR.NE.0) RETURN
  256. ITOTO=3
  257. CALL LFCDIP (IORES,ITOTO,ILENA,IRETOU,IFORM)
  258. IF ( IRETOU.NE.0) GO TO 1000
  259. IFILE =ILENA(1)
  260. NOBJN =ILENA(2)
  261. IMAX1 =ILENA(3)
  262. ITYPE=' '
  263. IF(IFILE.NE.0) THEN
  264. CALL TYPFIL(ITYPE,IFILE)
  265. WRITE (IOIMP,805) IMAX1,ITYPE
  266. 805 FORMAT( ' LECTURE DE ',I8 , ' OBJETS ',A8)
  267. IF(IIMPI.NE.0)
  268. * WRITE(IOIMP,803)IFILE,ITYPE,IMAX1,NOBJN
  269. ELSE
  270. ITYPE='POINT '
  271. IF(IIMPI.NE.0) WRITE(IOIMP,804)IMAX1,NOBJN
  272. ENDIF
  273. 803 FORMAT(///' * LA FILE NUMERO',I4,' CONSTITUEE D''OBJETS DE TYPE
  274. 1 ',A8,' CONTIENT',I8,
  275. 1 ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.')
  276. 804 FORMAT(///' * IL Y A ',I8,' NOUVEAUX POINTS, PARMI LESQUELS ',
  277. 1 I6,' SONT NOMMES.')
  278. C --- LECTURE DES NOMS S ILS EXISTENT
  279. CALL ENTNOM(IORES,NOBJN,NOMM1,NOMM2,IRETOU,IFORM)
  280. IF(IRETOU.NE.0) GOTO 1000
  281. C --- LECTURE DE LA PILE - ON EN LIRA IMAX1-------------------------
  282. IF(IFILE.EQ.0) GO TO 5001
  283. C KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
  284. ITLACC=KCOLA(IFILE)
  285. segact itlacc*mod
  286. IRETOU=0
  287. C ---
  288. if(ionive.ge.17) then
  289. if(ifile.eq.27) then
  290. segsup itlacc
  291. segini itlacc
  292. kcolac(ifile)=imax1
  293. kcola(ifile) = itlacc
  294. endif
  295. endif
  296. GO TO (6001,6002,6003,1002,1002,6006,6007,6008,6009,6010,1002,
  297. 1 6012,6013,6014,6015,6016,6017,6018,6019,6020,1002,6022,
  298. 1 6023,6024,6025,6026,6027,6028,6029,6030,6031,6032,6033,
  299. 1 6034,6035,6036,6037,6038,6039,6040,6041,
  300. 1 6042,6043,6010,6045,1098,1098,6048 ),IFILE
  301. 1002 MOTERR(1:8)=ITYPE
  302. CALL ERREUR(336)
  303. IF (ITYPE.EQ.'ESCLAVE') GOTO 1097
  304. GO TO 1000
  305. C *************** POINTS ET COORD**********************************
  306. 5001 CONTINUE
  307. IF(IONIVE.LE.9) THEN
  308. CALL LIPOIN (IMAX1,NOBJN,NOMM1,NOMM2,NBANC,IRETOU,IFORM)
  309. IF (IRETOU.NE.0) GO TO 1000
  310. ENDIF
  311. GOTO 1097
  312. C **************************MELEME**********************************
  313. 6001 CONTINUE
  314. DO 7 IEL=1,IMAX1
  315. IRETOU=0
  316. CALL LIMAIL (MELEME,NBANC,IRETOU,IFORM)
  317. IF (IRETOU.NE.0) GO TO 1000
  318. ITLAC(**)=MELEME
  319. * si on avait avant la restitution un point support de contact il faut l
  320. * le confondre avec celui restitue.
  321. 7 CONTINUE
  322. GOTO 1098
  323. C **************************CHPOINT*********************************
  324. 6002 CONTINUE
  325. CALL LICHPO(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  326. IF (IRETOU.NE.0) GO TO 1000
  327. GOTO 1098
  328. C ***********************MRIGID*************************************
  329. 6003 CONTINUE
  330. NN=0
  331. SEGINI ITBBE1
  332. NM=0
  333. SEGINI ITBBM1,itbbc1
  334. DO 1202 IEL=1,IMAX1
  335. C READ(IORES,8000,END=1000,ERR=1000) NRIGEL,ICHO,NBGEOR,NRIGE,J
  336. ITOTO=5
  337. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  338. IF (IRETOU.NE.0) GO TO 1000
  339. NRIGEL= ILENA(1)
  340. ICHO = ILENA(2)
  341. NBGEOR= ILENA(3)
  342. NRIGE = ILENA(4)
  343. J = ILENA(5)
  344. SEGINI MRIGID
  345. ITLAC(**)=MRIGID
  346. IFORIG=J
  347. C READ(IORES,8001,END=1000,ERR=1000)MTYMAT(1),MTYMAT(2)
  348. ITOTO=2
  349. CCC CALL LFCDIM (IORES,ITOTO,MTYMAT,IRETOU,IFORM)
  350. if (iform.ne.2) then
  351. CALL LFCDIM (IORES,ITOTO,IPVV,IRETOU,IFORM)
  352. IF (IRETOU.NE.0) GO TO 1000
  353. WRITE(MTYMAT,FMT='(2A4)') IPVV(1),IPVV(2)
  354. else
  355. ios=IXDRSTRING( ixdrr, mtymat(1:8))
  356. if (ios.lt.0) goto 1000
  357. endif
  358. ICHOLE=ICHO
  359. NN=NRIGE*NRIGEL+NBGEOR
  360. IF(IONIVE.GE.5) NN=NN + NRIGEL
  361. SEGADJ ITBBE1
  362. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  363. IF (IRETOU.NE.0) GO TO 1000
  364. NNN=0
  365. DO 1203 IR=1,NRIGEL
  366. II=NRIGE*(IR-1)
  367. DO 1204 NR=1,NRIGE
  368. IRR=II+NR
  369. IRIGEL(NR,IR)=ITABE1(IRR)
  370. 1204 CONTINUE
  371. NLIGRP=ITABE1(II+3)
  372. NLIGRD=NLIGRP
  373. IF(IONIVE.GE.5) THEN
  374. NLIGRD=ITABE1(IR+ NRIGE*NRIGEL+NBGEOR)
  375. ENDIF
  376. NNN=NNN+NLIGRP + NLIGRD
  377. SEGINI DESCR
  378. IRIGEL(3,IR)=DESCR
  379. if(ionive.ge.18.and.ionive.lt.20) then
  380. nelrig=ITABE1(II+4)
  381. segini xmatri
  382. irigel(4,ir)=xmatri
  383. endif
  384. 1203 CONTINUE
  385. IF(NBGEOR.EQ.0) GOTO 1207
  386. SEGINI IMGEOD
  387. DO 1206 I=1,NBGEOR
  388. IMGEOR(I)=ITABE1(NRIGE*NRIGEL+I)
  389. 1206 CONTINUE
  390. SEGDES IMGEOD
  391. IMGEO1=IMGEOD
  392. 1207 NN=NNN
  393. IF(IONIVE.LT.5) NN=NN/2
  394. SEGADJ ITBBE1
  395. NM=NNN
  396. SEGADJ ITBBM1,itbbc1
  397. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  398. IF(IRETOU.NE.0) GOTO 1000
  399. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  400. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  401. IF(IRETOU.NE.0) GOTO 1000
  402. J=0
  403. DO 1208 IR=1,NRIGEL
  404. DESCR=IRIGEL(3,IR)
  405. SEGACT DESCR*MOD
  406. NLIGRP=NOELEP(/1)
  407. IF(IONIVE.GE.5) THEN
  408. DO 1205 I=1,NLIGRP
  409. J=J+1
  410. NOELEP(I)=ITABE1(J)
  411. if (iform.ne.2) WRITE(LISINC(I),FMT='(A4)')ITABM1(J)
  412. if (iform.eq.2) lisinc(i)=itabc1(j)
  413. 1205 CONTINUE
  414. NLIGRD=NOELED(/1)
  415. DO 1209 I=1,NLIGRD
  416. J=J+1
  417. NOELED(I)=ITABE1(J)
  418. if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(J)
  419. if (iform.eq.2) lisdua(i)=itabc1(j)
  420. 1209 CONTINUE
  421. ELSE
  422. DO 1215 I=1,NLIGRP
  423. J=J+1
  424. NOELEP(I)=ITABE1(J)
  425. NOELED(I)=ITABE1(J)
  426. if (iform.ne.2) then
  427. WRITE(LISINC(I),FMT='(A4)')ITABM1(2*J-1)
  428. else
  429. lisinc(i)=itabc1(2*j-1)
  430. endif
  431. if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(2*J)
  432. if (iform.eq.2) lisdua(i)=itabc1(2*j)
  433. 1215 CONTINUE
  434. ENDIF
  435. SEGDES DESCR
  436. 1208 CONTINUE
  437. CALL LFCDI2(IORES,NRIGEL,COERIG,IRETOU,IFORM)
  438. if(ionive.ge.18.and.ionive.lt.20) then
  439. do ir=1,nrigel
  440. xmatri=irigel(4,ir)
  441. lval=re(/1)*re(/2)*re(/3)
  442. call lfcdi2(iores,lval,re,iretou,iform)
  443. segdes xmatri
  444. enddo
  445. endif
  446. SEGDES MRIGID
  447. IF(IRETOU.NE.0) GOTO 1000
  448. 1202 CONTINUE
  449. SEGSUP ITBBM1,itbbc1,ITBBE1
  450. GOTO 1098
  451. C *************************** *******************************
  452. 6004 CONTINUE
  453. GOTO 1098
  454. C *********************** *********************************
  455. 6005 CONTINUE
  456. GOTO 1098
  457. C ********************************BLOQ STRUC
  458. 6006 CONTINUE
  459. DO 60 IEL=1,IMAX1
  460. ITOTO=1
  461. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  462. IF(IRETOU.NE.0) GO TO 1000
  463. N=ILENA(1)
  464. SEGINI MCLSTR
  465. ITLAC(**)= MCLSTR
  466. CALL LFCDIE (IORES,N ,ISOSTR,IRETOU,IFORM)
  467. IF(IRETOU.NE.0) GO TO 1000
  468. CALL LFCDIE (IORES,N ,IRIGCL,IRETOU,IFORM)
  469. IF(IRETOU.NE.0) GO TO 1000
  470. SEGDES MCLSTR
  471. 60 CONTINUE
  472. GO TO 1098
  473. C ********************************ELEM STRUC
  474. 6007 CONTINUE
  475. DO 70 IEL=1,IMAX1
  476. ITOTO=1
  477. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  478. IF(IRETOU.NE.0) GO TO 1000
  479. N=ILENA(1)
  480. SEGINI MELSTR
  481. ITLAC(**) =MELSTR
  482. CALL LFCDIE (IORES,N ,ISOSTU,IRETOU,IFORM)
  483. IF(IRETOU.NE.0) GO TO 1000
  484. CALL LFCDIE (IORES,N ,IMELEM,IRETOU,IFORM)
  485. IF(IRETOU.NE.0) GO TO 1000
  486. SEGDES MELSTR
  487. 70 CONTINUE
  488. GO TO 1098
  489. C ****************************MSOLUT********************************
  490. 6008 CONTINUE
  491. IMAX2=IMAX1
  492. DO 1800 IEL=1,IMAX1
  493. IRETOU=0
  494. IF (NIVEAU.LE.2) CALL ENSOLF(ICOLAC,IRET,IFORM)
  495. IF (NIVEAU.LE.2) MSOLUT=IRET
  496. IF (NIVEAU.GE.3) CALL LISOLU(MSOLUT,IRETOU,IFORM)
  497. IF (IRETOU.NE.0) GO TO 1000
  498. IRET=MSOLUT
  499. IF(IRET.GE.0) THEN
  500. ITLAC(**)=IRET
  501. ELSE
  502. IF(IRET.LT.0) THEN
  503. ITLAC(**)=-IRET
  504. IMAX2=IEL
  505. ELSE
  506. IMAX2=IEL-1
  507. ENDIF
  508. GOTO 1801
  509. ENDIF
  510. 1800 CONTINUE
  511. 1801 CONTINUE
  512. IMAX1=IMAX2
  513. GOTO 1098
  514. C ***************************MSTRUC********************************
  515. 6009 CONTINUE
  516. DO 1901 IEL=1,IMAX1
  517. C READ(IORES,8000,END=1000,ERR=1000) N
  518. ITOTO=1
  519. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  520. IF (IRETOU.NE.0) GO TO 1000
  521. N = ILENA(1)
  522. SEGINI MSTRUC
  523. ITLAC(**)=MSTRUC
  524. CALL LFCDIE(IORES,N,LISTRU,IRETOU,IFORM)
  525. IF(IRETOU.NE.0) GOTO 1000
  526. SEGDES MSTRUC
  527. 1901 CONTINUE
  528. GOTO 1098
  529. C ******************************* MTABLE **************************
  530. 6010 CONTINUE
  531. NN=0
  532. SEGINI ITBBE1
  533. ITOTO=1
  534. DO 710 IEL=1,IMAX1
  535. MTABLE=0
  536. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  537. * write (6,*) ' lipil table ',ilena(1)
  538. IF (IRETOU.NE.0) GO TO 1000
  539. NN=ILENA(1)
  540. CCC IF (NN.EQ.0) GO TO 109
  541. M=NN/4
  542. SEGINI MTABLE
  543. MLOTAB=M
  544. IF (NN.EQ.0) GO TO 713
  545. SEGADJ ITBBE1
  546. CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
  547. * write (6,*) ' lipil table ',(itabe1(ii),ii=1,nn)
  548. IF(IRETOU.NE.0) GO TO 1000
  549. KK=0
  550. DO 711 K=1,NN,4
  551. KK=KK+1
  552. J=ITABE1(K)
  553. IVA=ITABE1(K+1)
  554. CTYPE=' '
  555. CALL TYPFIL (CTYPE,J)
  556. if (ctype.eq.'ENTIER') then
  557. * write (6,*) ' lipil indice table ',ctype,iva,mianc
  558. if (ionive.le.20) iva=iva+mianc
  559. endif
  560. if (ctype.eq.'FLOTTANT') then
  561. * write (6,*) ' lipil indice table ',ctype,iva,mranc
  562. iva=iva+mranc
  563. endif
  564. if (ctype.eq.'LOGIQUE') then
  565. iva=iva+mlanc
  566. endif
  567. MTABII(KK)=IVA
  568. MTABTI(KK)=CTYPE
  569. J=ITABE1(K+2)
  570. IVA=ITABE1(K+3)
  571. CTYPE=' '
  572. CALL TYPFIL (CTYPE,J)
  573. if (ctype.eq.'ENTIER') then
  574. * write (6,*) ' lipil valeur table ',ctype,iva,mianc
  575. if (ionive.le.20) iva=iva+mianc
  576. endif
  577. if (ctype.eq.'FLOTTANT') then
  578. * write (6,*) ' lipil indice table ',ctype,iva,mranc
  579. iva=iva+mranc
  580. endif
  581. if (ctype.eq.'LOGIQUE') then
  582. iva=iva+mlanc
  583. endif
  584. ** en attendant de savoir lire un esclave
  585. IF (CTYPE.EQ.'ESCLAVE') CTYPE='ANNULE'
  586. MTABIV(KK)=IVA
  587. MTABTV(KK)=CTYPE
  588. 711 CONTINUE
  589. 713 SEGDES MTABLE
  590. 109 ITLAC(**)=MTABLE
  591. 710 CONTINUE
  592. SEGSUP ITBBE1
  593. GOTO 1098
  594. C ***************************** *****************************
  595. 6011 CONTINUE
  596. GOTO 1098
  597. C **********************&**MSOSTU*******************************
  598. 6012 CONTINUE
  599. NN=0
  600. SEGINI ITBBE1
  601. DO 2201 IEL=1,IMAX1
  602. ITOTO=1
  603. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  604. IF (IRETOU.NE.0) GO TO 1000
  605. NS = ILENA(1)
  606. SEGINI MSOSTU
  607. ITLAC (**)=MSOSTU
  608. C READ(IORES,8000,END=1000,ERR=1000)ITYSOU,ISRAID,ISMASS
  609. ITOTO=3+NS
  610. NN=ITOTO
  611. SEGADJ ITBBE1
  612. CALL LFCDIE (IORES,ITOTO,ITABE1(1),IRETOU,IFORM)
  613. IF (IRETOU.NE.0) GO TO 1000
  614. ITYSOU= ITABE1(1)
  615. ISRAID= ITABE1(2)
  616. ISMASS= ITABE1(3)
  617. IF (NS.EQ.0) GO TO 120
  618. DO 12 I=1,NS
  619. ISCHAM(I)= ITABE1(I+3)
  620. 12 CONTINUE
  621. 120 SEGDES MSOSTU
  622. 2201 CONTINUE
  623. SEGSUP ITBBE1
  624. GOTO 1098
  625. C ***************************** IMATRI *****************************
  626. 6013 CONTINUE
  627. DO 2300 IEL=1,IMAX1
  628. C READ(IORES,8000,END=1000,ERR=1000)NELRIG
  629. ITOTO=4
  630. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  631. IF (IRETOU.NE.0) GO TO 1000
  632. nelrig=ilena(3)
  633. nligrd=ilena(1)
  634. nligrp=ilena(2)
  635. lval=nelrig*nligrp*nligrd
  636. segini xmatri
  637. symre=ilena(4)
  638. if (symre.eq.0.and.nligrp.eq.nligrd) then
  639. * cas symetrique on ne lit que la partie triangulaire
  640. laux=nligrp*(nligrp+1)/2
  641. segini xmaaux
  642. call lfcdi2(iores,laux*nelrig,reaux,
  643. > iretou,iform)
  644. do k=1,nelrig
  645. ip=0
  646. do j=1,nligrp
  647. do i=1,j
  648. re(i,j,k)=reaux(ip+i,k)
  649. re(j,i,k)=reaux(ip+i,k)
  650. enddo
  651. ip=ip+j
  652. enddo
  653. enddo
  654. segsup xmaaux
  655. else
  656. * cas general on lit tout
  657. call lfcdi2(iores,lval,re,iretou,iform)
  658. endif
  659. itlac(**)=xmatri
  660. SEGDES xMATRI
  661. 2300 CONTINUE
  662. GOTO 1098
  663. C ***************************** MJONCT *****************************
  664. 6014 CONTINUE
  665. CALL LIJONC (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  666. IF (IRETOU.NE.0) GO TO 1000
  667. GOTO 1098
  668. C ***************************** MATTAC *****************************
  669. 6015 CONTINUE
  670. CALL LIATTA (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  671. IF (IRETOU.NE.0) GO TO 1000
  672. GOTO 1098
  673. C ***************************** MMATRI *****************************
  674. 6016 CONTINUE
  675. CALL LIMMAT (IORES,ITLACC,IMAX1,IRETOU,IFORM)
  676. IF (IRETOU.NE.0) GO TO 1000
  677. GOTO 1098
  678. C *************************MDEFOR*******************************
  679. 6017 CONTINUE
  680. NN=0
  681. SEGINI ITBBE1
  682. DO 2700 IEL=1,IMAX1
  683. C READ(IORES,8000,END=1000,ERR=1000) NDEF
  684. ITOTO=1
  685. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  686. IF (IRETOU.NE.0) GO TO 1000
  687. NDEF = ILENA(1)
  688. SEGINI MDEFOR
  689. ITLAC(**)=MDEFOR
  690. CALL LFCDI2(IORES,NDEF,AMPL,IRETOU,IFORM)
  691. IF(IRETOU.NE.0) GOTO 1000
  692. C READ(IORES,8000,END=1000,ERR=1000)(IELDEF(I),I=1,NDEF),(ICHDEF(I),
  693. C 1 I=1,NDEF), (JCOUL(I),I=1,NDEF)
  694. NN=7*NDEF
  695. SEGADJ ITBBE1
  696. CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
  697. IF (IRETOU.NE.0) GO TO 1000
  698. CALL JDANSI ( IELDEF(1),ITABE1(1),NDEF)
  699. CALL JDANSI ( ICHDEF(1),ITABE1(NDEF +1),NDEF)
  700. CALL JDANSI ( JCOUL(1),ITABE1(2*NDEF+1),NDEF)
  701. CALL JDANSI ( MTVECT(1),ITABE1(3*NDEF+1),NDEF)
  702. CALL JDANSI ( MDCHP(1),ITABE1(4*NDEF+1),NDEF)
  703. CALL JDANSI ( MDCHEL(1),ITABE1(5*NDEF+1),NDEF)
  704. CALL JDANSI ( MDMODE(1),ITABE1(6*NDEF+1),NDEF)
  705. SEGDES MDEFOR
  706. 2700 CONTINUE
  707. SEGSUP ITBBE1
  708. GOTO 1098
  709. C ******************************MLREEL**************************
  710. 6018 CONTINUE
  711. DO 2800 IEL=1,IMAX1
  712. C READ(IORES,8000,END=1000,ERR=1000)N
  713. ITOTO=1
  714. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  715. IF (IRETOU.NE.0) GO TO 1000
  716. N = ILENA(1)
  717. JG=N
  718. SEGINI MLREEL
  719. CALL LFCDI2(IORES,N,PROG,IRETOU,IFORM)
  720. SEGDES MLREEL
  721. IF(IRETOU.NE.0) GOTO 1000
  722. ITLAC(**)=MLREEL
  723. 2800 CONTINUE
  724. GOTO 1098
  725. C ******************************MLENTI****************************
  726. 6019 CONTINUE
  727. DO 2900 IEL=1,IMAX1
  728. ITOTO=1
  729. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  730. IF (IRETOU.NE.0) GO TO 1000
  731. N = ILENA(1)
  732. JG=N
  733. SEGINI MLENTI
  734. CALL LFCDEE(IORES,N,LECT,IRETOU,IFORM)
  735. SEGDES MLENTI
  736. IF(IRETOU.NE.0) GOTO 1000
  737. ITLAC(**)=MLENTI
  738. 2900 CONTINUE
  739. GOTO 1098
  740. C ****************************MCHARG******************************
  741. 6020 CONTINUE
  742. NN=0
  743. NM=0
  744. NM2=0
  745. SEGINI ITBBM1,itbbc1
  746. SEGINI ITBBM2,itbbc3
  747. SEGINI ITBBM3,itbbc4
  748. SEGINI ITBBM4,itbbc5
  749. SEGINI ITBBE1
  750. SEGINI ITBBE2,itbbc2
  751. DO 3000 IEL=1,IMAX1
  752. C READ(IORES,8000,END=1000,ERR=1000)N
  753. IF(IONIVE.LE.6) THEN
  754. ITOTO=1
  755. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  756. IF (IRETOU.NE.0) GO TO 1000
  757. N = ILENA(1)
  758. SEGINI MCHARG
  759. NM=2*N
  760. SEGADJ ITBBM1,itbbc1
  761. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  762. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  763. IF(IRETOU.NE.0) GOTO 1000
  764. NN=3*N
  765. SEGADJ ITBBE1
  766. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  767. IF(IRETOU.NE.0) GOTO 1000
  768. DO 3001 I=1,N
  769. c WRITE (CHANOM(I),FMT='(I4)') I
  770. CHANOM(I)=' '
  771. SEGINI ICHARG
  772. KCHARG(I)=ICHARG
  773. I2=2*I
  774. I3=3*I
  775. if (iform.ne.2) then
  776. WRITE (CHANAT(I),FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  777. else
  778. chanat(i)(1:4)=itabc1(i2-1)
  779. chanat(i)(5:8)=itabc1(i2)
  780. endif
  781. CHATYP='CHPOINT '
  782. ICHPO1=ITABE1(I3-2)
  783. ICHPO2=ITABE1(I3-1)
  784. ICHPO3=ITABE1(I3)
  785. SEGDES ICHARG
  786. 3001 CONTINUE
  787. ELSE IF (IONIVE.GE.7.AND.IONIVE.LE.10) THEN
  788. ITOTO=1
  789. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  790. IF (IRETOU.NE.0) GO TO 1000
  791. N = ILENA(1)
  792. SEGINI MCHARG
  793. NN=2*N
  794. SEGADJ ITBBE2,itbbc2
  795. if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
  796. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
  797. IF(IRETOU.NE.0) GOTO 1000
  798. NM2=N
  799. SEGADJ ITBBM2,itbbc3
  800. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  801. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  802. IF(IRETOU.NE.0) GOTO 1000
  803. NM=2*N
  804. SEGADJ ITBBM1,itbbc1
  805. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  806. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  807. IF(IRETOU.NE.0) GOTO 1000
  808. NN=3*N
  809. SEGADJ ITBBE1
  810. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  811. IF(IRETOU.NE.0) GOTO 1000
  812. DO 3002 I=1,N
  813. SEGINI ICHARG
  814. KCHARG(I)=ICHARG
  815. I2=2*I
  816. I3=3*I
  817. if (iform.ne.2) then
  818. WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  819. WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
  820. WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
  821. else
  822. chatyp(1:4)=itabc1(i2-1)
  823. chatyp(5:8)=itabc1(i2)
  824. chanat(i)(1:4)=itabc2(i2-1)
  825. chanat(i)(5:8)=itabc2(i2)
  826. chanom(i)=itabc3(i)
  827. endif
  828. c initialise par defaut
  829. CHAMOB(I) = 'STAT'
  830. CHALIE(I) = 'LIE '
  831. c..
  832. ICHPO1=ITABE1(I3-2)
  833. ICHPO2=ITABE1(I3-1)
  834. ICHPO3=ITABE1(I3)
  835. SEGDES ICHARG
  836. 3002 CONTINUE
  837. ELSE
  838. ITOTO=1
  839. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  840. IF (IRETOU.NE.0) GO TO 1000
  841. N = ILENA(1)
  842. SEGINI MCHARG
  843. NN=2*N
  844. SEGADJ ITBBE2,itbbc2
  845. if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
  846. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
  847. IF(IRETOU.NE.0) GOTO 1000
  848. NM2=N
  849. SEGADJ ITBBM2,itbbc3
  850. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  851. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  852. IF(IRETOU.NE.0) GOTO 1000
  853. SEGADJ ITBBM3,itbbc4
  854. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM3,IRETOU,IFORM)
  855. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc4(1)(1:nm2*4))
  856. IF(IRETOU.NE.0) GOTO 1000
  857. SEGADJ ITBBM4,itbbc5
  858. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM4,IRETOU,IFORM)
  859. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc5(1)(1:nm2*4))
  860. IF(IRETOU.NE.0) GOTO 1000
  861. NM=2*N
  862. SEGADJ ITBBM1,itbbc1
  863. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  864. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  865. IF(IRETOU.NE.0) GOTO 1000
  866. NN=7*N
  867. SEGADJ ITBBE1
  868. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  869. IF(IRETOU.NE.0) GOTO 1000
  870. DO 3003 I=1,N
  871. SEGINI ICHARG
  872. KCHARG(I)=ICHARG
  873. I2=2*I
  874. I3=7*I
  875. if (iform.ne.2) then
  876. WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
  877. WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
  878. WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
  879. WRITE (CHAMOB(I),FMT='(1A4)') ITABM3(I)
  880. WRITE (CHALIE(I),FMT='(1A4)') ITABM4(I)
  881. else
  882. chatyp(1:4)=itabc1(i2-1)
  883. chatyp(5:8)=itabc1(i2)
  884. chanat(i)(1:4)=itabc2(i2-1)
  885. chanat(i)(5:8)=itabc2(i2)
  886. chanom(i)=itabc3(i)
  887. chamob(i)=itabc4(i)
  888. chalie(i)=itabc5(i)
  889. endif
  890. ICHPO1=ITABE1(I3-6)
  891. ICHPO2=ITABE1(I3-5)
  892. ICHPO3=ITABE1(I3-4)
  893. ICHPO4=ITABE1(I3-3)
  894. ICHPO5=ITABE1(I3-2)
  895. ICHPO6=ITABE1(I3-1)
  896. ICHPO7=ITABE1(I3)
  897. if (ionive.le.19) then
  898. ** if (ICHPO4.gt.0) then
  899. if (chamob(i).eq.'TRAN') then
  900. ipt1 = ICHPO4 + nbanc
  901. CALL CRELEM(ipt1)
  902. C*? C On verifie s'il n'a pas deja ete preconditionne.
  903. C*? CALL CRECH1(ipt1,1)
  904. segdes,ipt1
  905. ICHPO4 = ipt1
  906. else if (chamob(i).eq.'ROTA') then
  907. ipt1 = ICHPO4 + nbanc
  908. CALL CRELEM(ipt1)
  909. C*? C On verifie s'il n'a pas deja ete preconditionne.
  910. C*? CALL CRECH1(ipt1,1)
  911. segdes,ipt1
  912. ICHPO4 = ipt1
  913. if (ICHPO5.gt.0) then
  914. ipt1 = ICHPO5 + nbanc
  915. CALL CRELEM(ipt1)
  916. C*? C On verifie s'il n'a pas deja ete preconditionne.
  917. C*? CALL CRECH1(ipt1,1)
  918. segdes,ipt1
  919. ICHPO5 = ipt1
  920. endif
  921. endif
  922. ** endif
  923. endif
  924. SEGDES ICHARG
  925. 3003 CONTINUE
  926. ENDIF
  927. SEGDES MCHARG
  928. ITLAC(**)=MCHARG
  929. 3000 CONTINUE
  930. SEGSUP ITBBM1,itbbc1,ITBBE1,ITBBM2,itbbc3,ITBBM3,itbbc4,
  931. > ITBBM4,itbbc5,ITBBE2,itbbc2
  932. GOTO 1098
  933. C **************************** **************************
  934. 6021 CONTINUE
  935. GOTO 1098
  936. C *****************************MEVOLL***************************
  937. 6022 CONTINUE
  938. NN=0
  939. NM=0
  940. NM2=20
  941. SEGINI ITBBM2,itbbc3
  942. SEGINI ITBBE1,ITBBM1,itbbc1
  943. LDECA=7
  944. IF(NIVEAU.GE.3) LDECA=11
  945. LDECA2=18
  946. DO 3200 IEL=1,IMAX1
  947. ITOTO=1
  948. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  949. IF (IRETOU.NE.0) GO TO 1000
  950. N = ILENA(1)
  951. NM2=20
  952. SEGADJ ITBBM2,itbbc3
  953. SEGINI MEVOLL
  954. if (iform.ne.2) then
  955. CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  956. IF(IRETOU.NE.0) GOTO 1000
  957. WRITE (ITYEVO,FMT='(2A4)') ITABM2(1),ITABM2(2)
  958. WRITE(IEVTEX,FMT='(18A4)') (ITABM2(I+2),I=1,18)
  959. else
  960. ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  961. * write (6,*) ' evol itabc3 ',itabc3(1),itabc3(2)
  962. ityevo(1:4)=itabc3(1)
  963. ityevo(5:8)=itabc3(2)
  964. do jpv=1,18
  965. ievtex(1+4*(jpv-1):4*jpv)=itabc3(jpv+2)
  966. enddo
  967. endif
  968. NN=3*N
  969. SEGADJ ITBBE1
  970. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  971. IF(IRETOU.NE.0) GOTO 1000
  972. NM=LDECA*N
  973. SEGADJ ITBBM1,itbbc1
  974. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  975. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  976. IF(IRETOU.NE.0) GOTO 1000
  977. IF (NIVEAU.LT.3) GO TO 221
  978. NM2=LDECA2*N
  979. SEGADJ ITBBM2,itbbc3
  980. if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
  981. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
  982. IF(IRETOU.NE.0) GOTO 1000
  983. 221 CONTINUE
  984. DO 3201 IN=1,N
  985. SEGINI KEVOLL
  986. IEVOLL(IN)=KEVOLL
  987. I4=3*IN
  988. IPROGX=ITABE1(I4-2)
  989. IPROGY=ITABE1(I4-1)
  990. NUMEVX=ITABE1(I4)
  991. I7=LDECA*(IN-1)
  992. if (iform.ne.2) then
  993. WRITE(NOMEVX,FMT='(3A4)')(ITABM1(I7+I),I=1,3)
  994. WRITE(NOMEVY,FMT='(3A4)')(ITABM1(I7+I+3),I=1,3)
  995. WRITE (NUMEVY,FMT='(A4)') ITABM1(I7+7)
  996. IF(NIVEAU.GE.3) THEN
  997. I8=LDECA2*(IN-1)
  998. WRITE(TYPX,FMT='(2A4)')(ITABM1(I7+7+I),I=1,2)
  999. WRITE(TYPY,FMT='(2A4)')(ITABM1(I7+9+I),I=1,2)
  1000. WRITE(KEVTEX,FMT='(18A4)') (ITABM2(I8+JPV),JPV=1,18)
  1001. ENDIF
  1002. else
  1003. * write (6,*) ' evol itabc1 ',itabc1(i7+1),itabc1(i7+2)
  1004. * write (6,*) ' evol itabc1 ',itabc1(i7+3+1),itabc1(i7+3+2)
  1005. nomevx(1:4)=itabc1(i7+1)
  1006. nomevx(5:8)=itabc1(i7+2)
  1007. nomevx(9:12)=itabc1(i7+3)
  1008. nomevy(1:4)=itabc1(i7+3+1)
  1009. nomevy(5:8)=itabc1(i7+3+2)
  1010. nomevy(9:12)=itabc1(i7+3+3)
  1011. numevy=itabc1(i7+7)
  1012. if (niveau.ge.3) then
  1013. I8=LDECA2*(IN-1)
  1014. typx(1:4)=itabc1(i7+7+1)
  1015. typx(5:8)=itabc1(i7+7+2)
  1016. typy(1:4)=itabc1(i7+9+1)
  1017. typy(5:8)=itabc1(i7+9+2)
  1018. do jpv=1,18
  1019. kevtex(1+(jpv-1)*4:4*jpv)=itabc3(i8+jpv)
  1020. enddo
  1021. endif
  1022. endif
  1023. 3202 CONTINUE
  1024. SEGDES KEVOLL
  1025. 3201 CONTINUE
  1026. SEGDES MEVOLL
  1027. ITLAC(**)=MEVOLL
  1028. 3200 CONTINUE
  1029. SEGSUP ITBBE1,ITBBM1,itbbc1
  1030. SEGSUP ITBBM2,itbbc3
  1031. GOTO 1098
  1032. C
  1033. C **********************SUPERELE************************************
  1034. 6023 CONTINUE
  1035. ITOTO=1
  1036. DO 230 IEL=1,IMAX1
  1037. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1038. IF (IRETOU.NE.0) GO TO 1000
  1039. NTOTO=ILENA(1)
  1040. SEGINI MSUPER
  1041. ITLAC(**)=MSUPER
  1042. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  1043. IF (IRETOU.NE.0) GO TO 1023
  1044. MRIGTO=ILENA(1)
  1045. MSUPEL=ILENA(2)
  1046. MSURAI=ILENA(3)
  1047. MBLOQU=ILENA(4)
  1048. MSUMAS=ILENA(5)
  1049. MCROUT=ILENA(6)
  1050. SEGDES MSUPER
  1051. 230 CONTINUE
  1052. GOTO 1098
  1053. 1023 CONTINUE
  1054. SEGDES MSUPER
  1055. GO TO 1000
  1056. C ************************* LOGIQUE ***************************
  1057. 6024 CONTINUE
  1058. ITOTO=1
  1059. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1060. IF (IRETOU.NE.0) GO TO 1000
  1061. N = ILENA(1)
  1062. M=ITLAC(/1)
  1063. do i=m+1,m+n
  1064. itlac(**)=0
  1065. enddo
  1066. CALL LFCDIE (IORES,N,ITLAC(M+1),IRETOU,IFORM)
  1067. IF(IRETOU.NE.0) GOTO 1000
  1068. DO 242 I=m+1,m+n
  1069. ITOTO=ITLAC(I)
  1070. LOGI=.FALSE.
  1071. IF(ITOTO.EQ.1)LOGI=.TRUE.
  1072. CALL QUERAN (IRAT,'LOGIQUE ',IVB,XVA,CTYPE,LOGI,IOB)
  1073. ITLAC(i) =IRAT
  1074. 242 CONTINUE
  1075. mlnouv=itlac(/1)
  1076. GO TO 1098
  1077. C ******************************FLOTTANT**********************
  1078. 6025 CONTINUE
  1079. ITOTO=1
  1080. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1081. IF (IRETOU.NE.0) GO TO 1000
  1082. N = ILENA(1)
  1083. M=ITLAC(/1)
  1084. L=N
  1085. SEGINI ITBBR1
  1086. CALL LFCDI2(IORES,N,TABR1,IRETOU,IFORM)
  1087. IF(IRETOU.NE.0) GO TO 1000
  1088. DO 250 I=1,N
  1089. XVA=TABR1(I)
  1090. CALL QUERAN(IRAT,'FLOTTANT',IVB,XVA,CTYPE,LOGI,IOB)
  1091. ITLAC(**)=IRAT
  1092. 250 CONTINUE
  1093. SEGSUP ITBBR1
  1094. ITBBR1=0
  1095. mrnouv=itlac(/1)
  1096. GO TO 1098
  1097. C **************************** ENTIER***************************
  1098. 6026 CONTINUE
  1099. ITOTO=1
  1100. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1101. IF (IRETOU.NE.0) GO TO 1000
  1102. N = ILENA(1)
  1103. M=ITLAC(/1)
  1104. L=N
  1105. NN=L
  1106. SEGINI ITBBE1
  1107. CALL LFCDEE(IORES,N,ITABE1,IRETOU,IFORM)
  1108. IF(IRETOU.NE.0) GO TO 1000
  1109. DO 260 I=1,L
  1110. IVB=ITABE1(I)
  1111. itlac(**)=ivb
  1112. 260 CONTINUE
  1113. SEGSUP ITBBE1
  1114. minouv=itlac(/1)
  1115. GOTO 1098
  1116. C **************************** MOT ***************************
  1117. 6027 CONTINUE
  1118. ITOTO=2
  1119. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1120. IF (IRETOU.NE.0) GO TO 1000
  1121. N = ILENA(2)
  1122. NNN=N
  1123. NN=ILENA(1)
  1124. SEGINI ITAMOT
  1125. MM=ITLAC(/1)+1
  1126. DO 271 I=1,N
  1127. ITLAC(**)=0
  1128. 271 CONTINUE
  1129. CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1130. IF(IRETOU.NE.0) GO TO 1000
  1131. CALL LFCDIE(IORES,N,ICOTA,IRETOU,IFORM)
  1132. IF(IRETOU.NE.0) GOTO 1000
  1133. M=1
  1134. DO 270 I=1,N
  1135. LL=ICOTA(I)
  1136. NN=ICOTA(I)-M+1
  1137. IVA=NN
  1138. CHA1(1:NN)=ITAMO(M:LL)
  1139. M=LL+1
  1140. CALL QUERAN(IRAT,'MOT ',IVA,XVA,CHA1(1:NN),LOGI,IOB)
  1141. ITLAC(MM+I-1) =IRAT
  1142. 270 CONTINUE
  1143. SEGSUP ITAMOT
  1144. GOTO 1098
  1145. C ****************************TEXTE *************************
  1146. 6028 CONTINUE
  1147. DO 280 IEL=1,IMAX1
  1148. ITOTO=1
  1149. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1150. IF (IRETOU.NE.0) GO TO 1000
  1151. N = ILENA(1)
  1152. SEGINI MTEXTE
  1153. NCART= N
  1154. CALL LFCDIC(IORES,MTEXT,IRETOU,IFORM)
  1155. SEGDES MTEXTE
  1156. IF(IRETOU.NE.0) GOTO 1000
  1157. ITLAC(**)=MTEXTE
  1158. 280 CONTINUE
  1159. GO TO 1098
  1160. C ******************************MLMOTS****************************
  1161. 6029 CONTINUE
  1162. DO 290 IEL=1,IMAX1
  1163. ITOTO=2
  1164. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1165. IF (IRETOU.NE.0) GO TO 1000
  1166. JGN = ILENA(1)
  1167. JGM = ILENA(2)
  1168. SEGINI MLMOTS
  1169. NN=JGN*JGM
  1170. NNN=0
  1171. SEGINI ITAMOT
  1172. CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
  1173. IF(IRETOU.NE.0) GOTO 1000
  1174. DO 56 IUH = 1,JGM
  1175. MOTS(IUH)= ITAMO((IUH-1)*JGN+1:IUH*JGN)
  1176. 56 CONTINUE
  1177. SEGSUP ITAMOT
  1178. SEGDES MLMOTS
  1179. ITLAC(**)=MLMOTS
  1180. 290 CONTINUE
  1181. GOTO 1098
  1182. C **************************MVECTE**********************************
  1183. 6030 CONTINUE
  1184. DO 300 IOB=1,IMAX1
  1185. IRETOU=0
  1186. CALL LIVECT (MVECTE,IORES,IRETOU,IFORM)
  1187. IF (IRETOU.NE.0) GO TO 1000
  1188. ITLAC(**)=MVECTE
  1189. 300 CONTINUE
  1190. GOTO 1098
  1191. C ************************* VECTD ***************************
  1192. 6031 CONTINUE
  1193. DO 310 IEL=1,IMAX1
  1194. ITOTO=1
  1195. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1196. IF (IRETOU.NE.0) GO TO 1000
  1197. INC = ILENA(1)
  1198. SEGINI MVECTD
  1199. CALL LFCDI2(IORES,N,VECTBB,IRETOU,IFORM)
  1200. SEGDES MVECTD
  1201. IF(IRETOU.NE.0) GOTO 1000
  1202. ITLAC(**)=MVECTD
  1203. 310 CONTINUE
  1204. GOTO 1098
  1205. C **************************** POINTS **************************
  1206. 6032 CONTINUE
  1207. ITOTO=1
  1208. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1209. IF (IRETOU.NE.0) GO TO 1000
  1210. N = ILENA(1)
  1211. M = ITLAC(/1)
  1212. IPLU=N-M
  1213. DO 322 I=1,IPLU
  1214. ITLAC(**)=0
  1215. 322 CONTINUE
  1216. CALL LFCDIE(IORES,N,ITLAC,IRETOU,IFORM)
  1217. IF(IRETOU.NE.0) GOTO 1000
  1218. DO 321 I=1,N
  1219. ITLAC(I)=ITLAC(I)+NBANC
  1220. 321 CONTINUE
  1221. GOTO 1098
  1222. C ****************************CONFIG *************************
  1223. 6033 CONTINUE
  1224. IAV=ITLAC(/1)
  1225. * write(6,*) ' imax1 iav ' , imax1,iav
  1226. iconul=0
  1227. ibon=0
  1228. DO 330 IEL=1,IMAX1
  1229. ITOTO=1
  1230. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1231. * write(6,*) ' lipil iel ilena(1)' , iel , ilena(1)
  1232. IF (IRETOU.NE.0) GO TO 1000
  1233. ILONG=ILENA(1)
  1234. * write(6,*) ' lipil iel ilong' , iel , ilong
  1235. if(ilong.eq.0) then
  1236. iconul=iconul+1
  1237. * nbpts=idim+1
  1238. * segini mcoor1
  1239. * itlac(**)=mcoor1
  1240. go to 330
  1241. endif
  1242. IDRES=IDIM
  1243. IDIM = 0
  1244. * write(6,*) ' iel ilong idres nbanc ', iel,ilong,idres,nbanc
  1245. NBPTS = ILONG+NBANC*(IDRES+1)
  1246. SEGINI MCOOR1
  1247. if(ibon.eq.0) ibon=mcoor1
  1248. IDIM=IDRES
  1249. IDIM11= (IDIM+1)*NBANC+1
  1250. CALL LFCDI2(IORES,ILONG,MCOOR1.XCOOR(IDIM11),IRETOU,IFORM)
  1251. IF(IRETOU.NE.0) GOTO 1000
  1252. DO 332 J=1,NBANC*(IDIM+1)
  1253. MCOOR1.XCOOR(J)=XCOOR(J)
  1254. 332 CONTINUE
  1255. * write(6,*) ' mcoor1' , mcoor1
  1256. SEGDES MCOOR1
  1257. ITLAC(**)=MCOOR1
  1258. 330 CONTINUE
  1259. IF(IONIVE.GT.9) THEN
  1260. if( iconul.ne.imax1) then
  1261. MCOOR1=Ibon
  1262. SEGACT MCOOR1*MOD
  1263. SEGDES MCOORD
  1264. MCOORD=MCOOR1
  1265. * write(6,*) ' mcoord ' , mcoord
  1266. endif
  1267. ENDIF
  1268. GO TO 1098
  1269. C *************************** MLCHPO *************************
  1270. 6034 CONTINUE
  1271. DO 340 IEL=1,IMAX1
  1272. ITOTO=1
  1273. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1274. IF (IRETOU.NE.0) GO TO 1000
  1275. N1 = ILENA(1)
  1276. SEGINI MLCHPO
  1277. ITLAC(**)=MLCHPO
  1278. CALL LFCDIE(IORES,N1,ICHPOI,IRETOU,IFORM)
  1279. SEGDES MLCHPO
  1280. IF(IRETOU.NE.0) GOTO 1000
  1281. 340 CONTINUE
  1282. GOTO 1098
  1283. C ****************************MBASEM*****************************
  1284. 6035 CONTINUE
  1285. NN=0
  1286. DO 3500 IEL=1,IMAX1
  1287. ITOTO=1
  1288. CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1289. IF (IRETOU.NE.0) GO TO 1000
  1290. N=ILENA(1)
  1291. SEGINI MBASEM
  1292. DO 3501 I=1,N
  1293. ITOTO=1
  1294. CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
  1295. IF (IRETOU.NE.0) GO TO 1000
  1296. NIBST=ILENA(1)
  1297. SEGINI MSOBAS
  1298. LISBAS(I)=MSOBAS
  1299. CALL LFCDIE(IORES,NIBST,IBSTRM(1),IRETOU,IFORM)
  1300. IF (IRETOU.NE.0) GO TO 1000
  1301. SEGDES MSOBAS
  1302. 3501 CONTINUE
  1303. SEGDES MBASEM
  1304. ITLAC(**)=MBASEM
  1305. 3500 CONTINUE
  1306. GOTO 1098
  1307. C *************************** PROCED ****************************
  1308. 6036 CONTINUE
  1309. IMAX1=NOBJN
  1310. SEGACT NOMM1,NOMM2
  1311. DO 636 IEL=1,IMAX1
  1312. SEGACT NOMM1,NOMM2
  1313. CHA1(1:8)=NOM2(IEL)
  1314. CHA1(9:16)=' '
  1315. CALL CQUOI(CHA1(1:8),CHA1(9:16),IVAL,XVA,CHARI,LOGI,IOBJ)
  1316. IF(IERR.EQ.0)THEN
  1317. ITLAC(**)= IOBJ
  1318. ELSE
  1319. IRETOU=1
  1320. GO TO 1000
  1321. ENDIF
  1322. 636 CONTINUE
  1323. GOTO 1097
  1324. C *************************** BLOC ****************************
  1325. 6037 CONTINUE
  1326. GOTO 1097
  1327. C *************************** MMODEL ****************************
  1328. 6038 CONTINUE
  1329. CALL LIMODL(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC)
  1330. IF (IRETOU.NE.0) GOTO 1000
  1331. GOTO 1098
  1332. C *************************** MCHAML ****************************
  1333. 6039 CONTINUE
  1334. CALL LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
  1335. IF (IRETOU.NE.0) GOTO 1000
  1336. GOTO 1098
  1337. C *************************** MINTE ****************************
  1338. 6040 CONTINUE
  1339. DO 2840 IEL=1,IMAX1
  1340. ITOTO=2
  1341. CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
  1342. IF (IRETOU.NE.0) GO TO 1000
  1343. NBNO = ILENA(1)
  1344. NBPGAU = ILENA(2)
  1345. L=NBPGAU*4+6*NBPGAU*NBNO
  1346. SEGINI ITBBR1
  1347. CALL LFCDI2 (IORES,L,TABR1,IRETOU,IFORM)
  1348. IF(IRETOU.NE.0) GO TO 1000
  1349. SEGINI MINTE
  1350. I=0
  1351. DO 2841 IC=1,NBPGAU
  1352. I=I+1
  1353. POIGAU(IC)=TABR1(I)
  1354. I=I+1
  1355. QSIGAU(IC)=TABR1(I)
  1356. I=I+1
  1357. ETAGAU(IC)=TABR1(I)
  1358. I=I+1
  1359. DZEGAU(IC)=TABR1(I)
  1360. DO 28411 IB=1,NBNO
  1361. DO 28412 IA=1,6
  1362. I=I+1
  1363. SHPTOT(IA,IB,IC)=TABR1(I)
  1364. 28412 CONTINUE
  1365. 28411 CONTINUE
  1366. 2841 CONTINUE
  1367. SEGSUP ITBBR1
  1368. SEGDES MINTE
  1369. ITLAC(**)=MINTE
  1370. 2840 CONTINUE
  1371. GOTO 1098
  1372. C **************************NUAGE ***************************
  1373. 6041 CALL LINUAG(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1374. IF(IRETOU.NE.0) GO TO 1000
  1375. GOTO 1098
  1376. C ************************* MATRAK ********************************
  1377. 6042 CONTINUE
  1378. CALL LIMTAK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1379. IF (IRETOU.NE.0) GO TO 1000
  1380. GOTO 1098
  1381. C ************************* MATRIK ********************************
  1382. 6043 CONTINUE
  1383. CALL LIMTIK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1384. IF (IRETOU.NE.0) GO TO 1000
  1385. GOTO 1098
  1386. C ************************** METHODE *****************************
  1387. 6045 CONTINUE
  1388. DO 6945 I=1,IMAX1
  1389. ITLAC(**)=0
  1390. 6945 CONTINUE
  1391. CALL LFCDIE(IORES,1,ILENA,IRETOU,IFORM)
  1392. IF (IRETOU.NE.0) GO TO 1000
  1393. CALL LFCDIE(IORES,IMAX1,ITLAC,IRETOU,IFORM)
  1394. IF (IRETOU.NE.0) GO TO 1000
  1395. GOTO 1098
  1396. C ************************* IELVAL ********************************
  1397. 6048 CONTINUE
  1398. CALL LIIELV(IORES,ITLACC,IMAX1,IRETOU,IFORM)
  1399. IF (IRETOU.NE.0) GO TO 1000
  1400. GOTO 1098
  1401. C ******************************************************************
  1402. C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
  1403. C
  1404. 1098 CONTINUE
  1405. C **** KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
  1406. CALL CREOB (ITYPE,NOMM1,NOMM2,ITLACC,mianc,mranc,mlanc)
  1407. IF(IFIN.EQ.1) GOTO 1000
  1408. GOTO 1097
  1409. ********************* ON REBOUCLE EN LECTURE **********************
  1410. 1000 CONTINUE
  1411. 1099 CONTINUE
  1412. 1001 CONTINUE
  1413. IRET=IRETOU
  1414. IF(NOMM1.NE.0) SEGSUP NOMM1
  1415. IF(NOMM2.NE.0) SEGSUP NOMM2
  1416. IF (ITBBM1.NE.0) SEGSUP ITBBM1,itbbc1
  1417. IF (ITBBM2.NE.0) SEGSUP ITBBM2,itbbc3
  1418. IF (ITBBE1.NE.0) SEGSUP ITBBE1
  1419. IF (ITBBE2.NE.0) SEGSUP ITBBE2,itbbc2
  1420. IF (ITBBR1.NE.0) SEGSUP ITBBR1
  1421. SEGDES ICOLAC
  1422. RETURN
  1423. C -------------------------------------------------------
  1424. 8000 FORMAT(16I5)
  1425. 8001 FORMAT(16(1X,A4))
  1426. END
  1427.  
  1428.  
  1429.  
  1430.  
  1431.  
  1432.  
  1433.  
  1434.  
  1435.  
  1436.  
  1437.  
  1438.  
  1439.  
  1440.  
  1441.  
  1442.  
  1443.  
  1444.  
  1445.  
  1446.  
  1447.  

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