Télécharger lirefi.eso

Retour à la liste

Numérotation des lignes :

  1. C LIREFI SOURCE CB215821 16/12/12 21:15:03 9247
  2. C ROUTINE DE RELECTURE D'UN MAILLAGE SAUVE ANTERIEUREMENT
  3. C EVENTUELLEMENT COMMUNICATION AVEC UN AUTRE PROGRAMME
  4. C AUCUN ARGUMENT NE PARAIT NECESSAIRE
  5. C LES OBJETS DEJA EXISTANT AYANT LE MEME NOM SERONT ECRASES
  6. C
  7. SUBROUTINE LIREFI
  8.  
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11.  
  12. -INC CCOPTIO
  13. -INC CCGEOME
  14. -INC SMELEME
  15. -INC SMCOORD
  16.  
  17. CHARACTER*80 TEX
  18. SEGMENT NOMCL
  19. CHARACTER*4 CNOMCL(NBELEM)
  20. ENDSEGMENT
  21. SEGMENT ISGT
  22. INTEGER ISGTR(ILONG)
  23. ENDSEGMENT
  24. SEGMENT CSGT
  25. CHARACTER*8 CSGTR(ILONG)
  26. ENDSEGMENT
  27. SEGMENT JSGTR(ILONG)
  28. SEGMENT ILIST(ILONG)
  29. CHARACTER*8 ITTEMP
  30. CHARACTER*8 ICAR
  31. CHARACTER*4 NOMLU
  32.  
  33. PARAMETER (NTYPRO=8)
  34. CHARACTER*4 MOPROG(NTYPRO)
  35. INTEGER ITYPRO
  36.  
  37. DATA MOPROG / 'AVS ','MED ','UNV ', 'FEM ', 'PROC','CSV ','NAS ',
  38. & 'STL '/
  39.  
  40. ITYPRO=0
  41.  
  42. C Recherche du mot signifiant le type de la lecture
  43. CALL LIRMOT(MOPROG,NTYPRO,ITYPRO,0)
  44.  
  45. C Redirection directe vers le bon type de fichier
  46. GOTO(7001,7002,7003,7004,7005,7006,7007,7008),ITYPRO
  47. C Si ITYPRO=0 on va en 999
  48. GOTO 999
  49.  
  50. C Lecture du fichier AVS (UCD ASCII) ...
  51. 7001 CONTINUE
  52. CDEBUG WRITE(IOIMP,3001)
  53. CDEBUG 3001 FORMAT('Lecture du fichier AVS')
  54. CALL LIRAVS
  55. RETURN
  56.  
  57. C Lecture du fichier MED ...
  58. 7002 CONTINUE
  59. CALL LIRMED
  60. RETURN
  61.  
  62. C Lecture du fichier UNV I-DEAS(R) ...
  63. 7003 CONTINUE
  64. CDEBUG WRITE(IOIMP,3003)
  65. CDEBUG 3003 FORMAT('Lecture du fichier UNV')
  66. CALL LIRUNV
  67. RETURN
  68.  
  69. C Lecture du fichier FEM
  70. 7004 CONTINUE
  71. CDEBUG WRITE(IOIMP,3004)
  72. CDEBUG 3004 FORMAT('Lecture du fichier FEM')
  73. CALL LIRFEM
  74. RETURN
  75.  
  76. C Lecture d'un fichier PROCEDUR
  77. 7005 CONTINUE
  78. CDEBUG WRITE(IOIMP,3005)
  79. CDEBUG 3005 FORMAT('Lecture du fichier PROC')
  80. CALL LIPROC
  81. RETURN
  82.  
  83. C Lecture d'un fichier CSV
  84. 7006 CONTINUE
  85. CDEBUG WRITE(IOIMP,3006)
  86. CDEBUG 3006 FORMAT('Lecture du fichier CSV')
  87. CALL LIRCSV
  88. RETURN
  89.  
  90. C Lecture d'un fichier NAS
  91. 7007 CONTINUE
  92. CDEBUG WRITE(IOIMP,3007)
  93. CDEBUG 3007 FORMAT('Lecture du fichier NAS')
  94. CALL LIRNAS
  95. RETURN
  96.  
  97. C Lecture d'un fichier STL
  98. 7008 CONTINUE
  99. CDEBUG WRITE(IOIMP,3008)
  100. CDEBUG 3008 FORMAT('Lecture du fichier STL')
  101. CALL LIRSTL
  102. RETURN
  103.  
  104.  
  105. 999 CONTINUE
  106.  
  107.  
  108.  
  109.  
  110. CMB ... Ici commence l'ancienne lecture (Castem) ...
  111.  
  112. CALL QUETYP(ICAR,0,IRET1)
  113. IF (IERR.NE.0) RETURN
  114. IF(IRET1.NE.0) THEN
  115. CALL LIROBJ(ICAR,IPROUT,1,IRETOU)
  116. IF (IERR.NE.0) RETURN
  117. ENDIF
  118. *
  119. READ (IOCAR,100,END=1000,ERR=1000) TEX
  120. 100 FORMAT (A80)
  121. *
  122. IF(IRET1.NE.0) THEN
  123. CALL QUENOM(ICAR)
  124. MOTERR(1:8)=ICAR
  125. IF (TEX(1:8).NE.ICAR) CALL ERREUR(9)
  126. IF (IERR.NE.0) RETURN
  127. ENDIF
  128. *
  129. TITREE=TEX(1:72)
  130. IF (IIMPI.NE.0) WRITE(IOIMP,200) TEX(1:72)
  131. 200 FORMAT (1X,A72)
  132.  
  133. READ (IOCAR,101,END=1000,ERR=1000) IONIVE
  134. 101 FORMAT(34X,I3)
  135.  
  136. IF (IONIVE.GT.2) GOTO 1000
  137.  
  138. CALL NOMENT('&NIVE',IONIVE)
  139. READ(IOCAR,102,END=1000,ERR=1000) IaRR,JDIM,DENSIT
  140. 102 FORMAT(6X,I4,10X,I4,9X,E12.5)
  141.  
  142. IF (IIMPI.NE.0) WRITE (IOIMP,201) IaRR,JDIM,DENSIT
  143. 201 FORMAT (1X,'ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',1PE12.5)
  144.  
  145. IERMAX=MAX(IERMAX,IaRR)
  146. * IERR=0
  147. CALL GINT2
  148. IF (IDIM.EQ.0) IDIM=JDIM
  149. IF (JDIM.NE.IDIM) CALL ERREUR(12)
  150. CALL NOMENT('&DIME',IDIM)
  151.  
  152. READ (IOCAR,103,END=1000,ERR=1000) INOMB
  153. 103 FORMAT(17X,I8)
  154. IF (IIMPI.NE.0) WRITE (IOIMP,202) INOMB
  155. 202 FORMAT(' NOMBRE DE POINTS A LIRE ',I8)
  156.  
  157. SEGACT MCOORD
  158. NBANC=XCOOR(/1)/(IDIM+1)
  159. NBNOUV=NBANC+INOMB
  160. NBPTS=NBNOUV
  161. SEGADJ MCOORD
  162. NDEBB=NBANC+1
  163. NBC=IDIM+1
  164. READ (IOCAR,104,ERR=1000,END=1000) ((XCOOR((J-1)*(IDIM+1)+I),I=1,
  165. # NBC),J=NDEBB,NBNOUV)
  166. 104 FORMAT (6E12.5)
  167.  
  168. C LECTURE DES POINTS NOMMES
  169. READ (IOCAR,105,END=1000,ERR=1000) ILONG
  170. 105 FORMAT(23X,I8)
  171. IF (ILONG.NE.0) THEN
  172. SEGINI ISGT,CSGT
  173. READ (IOCAR,106,END=1000,ERR=1000)(CSGTR(I),ISGTR(I),I=1,ILONG)
  174. 106 FORMAT(5(A8,I8))
  175. IF (IIMPI.NE.0) WRITE (IOIMP,203)(CSGTR(I),ISGTR(I),I=1,ILONG)
  176. 203 FORMAT(' LISTE DES POINTS NOMMES',/,5(1X,A8,I8))
  177. DO 5 I=1,ILONG
  178. ITTEMP=CSGTR(I)
  179. ITVAL=ISGTR(I)+NBANC
  180. CALL NOMOBJ('POINT',ITTEMP,ITVAL)
  181. 5 CONTINUE
  182. SEGSUP ISGT,CSGT
  183. ENDIF
  184.  
  185. C LECTURE DES OBJETS
  186. READ (IOCAR,116,END=1000,ERR=1000) ILONG
  187. 116 FORMAT (16X,I8)
  188.  
  189. IF (IIMPI.NE.0) WRITE (IOIMP,204) ILONG
  190. 204 FORMAT (' NOMBRE D''OBJETS',I8)
  191.  
  192. SEGINI JSGTR
  193. DO 7 IOB=1,ILONG
  194. IF (IONIVE.LE.1) THEN
  195. READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  196. + NBNN,NBELEM
  197. 107 FORMAT(A4,12X,I4,11X,I4,10X,I4,8X,I4)
  198. ELSE
  199. READ (IOCAR,1107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  200. + NBNN,NBELEM
  201. 1107 FORMAT(A4,12X,I4,11X,I4,10X,I4,7X,I5)
  202. ENDIF
  203. IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM
  204. 205 FORMAT(' NOMLU ',A4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM
  205. # ',I4)
  206.  
  207. SEGINI MELEME
  208. JSGTR(IOB)=MELEME
  209. IF (NBSOUS.NE.0)
  210. + READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS)
  211. 108 FORMAT(20I4)
  212.  
  213. IF (NBREF.NE.0)
  214. + READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF)
  215.  
  216. IF (NBELEM.EQ.0) GOTO 7
  217.  
  218. C ... EST CE UN TYPE D'ELEM CONNU
  219. DO 10 I=1,NOMBR
  220. IF (NOMLU.EQ.NOMS(I)) GOTO 11
  221. 10 CONTINUE
  222. SEGSUP MELEME,JSGTR
  223. RETURN
  224. 11 ITYPEL=I
  225. IF( IONIVE .EQ. 0 ) THEN
  226. DO 1800 I = 1,NBELEM
  227. ICOLOR(I)=IDCOUL
  228. 1800 CONTINUE
  229. ELSE
  230. SEGINI NOMCL
  231. READ (IOCAR,112,END=1000,ERR=1000)(CNOMCL(I),I=1,NBELEM)
  232. 112 FORMAT (16(1X,A4))
  233. DO 18 I=1,NBELEM
  234. IREP=IDCOUL
  235. DO 19 J=0,NBCOUL
  236. IF (CNOMCL(I).EQ.NCOUL(J)) IREP=J
  237. 19 CONTINUE
  238. ICOLOR(I)=IREP
  239. 18 CONTINUE
  240. SEGSUP NOMCL
  241. ENDIF
  242. READ (IOCAR,111,END=1000,ERR=1000)((NUM(I,J),I=1,NBNN),
  243. + J=1,NBELEM)
  244. 111 FORMAT (16I5)
  245. 7 CONTINUE
  246.  
  247. DO 12 I=1,ILONG
  248. MELEME=JSGTR(I)
  249. IF (LISOUS(/1).NE.0) THEN
  250. DO 14 J=1,LISOUS(/1)
  251. LISOUS(J)=JSGTR(LISOUS(J))
  252. 14 CONTINUE
  253. ENDIF
  254. IF (LISREF(/1).NE.0) THEN
  255. DO 16 J=1,LISREF(/1)
  256. LISREF(J)=JSGTR(LISREF(J))
  257. 16 CONTINUE
  258. ENDIF
  259. DO 17 IK=1,NUM(/1)
  260. DO 17 JK=1,NUM(/2)
  261. NUM(IK,JK)=NUM(IK,JK)+NBANC
  262. 17 CONTINUE
  263. SEGDES MELEME
  264. 12 CONTINUE
  265.  
  266. READ (IOCAR,109,ERR=1000,END=1000) INN
  267. 109 FORMAT(22X,I8)
  268.  
  269. ILONG=3*INN
  270. SEGINI ILIST
  271. READ (IOCAR,110,END=1000,ERR=1000)(ILIST(I),I=1,ILONG)
  272. 110 FORMAT(5(2A4,I8))
  273.  
  274. IF (IIMPI.NE.0) WRITE (IOIMP,206) (ILIST(I),I=1,ILONG)
  275. 206 FORMAT (' LISTE DES OBJETS NOMMES',/,5(1X,2A4,I8))
  276.  
  277. DO 25 I=1,ILONG,3
  278. WRITE(ITTEMP,FMT='(2A4)')ILIST(I),ILIST(I+1)
  279. ITVAL=JSGTR(ILIST(I+2))
  280. CALL NOMOBJ('MAILLAGE',ITTEMP,ITVAL)
  281. 25 CONTINUE
  282. SEGSUP JSGTR,ILIST
  283. C
  284. C **** LECTURE DU FICHIER TTMF
  285. C
  286. READ(IOCAR,1002,END=1001) IQUOI
  287. 1002 FORMAT(7X,I5)
  288.  
  289. CALL RESTSO(IQUOI,NBANC)
  290. 1001 CONTINUE
  291. RETURN
  292.  
  293. 1000 CONTINUE
  294. CALL ERREUR(26)
  295. RETURN
  296. END
  297.  
  298.  

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