Télécharger la plaquette Cast3M


fr en

Télécharger lirefi.eso

Retour à la liste

Numérotation des lignes : 

lirefi

  1. C LIREFI    SOURCE    OF166741  24/11/14    21:15:17     12078          
  2.  
  3. C   ROUTINE DE RELECTURE D'UN MAILLAGE SAUVE ANTERIEUREMENT
  4. C   EVENTUELLEMENT COMMUNICATION AVEC UN AUTRE PROGRAMME
  5. C   AUCUN ARGUMENT NE PARAIT NECESSAIRE
  6. C   LES OBJETS DEJA EXISTANT AYANT LE MEME NOM SERONT ECRASES
  7. C
  8.       SUBROUTINE LIREFI
  9.  
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC CCGEOME
  16.  
  17. -INC SMELEME
  18. -INC SMCOORD
  19.  
  20.       CHARACTER*80 TEX
  21.       SEGMENT NOMCL
  22.          CHARACTER*4  CNOMCL(NBELEM)
  23.       ENDSEGMENT
  24.       SEGMENT ISGT
  25.          INTEGER ISGTR(ILONG)
  26.       ENDSEGMENT
  27.       SEGMENT CSGT
  28.          CHARACTER*8 CSGTR(ILONG)
  29.       ENDSEGMENT
  30.       SEGMENT JSGTR(ILONG)
  31.       SEGMENT ILIST(ILONG)
  32.       CHARACTER*8 ITTEMP
  33.       CHARACTER*8 ICAR
  34.       CHARACTER*4 NOMLU
  35.  
  36.       PARAMETER (NTYPRO=8)
  37.       CHARACTER*4 MOPROG(NTYPRO)
  38.       INTEGER ITYPRO
  39.  
  40.       DATA MOPROG / 'AVS ','MED ','UNV ', 'FEM ', 'PROC','CSV ','NAS ',
  41.      &              'STL '/
  42.  
  43.       ITYPRO=0
  44.  
  45. C     Recherche du mot signifiant le type de la lecture
  46.       CALL LIRMOT(MOPROG,NTYPRO,ITYPRO,0)
  47.  
  48. C     Redirection directe vers le bon type de fichier
  49.       GOTO(7001,7002,7003,7004,7005,7006,7007,7008),ITYPRO
  50. C     Si  ITYPRO=0 on va en 999
  51.       GOTO 999
  52.  
  53. C     Lecture du fichier AVS (UCD ASCII) ...
  54.  7001 CONTINUE
  55. CDEBUG         WRITE(IOIMP,3001)
  56. CDEBUG 3001    FORMAT('Lecture du fichier AVS')
  57.       CALL LIRAVS
  58.       RETURN
  59.  
  60. C     Lecture du fichier MED ...
  61.  7002 CONTINUE
  62.       CALL LIRMED
  63.       RETURN
  64.  
  65. C     Lecture du fichier UNV I-DEAS(R) ...
  66.  7003 CONTINUE
  67. CDEBUG         WRITE(IOIMP,3003)
  68. CDEBUG 3003    FORMAT('Lecture du fichier UNV')
  69.       CALL LIRUNV
  70.       RETURN
  71.  
  72. C     Lecture du fichier FEM
  73.  7004 CONTINUE
  74. CDEBUG         WRITE(IOIMP,3004)
  75. CDEBUG 3004    FORMAT('Lecture du fichier FEM')
  76.       CALL LIRFEM
  77.       RETURN
  78.  
  79. C     Lecture d'un fichier PROCEDUR
  80.  7005 CONTINUE
  81. CDEBUG         WRITE(IOIMP,3005)
  82. CDEBUG 3005    FORMAT('Lecture du fichier PROC')
  83.       CALL LIPROC
  84.       RETURN
  85.  
  86. C   Lecture d'un fichier CSV
  87.  7006 CONTINUE
  88. CDEBUG         WRITE(IOIMP,3006)
  89. CDEBUG 3006    FORMAT('Lecture du fichier CSV')
  90.       CALL LIRCSV
  91.       RETURN      
  92.  
  93. C   Lecture d'un fichier NAS
  94.  7007 CONTINUE
  95. CDEBUG         WRITE(IOIMP,3007)
  96. CDEBUG 3007    FORMAT('Lecture du fichier NAS')
  97.       CALL LIRNAS
  98.       RETURN      
  99.  
  100. C   Lecture d'un fichier STL
  101.  7008 CONTINUE
  102. CDEBUG         WRITE(IOIMP,3008)
  103. CDEBUG 3008    FORMAT('Lecture du fichier STL')
  104.       CALL LIRSTL
  105.       RETURN
  106.  
  107. CMB ... Ici commence l'ancienne lecture (Castem) ...
  108.  
  109.  999  CONTINUE
  110.  
  111.       CALL QUETYP(ICAR,0,IRET1)
  112.       IF (IERR.NE.0) RETURN
  113.       IF(IRET1.NE.0) THEN
  114.          CALL LIROBJ(ICAR,IPROUT,1,IRETOU)
  115.          IF (IERR.NE.0) RETURN
  116.       ENDIF
  117.  
  118.       READ (IOCAR,100,END=1000,ERR=1000) TEX
  119.  100  FORMAT (A80)
  120.  
  121.       IF(IRET1.NE.0) THEN
  122.          CALL QUENOM(ICAR)
  123.          MOTERR(1:8)=ICAR
  124.          IF (TEX(1:8).NE.ICAR) CALL ERREUR(9)
  125.          IF (IERR.NE.0) RETURN
  126.       ENDIF
  127.  
  128.       TITREE=TEX(1:72)
  129.       IF (IIMPI.NE.0) WRITE(IOIMP,200) TEX(1:72)
  130.  200  FORMAT (1X,A72)
  131.  
  132.       READ (IOCAR,101,END=1000,ERR=1000) NIVOLU
  133.  101  FORMAT(34X,I3)
  134.       IF (IIMPI.NE.0) WRITE(IOIMP,*) 'NIVEAU ',NIVOLU
  135.       IF (NIVOLU.GT.2) GOTO 1000
  136.       CALL NOMENT('&NIVE',NIVOLU)
  137.  
  138.       READ(IOCAR,102,END=1000,ERR=1000) IaRR,JDIM,DENSIT
  139.  102  FORMAT(6X,I4,10X,I4,9X,E12.5)
  140.  
  141.       IF (IIMPI.NE.0) WRITE (IOIMP,201) IaRR,JDIM,DENSIT
  142.  201  FORMAT (1X,'ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',1PE12.5)
  143.       IERMAX=MAX(IERMAX,IaRR)
  144. *      IERR=0
  145.       CALL GINT2
  146.       IF (IDIM.EQ.0) IDIM=JDIM
  147.       IF (JDIM.NE.IDIM) CALL ERREUR(12)
  148.       CALL NOMENT('&DIME',IDIM)
  149.  
  150.       READ (IOCAR,103,END=1000,ERR=1000) INOMB
  151.  103  FORMAT(17X,I8)
  152.       IF (IIMPI.NE.0) WRITE (IOIMP,202) INOMB
  153.  202  FORMAT(' NOMBRE DE POINTS A LIRE ',I8)
  154.       SEGACT MCOORD*mod
  155.       NBANC=nbpts
  156.       NBNOUV=NBANC+INOMB
  157.       NBPTS=NBNOUV
  158.       SEGADJ MCOORD
  159.       NDEBB=NBANC+1
  160.       NBC=IDIM+1
  161.       READ (IOCAR,104,ERR=1000,END=1000) ((XCOOR((J-1)*(IDIM+1)+I),I=1,
  162.      #  NBC),J=NDEBB,NBNOUV)
  163.  104  FORMAT (6E12.5)
  164.  
  165. C  LECTURE DES POINTS NOMMES
  166.       READ (IOCAR,105,END=1000,ERR=1000) ILONG
  167.  105  FORMAT(23X,I8)
  168.       IF (ILONG.NE.0) THEN
  169.          SEGINI ISGT,CSGT
  170.          READ (IOCAR,106,END=1000,ERR=1000)(CSGTR(I),ISGTR(I),I=1,ILONG)
  171.  106     FORMAT(5(A8,I8))
  172.          IF (IIMPI.NE.0) WRITE (IOIMP,203)(CSGTR(I),ISGTR(I),I=1,ILONG)
  173.  203     FORMAT(' LISTE DES POINTS NOMMES',/,5(1X,A8,I8))
  174.          DO 5 I=1,ILONG
  175.             ITTEMP=CSGTR(I)
  176.             ITVAL=ISGTR(I)+NBANC
  177.             CALL NOMOBJ('POINT',ITTEMP,ITVAL)
  178.    5     CONTINUE
  179.          SEGSUP ISGT,CSGT
  180.       ENDIF
  181.  
  182. C  LECTURE DES OBJETS
  183.       READ (IOCAR,116,END=1000,ERR=1000) ILONG
  184.  116  FORMAT (16X,I8)
  185.  
  186.       IF (IIMPI.NE.0) WRITE (IOIMP,204) ILONG
  187.  204  FORMAT (' NOMBRE D''OBJETS',I8)
  188.  
  189.       SEGINI JSGTR
  190.       DO 7 IOB=1,ILONG
  191.          IF (NIVOLU.LE.1) THEN
  192.             READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  193.      +                                         NBNN,NBELEM
  194.  107        FORMAT(A4,12X,I4,11X,I4,10X,I4,8X,I4)
  195.          ELSE
  196.             READ (IOCAR,1107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,
  197.      +                                          NBNN,NBELEM
  198. 1107        FORMAT(A4,12X,I4,11X,I4,10X,I4,7X,I5)
  199.          ENDIF
  200.          IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM
  201.  205  FORMAT(' NOMLU ',A4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM
  202.      # ',I4)
  203.  
  204.          SEGINI MELEME
  205.          JSGTR(IOB)=MELEME
  206.          IF (NBSOUS.NE.0)
  207.      +      READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS)
  208.  108        FORMAT(20I4)
  209.  
  210.          IF (NBREF.NE.0)
  211.      +      READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF)
  212.  
  213.          IF (NBELEM.EQ.0) GOTO 7
  214.  
  215. C ... EST CE UN TYPE D'ELEM CONNU
  216.          DO 10 I=1,NOMBR
  217.             IF (NOMLU.EQ.NOMS(I)) GOTO 11
  218.   10     CONTINUE
  219.          SEGSUP MELEME,JSGTR
  220.          RETURN
  221.   11     ITYPEL=I
  222.          IF( NIVOLU .EQ. 0 ) THEN
  223.             DO 1800 I = 1,NBELEM
  224.                ICOLOR(I)=IDCOUL
  225.  1800       CONTINUE
  226.          ELSE
  227.             SEGINI NOMCL
  228.             READ (IOCAR,112,END=1000,ERR=1000)(CNOMCL(I),I=1,NBELEM)
  229.  112        FORMAT (16(1X,A4))
  230.             DO 18 I=1,NBELEM
  231.                IREP=IDCOUL
  232.                DO 19 J=0,NBCOUL
  233.                   IF (CNOMCL(I).EQ.NCOUL(J)) IREP=J
  234. 19             CONTINUE
  235.                   ICOLOR(I)=IREP
  236. 18          CONTINUE
  237.             SEGSUP NOMCL
  238.          ENDIF
  239.          READ (IOCAR,111,END=1000,ERR=1000)((NUM(I,J),I=1,NBNN),
  240.      +                                               J=1,NBELEM)
  241.  111     FORMAT (16I5)
  242.    7  CONTINUE
  243.  
  244.       DO 12 I=1,ILONG
  245.          MELEME=JSGTR(I)
  246.          IF (LISOUS(/1).NE.0) THEN
  247.             DO 14 J=1,LISOUS(/1)
  248.                LISOUS(J)=JSGTR(LISOUS(J))
  249.   14        CONTINUE
  250.          ENDIF
  251.          IF (LISREF(/1).NE.0) THEN
  252.             DO 16 J=1,LISREF(/1)
  253.                LISREF(J)=JSGTR(LISREF(J))
  254.   16        CONTINUE
  255.          ENDIF
  256.          DO JK=1,NUM(/2)
  257.             DO IK=1,NUM(/1)
  258.                NUM(IK,JK)=NUM(IK,JK)+NBANC
  259.             ENDDO
  260.          ENDDO
  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,NIVOLU)
  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