Télécharger lirefi.eso

Retour à la liste

Numérotation des lignes :

  1. C LIREFI SOURCE JC220346 18/12/04 21:15:40 9991
  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. IF (IIMPI.NE.0) WRITE(IOIMP,*) 'NIVEAU ',IONIVE
  136. IF (IONIVE.GT.2) GOTO 1000
  137. CALL NOMENT('&NIVE',IONIVE)
  138.  
  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. IERMAX=MAX(IERMAX,IaRR)
  145. * IERR=0
  146. CALL GINT2
  147. IF (IDIM.EQ.0) IDIM=JDIM
  148. IF (JDIM.NE.IDIM) CALL ERREUR(12)
  149. CALL NOMENT('&DIME',IDIM)
  150.  
  151. READ (IOCAR,103,END=1000,ERR=1000) INOMB
  152. 103 FORMAT(17X,I8)
  153. IF (IIMPI.NE.0) WRITE (IOIMP,202) INOMB
  154. 202 FORMAT(' NOMBRE DE POINTS A LIRE ',I8)
  155. SEGACT MCOORD
  156. NBANC=XCOOR(/1)/(IDIM+1)
  157. NBNOUV=NBANC+INOMB
  158. NBPTS=NBNOUV
  159. SEGADJ MCOORD
  160. NDEBB=NBANC+1
  161. NBC=IDIM+1
  162. READ (IOCAR,104,ERR=1000,END=1000) ((XCOOR((J-1)*(IDIM+1)+I),I=1,
  163. # NBC),J=NDEBB,NBNOUV)
  164. 104 FORMAT (6E12.5)
  165.  
  166. C LECTURE DES POINTS NOMMES
  167. READ (IOCAR,105,END=1000,ERR=1000) ILONG
  168. 105 FORMAT(23X,I8)
  169. IF (ILONG.NE.0) THEN
  170. SEGINI ISGT,CSGT
  171. READ (IOCAR,106,END=1000,ERR=1000)(CSGTR(I),ISGTR(I),I=1,ILONG)
  172. 106 FORMAT(5(A8,I8))
  173. IF (IIMPI.NE.0) WRITE (IOIMP,203)(CSGTR(I),ISGTR(I),I=1,ILONG)
  174. 203 FORMAT(' LISTE DES POINTS NOMMES',/,5(1X,A8,I8))
  175. DO 5 I=1,ILONG
  176. ITTEMP=CSGTR(I)
  177. ITVAL=ISGTR(I)+NBANC
  178. CALL NOMOBJ('POINT',ITTEMP,ITVAL)
  179. 5 CONTINUE
  180. SEGSUP ISGT,CSGT
  181. ENDIF
  182.  
  183. C LECTURE DES OBJETS
  184. READ (IOCAR,116,END=1000,ERR=1000) ILONG
  185. 116 FORMAT (16X,I8)
  186.  
  187. IF (IIMPI.NE.0) WRITE (IOIMP,204) ILONG
  188. 204 FORMAT (' NOMBRE D''OBJETS',I8)
  189.  
  190. SEGINI JSGTR
  191. DO 7 IOB=1,ILONG
  192. IF (IONIVE.LE.1) THEN
  193. READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  194. + NBNN,NBELEM
  195. 107 FORMAT(A4,12X,I4,11X,I4,10X,I4,8X,I4)
  196. ELSE
  197. READ (IOCAR,1107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  198. + NBNN,NBELEM
  199. 1107 FORMAT(A4,12X,I4,11X,I4,10X,I4,7X,I5)
  200. ENDIF
  201. IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM
  202. 205 FORMAT(' NOMLU ',A4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM
  203. # ',I4)
  204.  
  205. SEGINI MELEME
  206. JSGTR(IOB)=MELEME
  207. IF (NBSOUS.NE.0)
  208. + READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS)
  209. 108 FORMAT(20I4)
  210.  
  211. IF (NBREF.NE.0)
  212. + READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF)
  213.  
  214. IF (NBELEM.EQ.0) GOTO 7
  215.  
  216. C ... EST CE UN TYPE D'ELEM CONNU
  217. DO 10 I=1,NOMBR
  218. IF (NOMLU.EQ.NOMS(I)) GOTO 11
  219. 10 CONTINUE
  220. SEGSUP MELEME,JSGTR
  221. RETURN
  222. 11 ITYPEL=I
  223. IF( IONIVE .EQ. 0 ) THEN
  224. DO 1800 I = 1,NBELEM
  225. ICOLOR(I)=IDCOUL
  226. 1800 CONTINUE
  227. ELSE
  228. SEGINI NOMCL
  229. READ (IOCAR,112,END=1000,ERR=1000)(CNOMCL(I),I=1,NBELEM)
  230. 112 FORMAT (16(1X,A4))
  231. DO 18 I=1,NBELEM
  232. IREP=IDCOUL
  233. DO 19 J=0,NBCOUL
  234. IF (CNOMCL(I).EQ.NCOUL(J)) IREP=J
  235. 19 CONTINUE
  236. ICOLOR(I)=IREP
  237. 18 CONTINUE
  238. SEGSUP NOMCL
  239. ENDIF
  240. READ (IOCAR,111,END=1000,ERR=1000)((NUM(I,J),I=1,NBNN),
  241. + J=1,NBELEM)
  242. 111 FORMAT (16I5)
  243. 7 CONTINUE
  244.  
  245. DO 12 I=1,ILONG
  246. MELEME=JSGTR(I)
  247. IF (LISOUS(/1).NE.0) THEN
  248. DO 14 J=1,LISOUS(/1)
  249. LISOUS(J)=JSGTR(LISOUS(J))
  250. 14 CONTINUE
  251. ENDIF
  252. IF (LISREF(/1).NE.0) THEN
  253. DO 16 J=1,LISREF(/1)
  254. LISREF(J)=JSGTR(LISREF(J))
  255. 16 CONTINUE
  256. ENDIF
  257. DO 17 IK=1,NUM(/1)
  258. DO 17 JK=1,NUM(/2)
  259. NUM(IK,JK)=NUM(IK,JK)+NBANC
  260. 17 CONTINUE
  261. SEGDES MELEME
  262. 12 CONTINUE
  263.  
  264. READ (IOCAR,109,ERR=1000,END=1000) INN
  265. 109 FORMAT(22X,I8)
  266.  
  267. ILONG=3*INN
  268. SEGINI ILIST
  269. READ (IOCAR,110,END=1000,ERR=1000)(ILIST(I),I=1,ILONG)
  270. 110 FORMAT(5(2A4,I8))
  271.  
  272. IF (IIMPI.NE.0) WRITE (IOIMP,206) (ILIST(I),I=1,ILONG)
  273. 206 FORMAT (' LISTE DES OBJETS NOMMES',/,5(1X,2A4,I8))
  274.  
  275. DO 25 I=1,ILONG,3
  276. WRITE(ITTEMP,FMT='(2A4)')ILIST(I),ILIST(I+1)
  277. ITVAL=JSGTR(ILIST(I+2))
  278. CALL NOMOBJ('MAILLAGE',ITTEMP,ITVAL)
  279. 25 CONTINUE
  280. SEGSUP JSGTR,ILIST
  281. C
  282. C **** LECTURE DU FICHIER TTMF
  283. C
  284. READ(IOCAR,1002,END=1001) IQUOI
  285. 1002 FORMAT(7X,I5)
  286.  
  287. CALL RESTSO(IQUOI,NBANC)
  288. 1001 CONTINUE
  289. RETURN
  290.  
  291. 1000 CONTINUE
  292. CALL ERREUR(26)
  293. RETURN
  294. END
  295.  
  296.  
  297.  

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