Télécharger la plaquette Cast3M


fr en

Télécharger lirunv.eso

Retour à la liste

Numérotation des lignes : 

lirunv

  1. C LIRUNV    SOURCE    PV        20/08/31    21:15:14     10703          
  2.  
  3. C=======================================================================
  4. C Appele par : LIREFI
  5. C=======================================================================
  6.  
  7.       SUBROUTINE LIRUNV
  8.  
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8(A-H,O-Z)
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC CCREDLE
  15. -INC CCGEOME
  16.  
  17. -INC SMCOORD
  18. -INC SMELEME
  19. -INC SMLENTI
  20.       SEGMENT MLINOE.MLENTI,MLINO2.MLENTI,MLIEL2.MLENTI
  21. -INC SMTABLE
  22.  
  23. C= Nombre de caracteres sur une ligne lue (cf. etiquette 1000)
  24.       PARAMETER (NCARMAX = 80 , NCARFIN = NCARMAX+1)
  25. C= Unite logique du fichier d'impression au format UNV I-Deas/NX(TM)
  26.       PARAMETER (IUUNV=67)
  27.       CHARACTER*(LOCHAI) FicUnv
  28.  
  29.       PARAMETER (INCJG = 10000)
  30.  
  31.       PARAMETER (NEFUNV=86, NEFBIM=8, NEFPOI=1)
  32.       INTEGER LEFUNV(NEFUNV), LEFGEO(NEFUNV),
  33.      &        LEFBIM(NEFBIM), LEFPOI(NEFPOI)
  34.       DATA LEFUNV /  11,  21,  22,  23,  24,  31,  32,  41,  42,  43,
  35.      &               44,  45,  46,  51,  52,  53,  54,  55,  56,  61,
  36.      &               62,  63,  64,  65,  66,  71,  72,  73,  74,  75,
  37.      &               76,  81,  82,  84,  85,  91,  92,  93,  94,  95,
  38.      &               96, 101, 102, 103, 104, 105, 106, 111, 112, 113,
  39.      &              114, 115, 116, 117, 118, 121, 122, 136, 137, 138,
  40.      &              139, 141, 142, 151, 152, 161, 171, 172, 181, 191,
  41.      &              192, 193, 194, 195, 196, 201, 202, 203, 204, 208,
  42.      &              212, 213, 221, 222, 231, 232 /
  43.       DATA LEFGEO /   2,   2,   2,   0,   3,   0,   0,   4,   6,   0,
  44.      &                8,  10,   0,   4,   6,   0,   8,  10,   0,   4,
  45.      &                6,   0,   8,  10,   0,   8,   6,   0,   4,  10,
  46.      &                0,   4,   6,   8,  10,   4,   6,   0,   8,  10,
  47.      &                0,  16,  17,   0,  14,  15,   0,  23,  16,  17,
  48.      &                0,  14,  15,   0,  24,   2,   0,   0,   0,   0,
  49.      &                0,   0,   0,   0,   0,   1,   2,   3,   0,   0,
  50.      &                0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
  51.      &                0,   0,   0,   0,   0,   0 /
  52.       DATA LEFBIM /  11,  21,  22,  23,  24,  31,  32, 121 /
  53.       DATA LEFPOI /  161 /
  54.  
  55.       SEGMENT MLIELT
  56.         INTEGER IELEM(JGEL,4)
  57.       ENDSEGMENT
  58.  
  59.       SEGMENT MLISEF
  60.         INTEGER ITYPE(JGEF,5)
  61.       ENDSEGMENT
  62.  
  63.       SEGMENT MLIMAI
  64.         POINTEUR PTMAI(JGMAI).MELEME
  65.         INTEGER  TYMAI(JGMAI)
  66.       ENDSEGMENT
  67.  
  68.       SEGMENT MLIPHY
  69.         INTEGER NUMPHY(JGPHY)
  70.         CHARACTER*40 NOMPHY(JGPHY)
  71.         POINTEUR PTPHY(JGPHY).MELEME
  72.       ENDSEGMENT
  73.  
  74.       SEGMENT MLIPEG
  75.         INTEGER NUMPEG(JGPEG,4)
  76.         CHARACTER*40 NOMPEG(JGPEG)
  77.         POINTEUR PTPEG(JGPEG).MELEME
  78.         POINTEUR PTPEGN(JGPEG).MELEME
  79.       ENDSEGMENT
  80.  
  81.       EXTERNAL LONG
  82.  
  83.       CHARACTER*8  mot_z
  84.       CHARACTER*45 nom_z
  85.       LOGICAL b_z
  86.  
  87. C... Format de lecture
  88.  1000 FORMAT(A80)
  89. C* 1003 FORMAT(2x,d23.16,2x,d23.16,2x,d23.16)
  90. C* 1004 FORMAT(2x,i8)
  91. C* 1005 FORMAT(4x,a2)
  92. C* 1010 FORMAT(8(i10))
  93.  
  94. C... Lecture des arguments (obligatoires)
  95. C= Lecture du nom du fichier de donnees au format UNV de I-Deas/NX(TM)
  96.       CALL LIRCHA(FicUnv,1,IRETOU)
  97.       IF (IERR.NE.0) RETURN
  98.  
  99. C... Initialisation de la table de sortie
  100.       CALL CRTABL(MATAB)
  101.       i_z = 0
  102.       r_z = 0.
  103.       b_z = .FALSE.
  104.       mot_z = '        '
  105.       nom_z = '                                        '
  106. C... Segment de lecture d'une ligne ...
  107.       SEGINI,sredle
  108.       SEPARA=.FALSE.
  109.       MOT=' '
  110.       NRAN=0
  111.       ICOUR=0
  112. C... Configuration initiale
  113.       IDIMI=IDIM
  114.       WRITE(IOIMP,*)
  115.       WRITE(IOIMP,FMT='(A,I2)') ' DIMEnsion initiale = ',IDIMI
  116.       SEGACT,MCOORD*MOD
  117.       NBANC=nbpts
  118. C... Passage temporaire en dimension 3 (si necessaire)
  119.       iOK=0
  120.       IDIMF=3
  121.       IF (IDIMF.NE.IDIMI) THEN
  122.         CALL ECRENT(IDIMF)
  123.         CALL ECRCHA('DIME')
  124.         CALL OPTION(1)
  125.         IF (IERR.NE.0) GOTO 990
  126.       ENDIF
  127. C... Par defaut, on affiche erreur Cast3m numero 424
  128.       iOK=424
  129.       l=LONG(FicUnv)
  130.       MOTERR=FicUnv(1:l)
  131.       INTERR(1)=0
  132.       CLOSE(UNIT=IUUNV,ERR=990)
  133.       WRITE(IOIMP,*)
  134.       WRITE(IOIMP,*) 'Ouverture du fichier I-Deas/NX (TM)'
  135.       OPEN(UNIT=IUUNV,STATUS='OLD',FILE=FicUnv(1:l),
  136.      &     IOSTAT=IOS,FORM='FORMATTED')
  137. C... Traitement des erreurs d ouverture des fichiers
  138.       IF (IOS.NE.0) THEN
  139.         iOK=599
  140.         INTERR(1)=IOS
  141.         GOTO 990
  142.       ENDIF
  143. C... Quelques initialisations
  144.       NBNPTS=0
  145.       NBELTS=0
  146.       NBEFLU=0
  147.       NBMAIS=0
  148.       NBPHYS=0
  149.       NBPEGR=0
  150.       MLINOE=0
  151.       MLINO2=0
  152.       MLIELT=0
  153.       MLIEL2=0
  154.       MLISEF=0
  155.       MLIMAI=0
  156.       MLIPHY=0
  157.       MLIPEG=0
  158.  
  159. C... Lecture des lignes du fichier ...
  160.       I_BLOC=0
  161. C... Recherche de l'indicateur "-1" en debut de bloc
  162.       WRITE(IOIMP,*)
  163.       WRITE(IOIMP,*) 'LECTURE DES DATASET'
  164.  10   CONTINUE
  165.       READ(IUUNV,FMT=1000,ERR=991,END=100) TEXT
  166.       NRAN=0
  167.       ICOUR=NCARMAX
  168.       IFINAN=NCARFIN
  169.       CALL REDLEC(sredle)
  170.       IF (IRE.NE.1) GOTO 10
  171.       IF (NFIX.NE.-1) GOTO 10
  172.       I_BLOC=1-I_BLOC
  173.       IF (I_BLOC.EQ.0) GOTO 10
  174. C... Lecture de la cle
  175.       READ(IUUNV,FMT=1000,ERR=991,END=100) TEXT
  176.       NRAN=0
  177.       ICOUR=NCARMAX
  178.       IFINAN=NCARFIN
  179.       CALL REDLEC(sredle)
  180.       IF (IRE.NE.1) THEN
  181.         WRITE(IOIMP,*) 'ERREUR : Numero du DATASET non trouve'
  182.         iOK=21
  183.         GOTO 991
  184.       ENDIF
  185.       IF (NFIX.EQ. 151) GOTO  151
  186.       IF (NFIX.EQ. 164) GOTO  164
  187.       IF (NFIX.EQ.2411) GOTO 2411
  188.       IF (NFIX.EQ.2412) GOTO 2412
  189.       IF (NFIX.EQ.2470) GOTO 2470
  190.       IF (NFIX.EQ.2477) GOTO 2477
  191.       WRITE(IOIMP,*) 'ATTENTION : DATASET ',NFIX,' ignore'
  192.       GOTO 10
  193.  
  194. C... Lecture de l'entete
  195.  151  CONTINUE
  196.       WRITE(IOIMP,*) '-> LECTURE du DATASET 151'
  197.       DO i = 1, 7
  198.         READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  199.         IF (i.EQ.3) THEN
  200. *         WRITE(IOIMP,*) TEXT(1:LONG(TEXT))
  201.         ELSE IF (i.EQ.6) THEN
  202.           WRITE(IOIMP,*) '   Programme = ',TEXT(1:LONG(TEXT))
  203.         ENDIF
  204.       ENDDO
  205. C...  Fin du bloc
  206.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  207.       I_BLOC=1-I_BLOC
  208.       WRITE(IOIMP,*) '<- Lecture du DATASET 151 terminee'
  209.       GOTO 10
  210.  
  211. C... Lecture de l'entete
  212.  164  CONTINUE
  213.       WRITE(IOIMP,*) '-> LECTURE du DATASET 164'
  214. *      READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  215.       READ(IUUNV,1640,ERR=991,END=991) i,TEXT,i
  216.  1640 FORMAT(I10,A20,I10)
  217.       WRITE(IOIMP,*) '   Systeme d unite utilise = ',TEXT(1:LONG(TEXT))
  218. C*    WRITE(IOIMP,*) '   Facteurs de conversion d unite'
  219.       NBVPR = 4
  220.       NBLIG = 0
  221.       DO i=1, NBVPR
  222.         IF (NBLIG.EQ.3) NBLIG = 0
  223.         NBLIG = NBLIG + 1
  224.         IF (NBLIG.EQ.1) THEN
  225.           READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  226. C*        NRAN=0
  227. C*        ICOUR=NCARMAX
  228. C*        IFINAN=NCARFIN
  229.         ENDIF
  230. C*      CALL REDLEC(sredle)
  231.       ENDDO
  232. C...  Fin du bloc
  233.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  234.       I_BLOC=1-I_BLOC
  235.       WRITE(IOIMP,*) '<- Lecture du DATASET 164 terminee'
  236.       GOTO 10
  237.  
  238. C Lecture des noeuds : numero, coordonnees (densite mise a zero)
  239.  2411 CONTINUE
  240.       WRITE(IOIMP,*) '-> LECTURE du DATASET 2411'
  241.       JG=INCJG
  242.       SEGINI,MLINOE
  243.       NBPTS=NBANC+JG
  244.       SEGADJ,MCOORD
  245.       NUMIN=100000000
  246.       NUMAX=0
  247.       idimp1=IDIM+1
  248.       ABS_Z = 0.D0
  249. 12411 CONTINUE
  250. C... Lecture des informations liees au noeud (RECORD 1)
  251.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  252.       NRAN=0
  253.       ICOUR=NCARMAX
  254.       IFINAN=NCARFIN
  255.       CALL REDLEC(sredle)
  256.       IF (IRE.NE.1) THEN
  257.         iOK=8
  258.         GOTO 991
  259.       ENDIF
  260. C. Fin du bloc ?
  261.       IF (NFIX.EQ.-1) GOTO 22411
  262.       IF (NFIX.EQ.0) THEN
  263.         iOK=8
  264.         GOTO 991
  265.       ENDIF
  266.       NBNPTS=NBNPTS+1
  267.       IF (NBNPTS.GT.JG) THEN
  268.         JG=JG+INCJG
  269.         SEGADJ,MLINOE
  270.         NBPTS=NBANC+JG
  271.         SEGADJ,MCOORD
  272.       ENDIF
  273.       MLINOE.LECT(NBNPTS)=NFIX
  274.       NUMIN=MIN(NUMIN,NFIX)
  275.       NUMAX=MAX(NUMAX,NFIX)
  276. C... Lecture des coordonnees (RECORD 2)
  277.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  278.       NRAN=0
  279.       ICOUR=NCARMAX
  280.       IFINAN=NCARFIN
  281.       j=(NBANC+NBNPTS-1)*idimp1
  282.       DO k=1,IDIMF
  283.         CALL REDLEC(sredle)
  284.         IF (IRE.NE.1.AND.IRE.NE.2) THEN
  285.           iOK=661
  286.           GOTO 991
  287.         ENDIF
  288.         IF (IRE.EQ.1) THEN
  289.           XCOOR(j+k)=NFIX
  290.         ELSE
  291.           XCOOR(j+k)=FLOT
  292.         ENDIF
  293.       ENDDO
  294.       XCOOR(j+idimp1)=0.D0
  295.       ABS_Z = MAX(ABS_Z,ABS(XCOOR(j+IDIMF)))
  296.       GOTO 12411
  297. C... Fin du bloc
  298. 22411 CONTINUE
  299.       WRITE(IOIMP,*) '   Nombre de noeuds lus :',NBNPTS
  300.       WRITE(IOIMP,*) '   Numero du noeud min. :',NUMIN
  301.       WRITE(IOIMP,*) '   Numero du noeud max. :',NUMAX
  302.       WRITE(IOIMP,*) '<- Lecture du DATASET 2411 terminee'
  303.       IF (NBNPTS.NE.JG) THEN
  304.         JG = NBNPTS
  305.         SEGADJ,MLINOE
  306.         NBPTS = NBANC+JG
  307.         SEGADJ,MCOORD
  308.       ENDIF
  309.       WRITE(IOIMP,*)
  310.       IF (IDIMI.EQ.IDIMF) THEN
  311.         WRITE(IOIMP,*) '   Noeuds lus en DIMEsion 3'
  312.       ELSE
  313.         IF (ABS_Z.GT.0.D0) THEN
  314.           WRITE(IOIMP,*) '   Noeuds lus en DIMEnsion 3'
  315.           WRITE(IOIMP,*) '=> Passage en DIMEnsion 3 necessaire'
  316.         ELSE
  317.           WRITE(IOIMP,*) '   Noeuds lus en DIMEnsion 2'
  318.           IF (IDIMI.NE.2) THEN
  319.             WRITE(IOIMP,*) '=> Passage en DIMEnsion 2 necessaire'
  320.           ENDIF
  321.           IDIMF = 2
  322.           CALL ECRENT(IDIMF)
  323.           CALL ECRCHA('DIME')
  324.           CALL OPTION(1)
  325.           IF (IERR.NE.0) GOTO 990
  326.         ENDIF
  327.       ENDIF
  328.       WRITE(IOIMP,*)
  329.       I_BLOC=1-I_BLOC
  330.       GOTO 10
  331.  
  332. C... Lecture des elements
  333.  2412 CONTINUE
  334.       WRITE(IOIMP,*) '-> LECTURE du DATASET 2412'
  335.       JGEF = 50
  336.       SEGINI,MLISEF
  337.       JGEL = INCJG
  338.       SEGINI,MLIELT
  339.       NUMIN = 100000000
  340.       NUMAX = 0
  341. 12412 CONTINUE
  342. C... Lecture des informations liees a l'element (RECORD 1)
  343.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  344.       NRAN=0
  345.       ICOUR=NCARMAX
  346.       IFINAN=NCARFIN
  347.       DO i=1,6
  348.         CALL REDLEC(sredle)
  349.         IF (IRE.NE.1) THEN
  350.           iOK=8
  351.           GOTO 991
  352.         ENDIF
  353.         IF (i.EQ.1) THEN
  354.           IF (NFIX.EQ.-1) GOTO 22412
  355.           NUMELT=NFIX
  356.         ELSE IF (i.EQ.2) THEN
  357.           NUMEF=NFIX
  358.         ELSE IF (i.EQ.3) THEN
  359.           NUMPP=NFIX
  360. C*      ELSE IF (i.EQ.4) THEN
  361. C*        NUMMP=NFIX
  362. C*      ELSE IF (i.EQ.5) THEN
  363. C*        NUMCO=NFIX
  364.         ELSE IF (i.EQ.6) THEN
  365.           NBNOE=NFIX
  366.         ENDIF
  367.       ENDDO
  368.       CALL PLACE2(LEFBIM,NEFBIM,IRETOU,NUMEF)
  369. C... Lecture des informations d un element type "BEAM"
  370. C... Pour l'instant pas de traitement de ces informations
  371.       IF (IRETOU.NE.0) THEN
  372.         READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  373.       ENDIF
  374.       NBELTS=NBELTS+1
  375.       IF (NBELTS.GT.JGEL) THEN
  376.         JGEL=JGEL+INCJG
  377.         SEGADJ,MLIELT
  378.       ENDIF
  379.       NUMIN=MIN(NUMIN,NUMELT)
  380.       NUMAX=MAX(NUMAX,NUMELT)
  381.       DO i=1,NBEFLU
  382.         IF (NUMEF.EQ.ITYPE(i,1)) GOTO 24120
  383.       ENDDO
  384.       NBEFLU = NBEFLU+1
  385.       ITYPE(NBEFLU,1) = NUMEF
  386.       ITYPE(NBEFLU,2) = NBNOE
  387.       JG = 1*NBNOE
  388.       SEGINI,MLENTI
  389.       ITYPE(NBEFLU,5) = MLENTI
  390.       i = NBEFLU
  391. 24120 CONTINUE
  392.       IF (NBNOE.NE.ITYPE(i,2)) THEN
  393.         write(IOIMP,*) 'Erreur NUMEF/NBNOE',NBELTS,NUMELT
  394.       ENDIF
  395.       NBELEF=ITYPE(i,3)+1
  396.       ITYPE(i,3)=NBELEF
  397.       MLENTI=ITYPE(i,5)
  398.       JG=LECT(/1)
  399.       NBNOEF=NBELEF*NBNOE
  400.       IF (NBNOEF.GT.JG) THEN
  401.         JG=JG+INCJG
  402.         SEGADJ,MLENTI
  403.       ENDIF
  404.       NBNOEF=NBNOEF-NBNOE
  405.       IELEM(NBELTS,1)=NUMELT
  406.       IELEM(NBELTS,2)=NUMPP
  407.       IELEM(NBELTS,3)=i
  408.       IELEM(NBELTS,4)=NBELEF
  409. C... Lecture des noeuds de l'element (RECORD 2)
  410.       j=0
  411.       DO k=NBNOEF+1,NBNOEF+NBNOE
  412.         j=j+1
  413.         IF (j.EQ.1) THEN
  414.           READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  415.           NRAN=0
  416.           ICOUR=NCARMAX
  417.           IFINAN=NCARFIN
  418.         ENDIF
  419.         CALL REDLEC(sredle)
  420.         IF (IRE.NE.1) THEN
  421.           iOK=661
  422.           GOTO 991
  423.         ENDIF
  424.         LECT(k)=NFIX
  425.         IF (j.EQ.8) j=0
  426.       ENDDO
  427.       GOTO 12412
  428. C... Fin du bloc
  429. 22412 CONTINUE
  430.       WRITE(IOIMP,*) '   Nombre d elements lus  :',NBELTS
  431.       WRITE(IOIMP,*) '   Numero d element min.  :',NUMIN
  432.       WRITE(IOIMP,*) '   Numero d element max.  :',NUMAX
  433.       WRITE(IOIMP,*) '   Nombre de types EF lus :',NBEFLU
  434.       IF (NBELTS.NE.JGEL) THEN
  435.         JGEL=NBELTS
  436.         SEGADJ,MLIELT
  437.       ENDIF
  438.       I_BLOC=1-I_BLOC
  439.       WRITE(IOIMP,*) '<- Lecture du DATASET 2412 terminee'
  440.       GOTO 10
  441.  
  442. C Lecture des proprietes physiques
  443.  2470 CONTINUE
  444.       WRITE(IOIMP,*) '-> LECTURE du DATASET 2470'
  445.       NBPHYS = 0
  446.       JGPHY = 50
  447.       SEGINI,MLIPHY
  448. 12470 CONTINUE
  449. C... Lecture des donnees/proprietes physiques (RECORD 1)
  450.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  451.       NRAN=0
  452.       ICOUR=NCARMAX
  453.       IFINAN=NCARFIN
  454.       DO i=1,3
  455.         CALL REDLEC(sredle)
  456.         IF (IRE.NE.1) THEN
  457.           iOK=8
  458.           GOTO 991
  459.         ENDIF
  460.         IF (i.EQ.1) THEN
  461.           IF (NFIX.EQ.-1) GOTO 22470
  462.           NUMPH=NFIX
  463. C*      ELSE IF (i.EQ.2) THEN
  464. C*        IDPHT=NFIX
  465.         ELSE IF (i.EQ.3) THEN
  466.           NBPHT=NFIX
  467.         ENDIF
  468.       ENDDO
  469.       NBPHYS=NBPHYS+1
  470.       IF (NBPHYS.GT.JGPHY) THEN
  471.         JGPHY=JGPHY+50
  472.         SEGADJ,MLIPHY
  473.       ENDIF
  474.       NUMPHY(NBPHYS)=NUMPH
  475. C... Lecture du nom de la propriete (RECORD 2)
  476.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  477.       NOMPHY(NBPHYS)=TEXT(1:LONG(TEXT))
  478. C... Lecture des valeurs de chaque propriete physique (RECORD 3 et 4)
  479. C... Pour l'instant : pas de traitement de ces valeurs
  480.       DO i = 1, NBPHT
  481.         READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  482.         NRAN=0
  483.         ICOUR=NCARMAX
  484.         IFINAN=NCARFIN
  485.         DO j=1,3
  486.           CALL REDLEC(sredle)
  487.           IF (IRE.NE.1) THEN
  488.             iOK=8
  489.             GOTO 991
  490.           ENDIF
  491.           IF (j.EQ.1) THEN
  492. C*          NUMPR=NFIX
  493.           ELSE IF (j.EQ.2) THEN
  494.             IDTPR=NFIX
  495.           ELSE IF (j.EQ.3) THEN
  496.             NBVPR=NFIX
  497.           ENDIF
  498.         ENDDO
  499.         NBLIG=0
  500.         IF (IDTPR.EQ.1) THEN
  501.           NBLIG = ((NBVPR-1) / 8) + 1
  502.         ELSE IF (IDTPR.EQ.2) THEN
  503.           NBLIG = ((NBVPR-1) / 5) + 1
  504.         ELSE IF (IDTPR.EQ.3) THEN
  505.           NBLIG = ((NBVPR-1) / 80) + 1
  506.         ENDIF
  507.         DO j=1,NBLIG
  508.           READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  509.         ENDDO
  510.       ENDDO
  511.       GOTO 12470
  512. C... Fin du bloc
  513. 22470 CONTINUE
  514.       WRITE(IOIMP,*) '   Nombre de proprietes lues :',NBPHYS
  515.       DO i=1,NBPHYS
  516.         j=LONG(NOMPHY(i))
  517.         WRITE(IOIMP,FMT='(3X,I2,3H = ,A)') NUMPHY(i),NOMPHY(i)(1:j)
  518.       ENDDO
  519. c*      IF (NBPHYS.NE.JGPHY) THEN
  520. c*        JGPHY = NBPHYS
  521. c*        SEGADJ,MLIPHY
  522. c*      ENDIF
  523.       I_BLOC=1-I_BLOC
  524.       WRITE(IOIMP,*) '<- Lecture du DATASET 2470 terminee'
  525.       GOTO 10
  526.  
  527. C Lecture des groupes (d'elements) "permanents"
  528.  2477 CONTINUE
  529.       WRITE(IOIMP,*) '-> LECTURE du DATASET 2477'
  530.       NBPEGR = 0
  531.       NBPEGP = 0
  532.       NBPEGE = 0
  533.       JGPEG = 50
  534.       SEGINI,MLIPEG
  535. 12477 CONTINUE
  536. C... Lecture des donnees... (RECORD 1)
  537.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  538.       NRAN=0
  539.       ICOUR=NCARMAX
  540.       IFINAN=NCARFIN
  541.       DO i = 1, 8
  542.         CALL REDLEC(sredle)
  543.         IF (IRE.NE.1) THEN
  544.           iOK=8
  545.           GOTO 991
  546.         ENDIF
  547.         IF (i.EQ.1) THEN
  548.           IF (NFIX.EQ.-1) GOTO 22477
  549.           NUMPH = NFIX
  550.         ELSE IF (i.EQ.8) THEN
  551.           NBPHT = NFIX
  552.         ENDIF
  553.       ENDDO
  554.       NBPEGR = NBPEGR+1
  555.       IF (NBPEGR.GT.JGPEG) THEN
  556.         JGPEG = JGPEG+50
  557.         SEGADJ,MLIPEG
  558.       ENDIF
  559.       NUMPEG(NBPEGR,1) = NUMPH
  560.       JG = NBPHT
  561.       SEGINI,MLENTI
  562.       NUMPEG(NBPEGR,2) = MLENTI
  563. C... Lecture du nom du groupe (RECORD 2)
  564.       READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  565.       j = LONG(TEXT)
  566.       NOMPEG(NBPEGR) = TEXT(1:j)
  567.       WRITE(IOIMP,FMT='(4X,9HGroupe lu,3X,I2,3H = ,A)')
  568.      &            NUMPH,NOMPEG(NBPEGR)
  569. C... Lecture de chaque entite du groupe
  570.       i = 0
  571.       kelt = 0
  572.       knoe = NBPHT+1
  573.       k = 0
  574. 32477 CONTINUE
  575.         k = k + 1
  576.         IF (k.EQ.1) THEN
  577.           READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  578.           NRAN=0
  579.           ICOUR=NCARMAX
  580.           IFINAN=NCARFIN
  581.         ELSE
  582.           k = 0
  583.         ENDIF
  584.         DO j = 1, 4
  585.           CALL REDLEC(sredle)
  586.           IF (IRE.NE.1) THEN
  587.             IF (j.EQ.1) THEN
  588.               IF (k.EQ.1) THEN
  589.                 iOK=8
  590.                 GOTO 991
  591.               ELSE
  592.                 GOTO 32477
  593.               ENDIF
  594.             ENDIF
  595.           ENDIF
  596.           IF (j.EQ.1) THEN
  597.             IDPTR=NFIX
  598.           ELSE IF (j.EQ.2) THEN
  599.             NUMPR=NFIX
  600.           ENDIF
  601.         ENDDO
  602.         i = i + 1
  603. C... On ne conserve que les noeuds (POI1) et les elements
  604.         IF (IDPTR.EQ.7) THEN
  605.           knoe = knoe - 1
  606.           LECT(knoe) = NUMPR
  607.         ELSE IF (IDPTR.EQ.8) THEN
  608.           kelt = kelt + 1
  609.           LECT(kelt) = NUMPR
  610.         ENDIF
  611.         IF (i.EQ.NBPHT) GOTO 42477
  612.       GOTO 32477
  613. 42477 CONTINUE
  614.       knoe = NBPHT+1 - knoe
  615.       NUMPEG(NBPEGR,3) = knoe
  616.       NUMPEG(NBPEGR,4) = kelt
  617.       IF (knoe.GT.0) NBPEGP = NBPEGP+1
  618.       IF (kelt.GT.0) NBPEGE = NBPEGE+1
  619.       IF (knoe.EQ.0 .AND. kelt.EQ.0) THEN
  620.         NBPEGR = NBPEGR-1
  621.         SEGSUP,MLENTI
  622.       ENDIF
  623.       GOTO 12477
  624. C... Fin du bloc
  625. 22477 CONTINUE
  626.       WRITE(IOIMP,*) '   Nombre de groupes conserves :',NBPEGR
  627.       DO i = 1, NBPEGR
  628.         j = LONG(NOMPEG(i))
  629.         IF (NUMPEG(i,4).EQ.0) THEN
  630.           WRITE(IOIMP,FMT=2001) NUMPEG(i,1),NOMPEG(i)(1:j)
  631.         ELSE
  632.           IF (NUMPEG(i,3).EQ.0) THEN
  633.             WRITE(IOIMP,FMT=2002) NUMPEG(i,1),NOMPEG(i)(1:j)
  634.           ELSE
  635.             WRITE(IOIMP,FMT=2000) NUMPEG(i,1)
  636.             WRITE(IOIMP,FMT=2002) NUMPEG(i,1),NOMPEG(i)(1:j)//'   '
  637.             WRITE(IOIMP,FMT=2001) NUMPEG(i,1),NOMPEG(i)(1:j)//'_GN'
  638.           ENDIF
  639.         ENDIF
  640.       ENDDO
  641.  2000 FORMAT(4X,I4,' ==> Groupe separe en 2 parties :')
  642.  2001 FORMAT(4X,I4,' = ',A,'  -> GroupeNoeuds')
  643.  2002 FORMAT(4X,I4,' = ',A,'  -> GroupeElements')
  644. c*      IF (NBPEGR.NE.JGPEG) THEN
  645. c*        JGPEG = NBPEGR
  646. c*        SEGADJ,MLIPEG
  647. c*      ENDIF
  648.       I_BLOC = 1-I_BLOC
  649.       WRITE(IOIMP,*) '<- Lecture du DATASET 2477 terminee'
  650.       GOTO 10
  651.  
  652. C= Fin normale de la lecture
  653.  100  CONTINUE
  654.       WRITE(IOIMP,*) 'FIN LECTURE DES DATASET'
  655.  
  656. C= Traitement des differents DATASET lus
  657.  
  658. C= Creation d'une liste croissante des noeuds selon leur numero lu
  659. C= Creation d'un maillage de POI1 contenant tous les noeuds lus
  660. C* Mettre une option pour creer ce maillage ?
  661.       IF (MLINOE.NE.0) THEN
  662.         NBNN=1
  663.         NBELEM=NBNPTS
  664.         NBSOUS=0
  665.         NBREF=0
  666.         SEGINI,MELEME
  667.         ITYPEL=1
  668.         DO i=1,NBNPTS
  669.           NUM(1,i)=i+NBANC
  670.         ENDDO
  671.         SEGDES,MELEME
  672.         CALL ECCTAB(MATAB,'MOT     ',i_z,r_z,'NOEUDS',b_z,  i_z ,
  673.      &                    'MAILLAGE',i_z,r_z, mot_z  ,b_z,MELEME)
  674.         JG = NBNPTS
  675.         SEGINI,MLINO2
  676.         MLINO2.LECT(1)=1
  677.         DO i=2,NBNPTS
  678.           INOE = MLINOE.LECT(i)
  679.           DO j=i-1,1,-1
  680.             JNO2 = MLINO2.LECT(j)
  681.             JNOE = MLINOE.LECT(JNO2)
  682.             IF (JNOE.LE.INOE) GOTO 101
  683.             MLINO2.LECT(j+1) = JNO2
  684.           ENDDO
  685.  101      CONTINUE
  686.           MLINO2.LECT(j+1) = i
  687.         ENDDO
  688.       ENDIF
  689. C= Creation du maillage contenant l'ensemble des elements lus ayant
  690. C= une correspondance dans Cast3m
  691.       IF (MLIELT.NE.0) THEN
  692.         IF (MLINOE.EQ.0) THEN
  693.           WRITE(IOIMP,*) 'ERREUR : DATASET 2411 non lu'
  694.           iOK = 21
  695.           GOTO 991
  696.         ENDIF
  697.         JGMAI = NBEFLU
  698.         SEGINI,MLIMAI
  699.         NBSOUS=0
  700.         NBREF=0
  701.         NBMAIS=0
  702.         icoul=0
  703.         DO i = 1, NBEFLU
  704.           NUMEF = ITYPE(i,1)
  705. C*          IF (NUMEF.LE.0) GOTO 110
  706.           CALL PLACE2(LEFUNV,NEFUNV,IRETOU,NUMEF)
  707.           IF (IRETOU.EQ.0) THEN
  708.             WRITE(IOIMP,*) 'FE ID non reconnu : ',NUMEF
  709.             GOTO 110
  710.           ENDIF
  711.           IF (LEFGEO(IRETOU).EQ.0) THEN
  712.             WRITE(IOIMP,*) NUMEF,' sans correspondance dans C3M'
  713.             GOTO 110
  714.           ENDIF
  715.           NBNN  =ITYPE(i,2)
  716.           NBELEM=ITYPE(i,3)
  717.           MLENTI=ITYPE(i,5)
  718.           icoul = icoul + 1
  719.           IF (icoul.EQ.NBCOUL) icoul=1
  720.           NBMAIS=NBMAIS+1
  721. C*          ITYPE(i,1)=LEFGEO(IRETOU)
  722.           ITYPE(i,4)=NBMAIS
  723.           SEGINI,PTMAI(NBMAIS)
  724.           IPT1=PTMAI(NBMAIS)
  725.           IPT1.ITYPEL=LEFGEO(IRETOU)
  726.           TYMAI(NBMAIS)=LEFGEO(IRETOU)
  727.           NBNOEL=0
  728.           DO j = 1, NBELEM
  729.             DO k = 1, NBNN
  730.               INOE = LECT(NBNOEL+k)
  731.               lInf = 1
  732.               lSup = NBNPTS
  733.  111          CONTINUE
  734.               IF (lInf.GT.lSup) THEN
  735.                 WRITE(IOIMP,*) 'ERREUR : Noeud',INOE,'pas dans 2411'
  736.                 iOK=21
  737.                 GOTO 991
  738.               ENDIF
  739.               lMil = (lInf+lSup)/2
  740.               l = MLINO2.LECT(lMil)
  741.               JNOE = MLINOE.LECT(l)
  742.               IF (INOE.EQ.JNOE) THEN
  743.                 GOTO 112
  744.               ELSE IF (INOE.LT.JNOE) THEN
  745.                 lSup = lMil - 1
  746.               ELSE
  747.                 lInf = lMil + 1
  748.               ENDIF
  749.               GOTO 111
  750.  112          CONTINUE
  751.               IPT1.NUM(k,j) = NBANC+l
  752.               LECT(NBNOEL+k) = NBANC+l
  753.             ENDDO
  754.             IPT1.ICOLOR(j)=icoul
  755.             NBNOEL=NBNOEL+NBNN
  756.           ENDDO
  757.           SEGDES,PTMAI(NBMAIS)
  758.  110      CONTINUE
  759.           MLENTI = ITYPE(i,5)
  760.           SEGDES,MLENTI
  761.         ENDDO
  762.         IF (JGMAI.NE.NBMAIS) THEN
  763.           JGMAI=NBMAIS
  764.           SEGADJ,MLIMAI
  765.         ENDIF
  766.         IF (NBMAIS.EQ.0) THEN
  767.           WRITE(IOIMP,*) 'Pas de maillage au sens Cast3m'
  768.           CALL ECCTAB(MATAB,'MOT     ',i_z,r_z,'MAILLAGE',b_z,i_z,
  769.      &                      'MOT     ',i_z,r_z,  'VIDE'  ,b_z,i_z)
  770.         ELSE
  771.           nom_z(1:5) = '@    '
  772.           DO i = 1, NBMAIS
  773.             IPT1=PTMAI(i)
  774.             j   =TYMAI(i)
  775.             nom_z(2:5) = NOMS(j)(1:4)
  776.             CALL ECCTAB(MATAB,'MOT     ',i_z,r_z,nom_z(1:5),b_z,i_z ,
  777.      &                        'MAILLAGE',i_z,r_z,   mot_z  ,b_z,IPT1)
  778.           ENDDO
  779.           IF (NBMAIS.EQ.1) THEN
  780.             IPT2=PTMAI(1)
  781.           ELSE
  782.             NBSOUS=NBMAIS
  783.             NBREF =0
  784.             NBNN  =0
  785.             NBELEM=0
  786.             SEGINI,IPT2
  787.             DO i = 1, NBSOUS
  788.               IPT2.LISOUS(i)=PTMAI(i)
  789.             ENDDO
  790.             SEGDES,IPT2
  791.           ENDIF
  792.           CALL ECCTAB(MATAB,'MOT     ',i_z,r_z,'MAILLAGE',b_z,i_z ,
  793.      &                      'MAILLAGE',i_z,r_z,  mot_z   ,b_z,IPT2)
  794.         ENDIF
  795.       ENDIF
  796. C= Creation des maillages (groupes d'elements) associes a chaque
  797. C= propriete physique lue (elements avec une correspondance dans Cast3m)
  798.       IF (MLIPHY.NE.0) THEN
  799.         IF (MLIELT.EQ.0) THEN
  800.           WRITE(IOIMP,*) 'ERREUR : DATASET 2412 non lu'
  801.           iOK = 21
  802.           GOTO 991
  803.         ENDIF
  804.         IF (NBMAIS.EQ.0) THEN
  805.           WRITE(IOIMP,*) 'Pas de GROUPE associe aux proprietes'
  806.         ELSE
  807.           JG=NBMAIS
  808.           SEGINI,MLENTI,MLENT1
  809.           DO j=1,NBMAIS
  810.             SEGACT,PTMAI(j)
  811.           ENDDO
  812.           icoul = 1
  813.           DO i = 1, NBPHYS
  814.             NUMPP = NUMPHY(i)
  815.             PTPHY(i) = 0
  816.             DO j=1,NBMAIS
  817.               LECT(j)=0
  818.               MLENT1.LECT(j)=0
  819.             ENDDO
  820.             DO j=1,NBELTS
  821.               IF (IELEM(j,2).EQ.NUMPP) THEN
  822.                 k = ITYPE(IELEM(j,3),4)
  823.                 IF (k.NE.0) LECT(k)=LECT(k)+1
  824.               ENDIF
  825.             ENDDO
  826.             NMAIPH=0
  827.             NBSOUS=0
  828.             NBREF =0
  829.             DO j=1,NBMAIS
  830.               NBELEM=LECT(j)
  831.               IF (NBELEM.NE.0) THEN
  832.                 NMAIPH=NMAIPH+1
  833.                 IPT1=PTMAI(j)
  834.                 NBNN=IPT1.NUM(/1)
  835.                 SEGINI,MELEME
  836.                 ITYPEL=IPT1.ITYPEL
  837.                 DO k=1,NBELEM
  838.                   ICOLOR(k)=icoul
  839.                 ENDDO
  840.                 LECT(j)=MELEME
  841.               ENDIF
  842.             ENDDO
  843.             IF (NMAIPH.EQ.0) GOTO 120
  844.             DO j=1,NBELTS
  845.               IF (IELEM(j,2).EQ.NUMPP) THEN
  846.                 k = ITYPE(IELEM(j,3),4)
  847.                 IF (k.NE.0) THEN
  848.                   IPT1  =PTMAI(k)
  849.                   MELEME=LECT(k)
  850.                   NBNN = NUM(/1)
  851.                   iel1 = IELEM(j,4)
  852.                   iel2 = MLENT1.LECT(k)+1
  853.                   DO l=1,NBNN
  854.                     NUM(l,iel2)=IPT1.NUM(l,iel1)
  855.                   ENDDO
  856.                   MLENT1.LECT(k) = iel2
  857.                 ENDIF
  858.               ENDIF
  859.             ENDDO
  860.             DO j=1,NBMAIS
  861.               MELEME=LECT(j)
  862.               IF (MELEME.NE.0) SEGDES,MELEME
  863.             ENDDO
  864.             IF (NMAIPH.EQ.1) THEN
  865.               DO j=1,NBMAIS
  866.                 MELEME=LECT(j)
  867.                 IF (MELEME.NE.0) PTPHY(i)=MELEME
  868.               ENDDO
  869.             ELSE
  870.               NBNN=0
  871.               NBREF=0
  872.               NBSOUS=NMAIPH
  873.               SEGINI,MELEME
  874.               ISOUS=0
  875.               DO j=1,NBMAIS
  876.                 IPT1=LECT(j)
  877.                 IF (IPT1.NE.0) THEN
  878.                   ISOUS=ISOUS+1
  879.                   LISOUS(ISOUS)=IPT1
  880.                 ENDIF
  881.               ENDDO
  882.               SEGDES,MELEME
  883.               PTPHY(i)=MELEME
  884.             ENDIF
  885.             icoul = icoul + 1
  886.             IF (icoul.EQ.16) icoul=icoul-15
  887.  120        CONTINUE
  888.           ENDDO
  889.           SEGSUP,MLENTI,MLENT1
  890.           DO j=1,NBMAIS
  891.             SEGDES,PTMAI(j)
  892.           ENDDO
  893.           DO i = 1, NBPHYS
  894.             IPT1=PTPHY(i)
  895.             IF (IPT1.NE.0) THEN
  896.               nom_z = NOMPHY(i)
  897.               CALL ECCTAB(MATAB,'MOT     ',i_z,r_z,nom_z,b_z,i_z,
  898.      &                          'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1)
  899.             ENDIF
  900.           ENDDO
  901.         ENDIF
  902.       ENDIF
  903. C= Creation des groupes de noeuds ou d'elements ("permanents")
  904. C= Pour permettre la lecture d'"anciens" fichiers UNV...
  905.       IF (MLIPEG.NE.0) THEN
  906.         IF (MLIELT.EQ.0) THEN
  907.           WRITE(IOIMP,*) 'ERREUR : DATASET 2412 non lu'
  908.           iOK = 21
  909.           GOTO 991
  910.         ENDIF
  911. C= Creation d'une liste croissante des elements selon leur numero lu
  912. C= (uniquement s'il y des elements dans les groupes "permanents")
  913.         IF (NBPEGE.NE.0) THEN
  914.           JG = NBELTS
  915.           SEGINI,MLIEL2
  916.           MLIEL2.LECT(1) = 1
  917.           DO i = 2, NBELTS
  918.             INOE = IELEM(i,1)
  919.             DO j = i-1, 1, -1
  920.               JNO2 = MLIEL2.LECT(j)
  921.               JNOE = IELEM(JNO2,1)
  922.               IF (JNOE.LE.INOE) GOTO 130
  923.               MLIEL2.LECT(j+1) = JNO2
  924.             ENDDO
  925.  130        CONTINUE
  926.             MLIEL2.LECT(j+1) = i
  927.           ENDDO
  928.         ENDIF
  929. C*
  930.         icoul = 1
  931.         JG = NBEFLU
  932.         SEGINI,MLENT1
  933.         DO i = 1, NBPEGR
  934.           DO j = 1, NBEFLU
  935.             MLENT1.LECT(j) = 0
  936.           ENDDO
  937. c*        NUMPH  = NUMPEG(i,1)
  938.           MLENTI = NUMPEG(i,2)
  939.           knoe   = NUMPEG(i,3)
  940.           kelt   = NUMPEG(i,4)
  941.           PTPEG(i)  = 0
  942.           PTPEGN(i) = 0
  943.           MELPOI = 0
  944.           IF (knoe.EQ.0) GOTO 133
  945.           NBNN   = 1
  946.           NBELEM = knoe
  947.           NBREF  = 0
  948.           NBSOUS = 0
  949.           SEGINI,MELEME
  950.           ITYPEL = 1
  951.           NBPHT = LECT(/1) - knoe
  952.           DO k = 1, knoe
  953.             INOE = LECT(NBPHT+k)
  954.             lInf = 1
  955.             lSup = NBNPTS
  956.  131        CONTINUE
  957.             IF (lInf.GT.lSup) THEN
  958.               WRITE(IOIMP,*) 'ERREUR : Noeud',INOE,'pas dans 2411'
  959.               iOK = 21
  960.               GOTO 991
  961.             ENDIF
  962.             lMil = (lInf+lSup)/2
  963.             l = MLINO2.LECT(lMil)
  964.             JNOE = MLINOE.LECT(l)
  965.             IF (INOE.EQ.JNOE) THEN
  966.               GOTO 132
  967.             ELSE IF (INOE.LT.JNOE) THEN
  968.               lSup = lMil - 1
  969.             ELSE
  970.               lInf = lMil + 1
  971.             ENDIF
  972.             GOTO 131
  973.  132        CONTINUE
  974.             NUM(1,k) = NBANC+l
  975.             ICOLOR(k) = icoul
  976.           ENDDO
  977.           SEGDES,MELEME
  978.           MELPOI = MELEME
  979.           PTPEG(i) = MELPOI
  980.           IF (kelt.EQ.0) GOTO 137
  981.  133      CONTINUE
  982.           PTPEGN(i) = MELPOI
  983.           DO k = 1, kelt
  984.             INOE = LECT(k)
  985.             lInf = 1
  986.             lSup = NBELTS
  987.  134        CONTINUE
  988.             IF (lInf.GT.lSup) THEN
  989.               WRITE(IOIMP,*) 'ERREUR : Element',INOE,'pas dans 2412'
  990.               iOK = 21
  991.               GOTO 991
  992.             ENDIF
  993.             lMil = (lInf+lSup)/2
  994.             l = MLIEL2.LECT(lMil)
  995.             JNOE = IELEM(l,1)
  996.             IF (INOE.EQ.JNOE) THEN
  997.               GOTO 135
  998.             ELSE IF (INOE.LT.JNOE) THEN
  999.               lSup = lMil - 1
  1000.             ELSE
  1001.               lInf = lMil + 1
  1002.             ENDIF
  1003.             GOTO 134
  1004.  135        CONTINUE
  1005.             LECT(k) = l
  1006.             JNOE = IELEM(l,3)
  1007.             MLENT1.LECT(JNOE) = MLENT1.LECT(JNOE) + 1
  1008.           ENDDO
  1009.           NBMAIS = 0
  1010.           NBREF  = 0
  1011.           NBSOUS = 0
  1012.           DO j = 1, NBEFLU
  1013.             NBELEM = MLENT1.LECT(j)
  1014.             IF (NBELEM.EQ.0) GOTO 136
  1015.             NBMAIS = NBMAIS + 1
  1016.             NUMEF = ITYPE(j,4)
  1017.             NBNN  = ITYPE(j,2)
  1018.             IPT1  = PTMAI(NUMEF)
  1019.             SEGACT,IPT1
  1020.             SEGINI,MELEME
  1021.             ITYPEL = IPT1.ITYPEL
  1022.             iel2 = 0
  1023.             DO k = 1, kelt
  1024.               JNOE = LECT(k)
  1025.               l = ITYPE(IELEM(JNOE,3),4)
  1026.               IF (l.EQ.NUMEF) THEN
  1027.                 iel1 = IELEM(JNOE,4)
  1028.                 iel2 = iel2 + 1
  1029.                 DO l = 1, NBNN
  1030.                   NUM(l,iel2) = IPT1.NUM(l,iel1)
  1031.                 ENDDO
  1032.                 ICOLOR(iel2) = icoul
  1033.               ENDIF
  1034.             ENDDO
  1035.             SEGDES,IPT1,MELEME
  1036.             MLENT1.LECT(j) = MELEME
  1037.  136        CONTINUE
  1038.           ENDDO
  1039.           IF (NBMAIS.EQ.1) THEN
  1040.             IPT2 = MELEME
  1041.           ELSE
  1042.             NBNN   = 0
  1043.             NBELEM = 0
  1044.             NBREF  = 0
  1045.             NBSOUS = NBMAIS
  1046.             SEGINI,IPT2
  1047.             ISOUS = 0
  1048.             DO j = 1, NBEFLU
  1049.               IPT1 = MLENT1.LECT(j)
  1050.               IF (IPT1.NE.0) THEN
  1051.                 ISOUS = ISOUS + 1
  1052.                 IPT2.LISOUS(ISOUS) = IPT1
  1053.               ENDIF
  1054.             ENDDO
  1055.             SEGDES,IPT2
  1056.           ENDIF
  1057.           PTPEG(i) = IPT2
  1058.  137      CONTINUE
  1059.           icoul = icoul + 1
  1060.           IF (icoul.EQ.16) icoul = icoul-15
  1061.         ENDDO
  1062.  
  1063.         DO i = 1, NBPEGR
  1064.           IPT1 = PTPEG(i)
  1065.           j = LONG(NOMPEG(i))
  1066.           nom_z = NOMPEG(i)(1:j)
  1067.           CALL ECCTAB(MATAB,'MOT     ',i_z,r_z,nom_z,b_z,i_z,
  1068.      &                      'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1)
  1069.           IPT1 = PTPEGN(i)
  1070.           IF (IPT1.NE.0) THEN
  1071.             nom_z = NOMPEG(i)(1:j)//'_GN'
  1072.             CALL ECCTAB(MATAB,'MOT     ',i_z,r_z,nom_z,b_z,i_z,
  1073.      &                        'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1)
  1074.           ENDIF
  1075.         ENDDO
  1076.  
  1077.       ENDIF
  1078.  
  1079. C= Ecriture de la TABLE contenant les donnees lues !
  1080.       iOK = 0
  1081.       CALL ECROBJ('TABLE   ',MATAB)
  1082.  
  1083. C= Menage et traitement des erreurs
  1084.  991  CONTINUE
  1085.       CLOSE(UNIT=IUUNV)
  1086.  
  1087.       IF (MLINOE.NE.0) SEGSUP,MLINOE
  1088.       IF (MLINO2.NE.0) SEGSUP,MLINO2
  1089.       IF (MLIELT.NE.0) SEGSUP,MLIELT
  1090.       IF (MLIEL2.NE.0) SEGSUP,MLIEL2
  1091.       IF (MLISEF.NE.0) THEN
  1092.         DO i = 1, NBEFLU
  1093.           MLENTI = ITYPE(i,5)
  1094.           SEGSUP,MLENTI
  1095.         ENDDO
  1096.         SEGSUP,MLISEF
  1097.       ENDIF
  1098.       IF (MLIMAI.NE.0) SEGSUP,MLIMAI
  1099.       IF (MLIPHY.NE.0) SEGSUP,MLIPHY
  1100.       IF (MLIPEG.NE.0) THEN
  1101.         DO i = 1, NUMPEG(/1)
  1102.           MLENTI = NUMPEG(i,2)
  1103.           IF (MLENTI.NE.0) SEGSUP,MLENTI
  1104.         ENDDO
  1105.         SEGSUP,MLIPEG
  1106.       ENDIF
  1107.  990  CONTINUE
  1108.       SEGSUP,sredle
  1109.       MTABLE=MATAB
  1110.       SEGDES,MTABLE
  1111.  
  1112. C= Traitement des erreurs
  1113.       IF (iOK.NE.0 .OR. IERR.NE.0) THEN
  1114.         IF (iOK.NE.0) CALL ERREUR(iOK)
  1115.         SEGSUP,MTABLE
  1116.         WRITE(IOIMP,*)
  1117.         WRITE(IOIMP,*) 'Retour a la configuration initiale'
  1118.         NBPTS = NBANC
  1119.         SEGADJ,MCOORD
  1120.         IF (IDIMI.NE.0) THEN
  1121.           CALL ECRENT(IDIMI)
  1122.           CALL ECRCHA('DIME')
  1123.           CALL OPTION(1)
  1124.         ELSE
  1125.           IDIM = IDIMI
  1126.         ENDIF
  1127.       ENDIF
  1128.  
  1129.       WRITE(IOIMP,*)
  1130.       RETURN
  1131.       END
  1132.  
  1133.  
  1134.  
  1135.  
  1136.  
  1137.  
  1138.  

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