Télécharger restso.eso

Retour à la liste

Numérotation des lignes :

  1. C RESTSO SOURCE PV 16/11/26 21:16:27 9205
  2. SUBROUTINE RESTSO(IQUOI,NBANC)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C APPELE PAR L'OPERATEUR SORTIR:LECTURE DU FICHIER TTMF
  7. C LIREFI LIT LE FICHIER SORTIR, RESTSO LIT DES PILES (COMME RESTITUER)
  8. C
  9. C APPELLE : ERREUR(12) LFCDIM LFCDIE LFCDIR SORT5 ENTNOF
  10. C ECRIT PAR FARVACQUE
  11. C
  12. C=======================================================================
  13. -INC CCOPTIO
  14. -INC CCGEOME
  15. -INC SMELEME
  16. -INC SMCHPOI
  17. SEGMENT ILIST(ILL)
  18. SEGMENT ISORTA(0)
  19. -INC TMCOLAC
  20. SEGMENT/ITBBE1/( ITABE1(NN))
  21. SEGMENT/ITBBE2/( ITABE2(NN))
  22. SEGMENT/ITBBM1/( ITABM1(NM))
  23. SEGMENT/NOMM1/(NOM1(NOBJN1))
  24. SEGMENT/NOMM2/(NOM2(NOBJN2))
  25. C
  26. CHARACTER*(8) ITYPE
  27. CHARACTER*(8) NOMM
  28. CHARACTER*(72) CK
  29. REAL*8 XK
  30. LOGICAL BK
  31. C
  32. C
  33. C
  34. ITOTO=1
  35. IRETOU=0
  36. NOBJN1=0
  37. NOBJN2=0
  38. SEGINI NOMM1,NOMM2
  39. NITLAC=20
  40. SEGINI ICOLAC
  41. DO 1 IFILE=1,NITLAC
  42. SEGINI ITLACC
  43. KCOLA(IFILE)=ITLACC
  44. C KCOLAC(IFILE)=0
  45. 1 CONTINUE
  46. GOTO 1096
  47. C
  48. 1097 CONTINUE
  49. READ(IOCAR,74,END=1000,ERR=1000) IQUOI
  50. 74 FORMAT(7X,I5)
  51. C
  52. 1096 CONTINUE
  53. IF(IQUOI.EQ.5) GOTO 1000
  54. C *** FIN DES LECTURES ***********
  55. C
  56. C
  57. C
  58. C ***** LECTURE D'UN TITRE
  59. C
  60. C IF(IQUOI.NE.3) GOTO 5000
  61. C CALL LFCDIM(IOCAR,18,TITREE,IRETOU)
  62. C IF(IRETOU.NE.0) GOTO 1000
  63. C GOTO 1097
  64. C
  65. C ***** LECTURE D'UNE PILE
  66. C5000 CONTINUE
  67. IF(IQUOI.NE.2) GOTO 1000
  68. READ(IOCAR,75,END=1000,ERR=1000) IFILE,NOBJN,IMAX1
  69. 75 FORMAT(7X,I5,15X,I5,17X,I5)
  70. ITYPE=' '
  71. CALL TYPFIL(ITYPE,IFILE)
  72. WRITE(IOIMP,703)IFILE,ITYPE,IMAX1,NOBJN
  73. 703 FORMAT(///' * LA FILE NUMERO',I4,' CONSTITUEE D''OBJETS DE TYPE
  74. 1 ',A8,' CONTIENT',I5,
  75. 1 ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.')
  76. C
  77. IF(NOBJN.NE.0) CALL ENTNOF(IOCAR,NOBJN,NOMM1,NOMM2,IRETOU)
  78. IF(IRETOU.NE.0) GOTO 1000
  79. ITLACC=KCOLA(IFILE)
  80. GO TO (6001,6002),IFILE
  81. C **************************MELEME**********************************
  82. 6001 CONTINUE
  83. C LECTURE DES OBJETS
  84. DO 7 IOB=1,IMAX1
  85. READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,NBNN,NBELEM
  86. 107 FORMAT(I4,12X,I4,11X,I4,10X,I4,8X,I4)
  87. IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM
  88. 205 FORMAT(' ITYPEL',I4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM
  89. # ',I4)
  90. SEGINI MELEME
  91. ITLAC(**)=MELEME
  92. IF (NBSOUS.EQ.0) GOTO 8
  93. READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS)
  94. 108 FORMAT(20I4)
  95. 8 IF (NBREF.EQ.0) GOTO 9
  96. READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF)
  97. 9 CONTINUE
  98. IF (NBELEM.EQ.0) GOTO 7
  99. C EST CE UN TYPE D'ELEM CONNU
  100. C DO 10 I=1,NOMBR
  101. C IF (NOMLU.EQ.NOMS(I)) GOTO 11
  102. C 10 CONTINUE
  103. C MCOT(1)=NOMLU
  104. C WRITE (MOT(1:4),FMT='(A4)') MCOT
  105. C SEGSUP MELEME,ISGTR
  106. C RETURN
  107. C 11 ITYPEL=I
  108. ITYPEL=NOMLU
  109. C IF( IONIVE .EQ. 0 ) THEN
  110. DO 1800 I = 1,NBELEM
  111. 1800 ICOLOR(I)=IDCOUL
  112. C ELSE
  113. C SEGINI NOMCL
  114. C READ (IOCAR,112,END=1000,ERR=1000)(NOMCL(I),I=1,NBELEM)
  115. 112 FORMAT (16(1X,A4))
  116. C DO 18 I=1,NBELEM
  117. C IREP=0
  118. C DO 19 J=1,NBCOUL
  119. C 19 IF (NOMCL(I).EQ.NCOUL(J)) IREP=J
  120. C IF (IREP.EQ.0) THEN
  121. C MCOT(1)=NOMCL(I)
  122. C WRITE (MOT(1:4),FMT='(A4)') MCOT
  123. C SEGSUP MELEME,ISGTR,NOMCL
  124. C RETURN
  125. C ELSE
  126. C ICOLOR(I)=IREP
  127. C ENDIF
  128. C18 CONTINUE
  129. C SEGSUP NOMCL
  130. C ENDIF
  131. L=NBELEM*NBNN
  132. CALL LFCDIE(IOCAR,L,NUM,IRETOU,ITOTO)
  133. DO 17 IK=1,NBNN
  134. DO 17 JK=1,NBELEM
  135. NUM(IK,JK)=NUM(IK,JK)+NBANC
  136. 17 CONTINUE
  137. SEGDES MELEME
  138. 7 CONTINUE
  139. GOTO 1098
  140. C **************************CHPOINT*********************************
  141. 6002 CONTINUE
  142. NN=0
  143. NM=0
  144. SEGINI ITBBE1
  145. SEGINI ITBBM1
  146. DO 1101 IEL=1,IMAX1
  147. READ (IOCAR,1199,END=1000,ERR=1000)NSOUPO,NM
  148. 1199 FORMAT(8X,I5,4X,I5)
  149. NAT=1
  150. SEGINI MCHPOI
  151. ITLAC(**)=MCHPOI
  152. NN=3*NSOUPO
  153. SEGADJ ITBBE1
  154. SEGADJ ITBBM1
  155. CALL LFCDIE(IOCAR,NN,ITABE1,IRETOU,ITOTO)
  156. IF(IRETOU.NE.0) GOTO 1000
  157. CALL LFCDIM(IOCAR,NM,ITABM1,IRETOU,ITOTO)
  158. IF(IRETOU.NE.0) GOTO 1000
  159. READ(IOCAR,113,END=1000,ERR=1000) MTYPOI,MOCHDE
  160. 113 FORMAT (A8,A72)
  161. ICC=0
  162. DO 1103 ISOU=1,NSOUPO
  163. NC=ITABE1(3*ISOU)
  164. SEGINI MSOUPO
  165. IPCHP(ISOU)=MSOUPO
  166. IGEOC=ITABE1(3*ISOU -2)
  167. N=ITABE1(3*ISOU -1)
  168. DO 1102 IC=1,NC
  169. ICC=ICC+1
  170. WRITE (NOCOMP(IC),FMT='(A4)') ITABM1(ICC)
  171. 1102 CONTINUE
  172. SEGINI MPOVAL
  173. IPOVAL=MPOVAL
  174. LMAX=N*NC
  175. CALL LFCDIR(IOCAR,LMAX,VPOCHA,IRETOU)
  176. 104 FORMAT(E22.15)
  177. IF(IRETOU.NE.0) GOTO 1000
  178. SEGDES MPOVAL,MSOUPO
  179. 1103 CONTINUE
  180. SEGDES MCHPOI
  181. 1101 CONTINUE
  182. SEGSUP ITBBE1,ITBBM1
  183. GOTO 1098
  184. C
  185. C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
  186. C
  187. 1098 CONTINUE
  188. C KCOLAC(IFILE)=KCOLAC(IFILE)+IMAX1
  189. IF(NOBJN.EQ.0) GOTO 1095
  190. DO 1094 I=1,NOBJN
  191. J=NOM1(I)
  192. IF(J.GT.ITLAC(/1)) THEN
  193. WRITE(IOIMP,708) ITYPE,NOM2(2*I-1),NOM2(2*I)
  194. ELSE
  195. K=ITLAC(J)
  196. WRITE(IOIMP,701)ITYPE,NOM2(2*I-1),NOM2(2*I),K
  197. WRITE(NOMM,FMT='(2A4)') NOM2(2*I-1),NOM2(2*I)
  198. IF(ITYPE.EQ.'ENTIER '.OR.ITYPE.EQ.'FLOTTANT'.OR.ITYPE.EQ.
  199. $ 'LOGIQUE '.OR.ITYPE.EQ.'MOT ')
  200. $ CALL QUEVAL(K,ITYPE,IERT,IK,XK,CK,BK,IOK)
  201. IF(IERT.EQ.1 ) THEN
  202. CALL ERREUR(5)
  203. RETURN
  204. ENDIF
  205. IF(ITYPE.EQ.'ENTIER ') THEN
  206. CALL NOMENT(NOMM,IK)
  207. ELSEIF(ITYPE.EQ.'FLOTTANT') THEN
  208. CALL NOMREE(NOMM,XK)
  209. ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  210. CALL NOMLOG(NOMM,BK)
  211. ELSEIF(ITYPE.EQ.'MOT ') THEN
  212. CALL NOMCHA(NOMM,CK)
  213. ELSE
  214. CALL NOMOBJ(ITYPE,NOMM,K)
  215. ENDIF
  216. ENDIF
  217. 1094 CONTINUE
  218. 701 FORMAT(2X,A8,2X,2A4,2X,I5)
  219. 708 FORMAT(2X,A8,' * ATTENTION ERREUR SUR L''OBJET ',2A4)
  220. 1095 CONTINUE
  221. GOTO 1097
  222. 1000 CONTINUE
  223. C
  224. SEGDES ICOLAC
  225. CALL SORT5(ICOLAC)
  226. SEGACT ICOLAC
  227. DO 1001 I=1,NITLAC
  228. ITLACC=KCOLA(I)
  229. SEGSUP ITLACC
  230. 1001 CONTINUE
  231. SEGSUP ICOLAC
  232. RETURN
  233. END
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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