Télécharger lirfem.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRFEM SOURCE CB215821 16/03/08 21:15:11 8842
  2. SUBROUTINE LIRFEM
  3.  
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C BUT: Lecture des données provenant de HyperMesh sous forme de
  7. C fichier FEM (ASCII). Les données sont logées dans une table
  8. C qui est renvoyée comme résultat.
  9. C
  10. C Auteur : Clément BERTHINIER
  11. C Mars 2016
  12. C
  13. C Liste des Corrections :
  14. C
  15. C Appelé par : LIREFI
  16. C
  17. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  18.  
  19.  
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8 (A-H,O-Z)
  22.  
  23.  
  24. C Déclaration des chaines de caractères
  25. CHARACTER*256 FicFem
  26. CHARACTER*80 LIGNE
  27.  
  28. C Unite logique du fichier d'impression au format .fem et nom du fichier
  29. PARAMETER (IUFEM=67)
  30.  
  31. C Version minimum du Templates HyperMesh qui sont Lus ou partiellement Lus
  32. PARAMETER (MINVER=12)
  33.  
  34. C Définition des COMMON utiles
  35. -INC CCOPTIO
  36. -INC SMCOORD
  37.  
  38.  
  39. NBLIGN = 0
  40.  
  41. C Lecture des arguments : Nom du fichier à lire (toto.fem)
  42. CALL LIRCHA(FicFem,1,IRETO1)
  43. IF (IERR.NE.0) RETURN
  44.  
  45. C Par defaut, Erreur Cast3M numero 424
  46. C Erreur 424 : Problème %i1 en ouvrant le fichier : %m1:40
  47. iOK=424
  48. L=LEN(FicFem)
  49. MOTERR(1:L)=FicFem(1:L)
  50. INTERR(1)=0
  51.  
  52. C Ouverture du fichier .fem
  53. CLOSE(UNIT=IUFEM,ERR=991)
  54. OPEN(UNIT=IUFEM,STATUS='OLD',FILE=FicFem(1:L),
  55. & IOSTAT=IOS,FORM='FORMATTED')
  56.  
  57. C Traitement des erreurs d'ouverture des fichiers
  58. IF (IOS.NE.0) THEN
  59. INTERR(1)=IOS
  60. C IF (DEBCB) THEN
  61. C WRITE(IOIMP,*) 'Fichier introuvable : ',FicFem
  62. C ENDIF
  63. CALL ERREUR(424)
  64. RETURN
  65. ELSE
  66. C IF (DEBCB) THEN
  67. C WRITE(IOIMP,*) 'Ouverture OK du fichier FEM'
  68. C ENDIF
  69.  
  70. C Changement de dimension (si necessaire)
  71. iOK=0
  72. IDIMI=IDIM
  73. IDIMF=3
  74. IF (IDIMF.NE.IDIMI) THEN
  75. CALL ECRENT(IDIMF)
  76. CALL ECRCHA('DIME')
  77. CALL OPTION(1)
  78. IF (IERR.NE.0) THEN
  79. CALL ERREUR(IERR)
  80. RETURN
  81. ENDIF
  82. WRITE(IOIMP,*) ' '
  83. WRITE(IOIMP,*) ' Passage en DIMEnsion 3'
  84. WRITE(IOIMP,*) ' '
  85. ENDIF
  86. ENDIF
  87.  
  88. 10 CONTINUE
  89. C Lecture de la ligne complete (80 caracteres)
  90. 1000 FORMAT(A80)
  91. READ(IUFEM,1000,ERR=991,END=100) LIGNE
  92. NBLIGN = NBLIGN + 1
  93. C IF (DEBCB) THEN
  94. C WRITE(IOIMP,*) 'Nombre de LIGNES : ',NBLIGN
  95. C ENDIF
  96.  
  97. IF (NBLIGN .EQ. 3) THEN
  98. C Lecture de la version du Template d'export
  99. IF (LIGNE(60:68) .EQ. 'hwdesktop') THEN
  100. READ(LIGNE(69:70),*) IVERLU
  101. ELSE
  102. READ(LIGNE(60:61),*) IVERLU
  103. ENDIF
  104.  
  105. IF ( IVERLU .LT. MINVER) THEN
  106. C Teste si la version est supportée
  107. WRITE(IOIMP,*) ' Version non supportee : ',IVERLU
  108. WRITE(IOIMP,*) ' Version Minimum requise : ',MINVER
  109. WRITE(IOIMP,*) ' '
  110. iOK = 424
  111. ENDIF
  112. ENDIF
  113.  
  114. IF (NBLIGN .EQ. 5) THEN
  115. C Lecture du nom du Template d'export
  116. IF (LIGNE(1:26) .NE. '$$ Template: optistruct') THEN
  117. WRITE(IOIMP,*) ' Template non supporte : ',LIGNE(17:50)
  118. WRITE(IOIMP,*) ' Template requis : optistruct'
  119. WRITE(IOIMP,*) ' '
  120. iOK = 424
  121. ENDIF
  122. GOTO 100
  123. ENDIF
  124. GOTO 10
  125.  
  126. 100 CONTINUE
  127.  
  128. C***********************************************************************
  129. C Orientation vers la source qui lit les fichiers .fem
  130. C***********************************************************************
  131. MTABLE = 0
  132. IF (IVERLU .LT. 14) THEN
  133. CALL femv12(IUFEM,NBLIGN,MTABLE)
  134.  
  135. ELSEIF(IVERLU .GE. 14) THEN
  136. CALL femv14(IUFEM,NBLIGN,MTABLE)
  137.  
  138. ELSE
  139. CALL ERREUR(21)
  140. RETURN
  141.  
  142. ENDIF
  143.  
  144. C***********************************************************************
  145. C Fermeture du fichier en lecture
  146. C***********************************************************************
  147. CLOSE(UNIT=IUFEM,ERR=991)
  148.  
  149. 991 CONTINUE
  150.  
  151. C Traitement des erreurs
  152. IF (iOK .NE.0) THEN
  153. CALL ERREUR(iOK)
  154.  
  155. ELSEIF (IERR.NE.0) THEN
  156. CALL ERREUR(IERR)
  157.  
  158. ELSE
  159. CALL ECROBJ('TABLE ',MTABLE)
  160.  
  161. ENDIF
  162.  
  163. RETURN
  164. END
  165.  
  166.  
  167.  

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