Télécharger licham.eso

Retour à la liste

Numérotation des lignes :

  1. C LICHAM SOURCE PV 09/03/12 21:27:28 6325
  2. SUBROUTINE LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * LECTURE D'UN NOUVEAU CHAMELEM SUR LE FICHIER IORES. *
  8. * *
  9. * Param}tres: *
  10. * *
  11. * IORES NUM{RO DU FICHIER DE LECTURE *
  12. * ITLACC Pile contenant les nouveaux CHAMELEMs *
  13. * IMAX1 Nombre de CHAMELEMs dans la pile *
  14. * IFORM Si sauvegarde en format ou non *
  15. * *
  16. * APPEL{ PAR: LIPIL *
  17. * *
  18. * Auteur, date de cr{ation: *
  19. * *
  20. * Denis ROBERT-MOUGIN, le 29 juin 1989. *
  21. * *
  22. *--------------------------------------------------------------------*
  23. -INC SMCHAML
  24. -INC CCFXDR
  25. *
  26. SEGMENT,ITLACC
  27. INTEGER ITLAC(0)
  28. ENDSEGMENT
  29. SEGMENT,MTABE1
  30. INTEGER ITABE1(NM1)
  31. ENDSEGMENT
  32. SEGMENT,MTABE2
  33. INTEGER ITABE2(NM2)
  34. ENDSEGMENT
  35. SEGMENT,MTABE4
  36. CHARACTER*(8) ITABE4(NM4)
  37. ENDSEGMENT
  38. SEGMENT,MTABE5
  39. CHARACTER*(8) ITABE5(NM5)
  40. ENDSEGMENT
  41. SEGMENT,MTABE6
  42. CHARACTER*(8) ITABE6(NM6)
  43. ENDSEGMENT
  44. *
  45. INTEGER IDAN(4)
  46. IRETOU=0
  47. NM5=0
  48. *
  49. * Boucle sur les CHAMELEMs contenus dans la pile:
  50. *
  51. DO 10 IEL=1,IMAX1
  52. *
  53. MCHELM = 0
  54. *
  55. * CREATION ET REMPLISSAGE DU SEGMENT MCHELM
  56. *
  57. CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
  58. IF(IRETOU.NE.0) RETURN
  59. *
  60. N1 = IDAN(1)
  61. N3 = IDAN(3)
  62. L1 = IDAN(4)
  63. SEGINI MCHELM
  64. IFOCHE = IDAN(2)
  65. CALL LFCDIC(IORES,TITCHE,IRETOU,IFORM)
  66. IF(IRETOU.NE.0) RETURN
  67. *
  68. N6 = N3 + 3
  69. NM1 = N1 * N6
  70. SEGINI,MTABE1
  71. CALL LFCDIE(IORES,NM1,ITABE1,IRETOU,IFORM)
  72. IF(IRETOU.NE.0) RETURN
  73. IF(NIVEAU.GE.4) THEN
  74. NM5 = N1 * 2
  75. SEGINI,MTABE5
  76. CALL LFCDIN(IORES,NM5,ITABE5,IRETOU,IFORM)
  77. IF(IRETOU.NE.0) RETURN
  78. ENDIF
  79. if(niveau.ge.15) then
  80. nm6=n1
  81. segini mtabe6
  82. CALL LFCDIN(IORES,NM6,ITABE6,IRETOU,IFORM)
  83. endif
  84. *
  85. DO 21 ISOUEL=1,N1
  86. ISOU = N6 * (ISOUEL - 1)
  87. IMACHE(ISOUEL) = ITABE1(ISOU+1)
  88. N2 = ITABE1(ISOU+3)
  89. SEGINI MCHAML
  90. ICHAML(ISOUEL)=MCHAML
  91. DO 12 IJ=1,N3
  92. 12 INFCHE(ISOUEL,IJ) = ITABE1(ISOU+3+IJ)
  93. IF(NIVEAU.GE.4) THEN
  94. CONCHE(ISOUEL)(1:8) = ITABE5(2*ISOUEL-1)
  95. CONCHE(ISOUEL)(9:16)= ITABE5(2*ISOUEL )
  96. ELSE
  97. CONCHE(ISOUEL) = ' '
  98. ENDIF
  99. if(niveau.ge.15) then
  100. conche(isouel)(17:24) =itabe6(isouel)
  101. else
  102. conche(isouel)(17:24) =' '
  103. endif
  104. 21 CONTINUE
  105. SEGSUP MTABE1
  106. IF(NIVEAU.GE.4) SEGSUP MTABE5
  107. if(niveau.ge.15) segsup mtabe6
  108. *
  109. * BOUCLES SUR LES ZONES {L{MENTAIRES DU CHAMELEM :
  110. *
  111. DO 22 ISOUEL=1,N1
  112. MCHAML = ICHAML(ISOUEL)
  113. N2 = NOMCHE(/2)
  114. NM2=N2
  115. NM4=N2*2
  116. SEGINI MTABE2,MTABE4
  117. CALL LFCDIE(IORES,NM2,ITABE2,IRETOU,IFORM)
  118. IF(IRETOU.NE.0) RETURN
  119. CALL LFCDIN(IORES,NM2,NOMCHE,IRETOU,IFORM)
  120. IF(IRETOU.NE.0) RETURN
  121. CALL LFCDIN(IORES,NM4,ITABE4,IRETOU,IFORM)
  122. IF(IRETOU.NE.0) RETURN
  123. *
  124. DO 31 ICO=1,N2
  125. if (iform.ne.2) then
  126. WRITE(TYPCHE(ICO),FMT='(2A8)') ITABE4(2*ICO-1),
  127. & ITABE4(2*ICO)
  128. else
  129. TYPCHE(ICO)(1:8) =ITABE4(2*ICO-1)
  130. TYPCHE(ICO)(9:16)=ITABE4(2*ICO )
  131. endif
  132. * write (6,*) ' licham ico typche ',ico,typche(ico)
  133.  
  134. *
  135. * PETITS TEST MILL 17 / 1 /92
  136. *
  137. IF(TYPCHE(ICO).EQ.'POINTEUR MLREEL' )
  138. . TYPCHE(ICO)='POINTEURLISTREEL'
  139. IF(TYPCHE(ICO).EQ.'POINTEUR MEVOLUT' )
  140. . TYPCHE(ICO)='POINTEUREVOLUTIO'
  141. *
  142. 31 CONTINUE
  143. *
  144. SEGSUP MTABE2,MTABE4
  145. *
  146. * BOUCLE SUR LES COMPOSANTES :
  147. *
  148. DO 32 ICO=1,N2
  149. CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
  150. IF(IRETOU.NE.0) RETURN
  151. N1PTEL = IDAN (1)
  152. N1EL = IDAN (2)
  153. N2PTEL = IDAN (3)
  154. N2EL = IDAN (4)
  155. * write (6,*) ' licham ',n1ptel,n1el,n2ptel,n2el
  156. SEGINI MELVAL
  157. IELVAL(ICO) = MELVAL
  158. *
  159. * LECTURE DU CONTENU DU SEGMENT MELVAL :
  160. *
  161. L1 = IDAN(1) * IDAN(2)
  162. L2 = IDAN(3) * IDAN(4)
  163. CALL LFCDI2(IORES,L1,VELCHE,IRETOU,IFORM)
  164. IF(IRETOU.NE.0) RETURN
  165. CALL LFCDIE(IORES,L2,IELCHE,IRETOU,IFORM)
  166. IF(IRETOU.NE.0) RETURN
  167. SEGDES MELVAL
  168. 32 CONTINUE
  169. *
  170. SEGDES MCHAML
  171. 22 CONTINUE
  172. *
  173. SEGDES MCHELM
  174. ITLAC(**)=MCHELM
  175. 10 CONTINUE
  176. *
  177. RETURN
  178. END
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  

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