Télécharger la plaquette Cast3M


fr en

Télécharger lirfem.eso

Retour à la liste

Numérotation des lignes : 

lirfem

  1. C LIRFEM    SOURCE    PV        20/08/31    21:15:04     10703          
  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.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC SMCOORD
  39.  
  40.  
  41.       NBLIGN = 0
  42.  
  43. C Lecture des arguments : Nom du fichier à lire (toto.fem)
  44.       CALL LIRCHA(FicFem,1,IRETO1)
  45.       IF (IERR.NE.0) RETURN
  46.  
  47. C Par defaut, Erreur Cast3M numero 424
  48. C     Erreur 424 : Problème %i1 en ouvrant le fichier : %m1:40
  49.       iOK=424
  50.       L=LEN(FicFem)
  51.       MOTERR=FicFem(1:L)
  52.       INTERR(1)=0
  53.  
  54. C Ouverture du fichier .fem
  55.       CLOSE(UNIT=IUFEM,ERR=991)
  56.       OPEN(UNIT=IUFEM,STATUS='OLD',FILE=FicFem(1:L),
  57.      &     IOSTAT=IOS,FORM='FORMATTED')
  58.  
  59. C Traitement des erreurs d'ouverture des fichiers
  60.       IF (IOS.NE.0) THEN
  61.         INTERR(1)=IOS
  62. C           IF (DEBCB) THEN
  63. C             WRITE(IOIMP,*) 'Fichier introuvable : ',FicFem
  64. C           ENDIF
  65.         CALL ERREUR(424)
  66.         RETURN
  67.       ELSE
  68. C        IF (DEBCB) THEN
  69. C          WRITE(IOIMP,*) 'Ouverture OK du fichier FEM'
  70. C        ENDIF
  71.  
  72. C       Changement de dimension (si necessaire)
  73.         iOK=0
  74.         IDIMI=IDIM
  75.         IDIMF=3
  76.         IF (IDIMF.NE.IDIMI) THEN
  77.           CALL ECRENT(IDIMF)
  78.           CALL ECRCHA('DIME')
  79.           CALL OPTION(1)
  80.           IF (IERR.NE.0) THEN
  81.             CALL ERREUR(IERR)
  82.             RETURN
  83.           ENDIF
  84.           WRITE(IOIMP,*) ' '
  85.           WRITE(IOIMP,*) '     Passage en DIMEnsion 3'
  86.           WRITE(IOIMP,*) ' '
  87.         ENDIF
  88.       ENDIF
  89.  
  90.  10   CONTINUE
  91. C     Lecture de la ligne complete (80 caracteres)
  92.  1000 FORMAT(A80)
  93.       READ(IUFEM,1000,ERR=991,END=100) LIGNE
  94.       NBLIGN = NBLIGN + 1
  95. C       IF (DEBCB) THEN
  96. C         WRITE(IOIMP,*) 'Nombre de LIGNES : ',NBLIGN
  97. C       ENDIF
  98.  
  99.       IF (NBLIGN .EQ. 3) THEN
  100. C       Lecture de la version du Template d'export
  101.         IF (LIGNE(60:68) .EQ. 'hwdesktop') THEN
  102.           READ(LIGNE(69:70),*) IVERLU
  103.         ELSE
  104.           READ(LIGNE(60:61),*) IVERLU
  105.         ENDIF
  106.  
  107.         IF ( IVERLU .LT. MINVER) THEN
  108. C         Teste si la version est supportée
  109.           WRITE(IOIMP,*) '   Version non supportee   : ',IVERLU
  110.           WRITE(IOIMP,*) '   Version Minimum requise : ',MINVER
  111.           WRITE(IOIMP,*) '                             '
  112.           iOK = 424
  113.         ENDIF
  114.       ENDIF
  115.  
  116.       IF (NBLIGN .EQ. 5) THEN
  117. C       Lecture du nom du Template d'export
  118.         IF (LIGNE(1:26) .NE. '$$   Template:  optistruct') THEN
  119.           WRITE(IOIMP,*) '   Template non supporte  : ',LIGNE(17:50)
  120.           WRITE(IOIMP,*) '   Template requis        : optistruct'
  121.           WRITE(IOIMP,*) '                             '
  122.           iOK = 424
  123.         ENDIF
  124.         GOTO 100
  125.       ENDIF
  126.       GOTO 10
  127.  
  128.  100  CONTINUE
  129.  
  130. C***********************************************************************
  131. C      Orientation vers la source qui lit les fichiers .fem
  132. C***********************************************************************
  133.       MTABLE = 0
  134.       IF    (IVERLU .LT. 14) THEN
  135.         CALL femv12(IUFEM,NBLIGN,MTABLE)
  136.  
  137.       ELSEIF(IVERLU .GE. 14) THEN
  138.         CALL femv14(IUFEM,NBLIGN,MTABLE)
  139.  
  140.       ELSE
  141.         CALL ERREUR(21)
  142.         RETURN
  143.  
  144.       ENDIF
  145.  
  146. C***********************************************************************
  147. C      Fermeture du fichier en lecture
  148. C***********************************************************************
  149.       CLOSE(UNIT=IUFEM,ERR=991)
  150.  
  151.  991  CONTINUE
  152.  
  153. C Traitement des erreurs
  154.       IF (iOK .NE.0) THEN
  155.         CALL ERREUR(iOK)
  156.  
  157.       ELSEIF (IERR.NE.0) THEN
  158.         CALL ERREUR(IERR)
  159.  
  160.       ELSE
  161.         CALL ECROBJ('TABLE   ',MTABLE)
  162.  
  163.       ENDIF
  164.  
  165.       RETURN
  166.       END
  167.  
  168.  
  169.  
  170.  

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