Download rleord.eso

Back to the list

   1 : C RLEORD    SOURCE    CHAT      05/01/13    03:01:46     5004           
   2 :       SUBROUTINE RLEORD(MELFL,MELFP,MELF1,MELFL1)
   3 : C
   4 : C
   5 : C**** Variables de COOPTIO
   6 : C
   7 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
   8 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
   9 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  10 : C     &        ,IECHO,   IIMPI,  IOSPI
  11 : C     &        ,IDIM
  12 : CC     &        ,MCOORD      
  13 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  14 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  15 : C     &        ,NORINC,NORVAL,NORIND,NORVAD
  16 : C     &        ,NUCROU, IPSAUV
  17 : C
  18 :       IMPLICIT INTEGER(I-N)
  19 : -INC CCOPTIO
  20 : -INC SMCOORD
  21 : -INC SMELEME
  22 :       INTEGER NBSOUS,NBNN,NBELEM,NBREF
  23 :       POINTEUR MELF1.MELEME,MELFL.MELEME,MELFP.MELEME,
  24 :      &     MELFL1.MELEME,MELFP1.MELEME
  25 : C
  26 :       INTEGER JG
  27 : -INC SMLENTI
  28 :       POINTEUR MLEFL.MLENTI,MLEFP.MLENTI
  29 :       INTEGER IELEM,NGF,NLF,ISOUS,INF,I1,IELEMF
  30 : C
  31 :       SEGACT MELFL
  32 :       NBSOUS=MELFL.LISOUS(/1)
  33 :       IF(NBSOUS .NE. 0)THEN
  34 :          WRITE(IOIMP,*) 'subroutine rleord.eso'
  35 :          WRITE(IOIMP,*) 'FACEL???'
  35 :          CALL ERREUR(5)
  36 :          GOTO 9999
  37 :       ENDIF
  38 : C
  39 :       SEGINI, MELFL1=MELFL
  40 : C
  41 :       NBELEM=MELFL.NUM(/2)
  42 :       NBNN=1
  43 :       NBSOUS=0
  44 :       NBREF=0
  45 :       SEGINI MELF1
  46 : C
  47 :       JG=MCOORD.XCOOR(/1)/(IDIM+1)
  48 :       SEGINI MLEFL
  49 :       DO IELEM = 1, NBELEM, 1
  50 :          NGF=MELFL.NUM(2,IELEM)
  51 :          MLEFL.LECT(NGF)=IELEM
  52 :       ENDDO
  53 : C
  54 :       SEGACT MELFP
  55 :       NBSOUS=MELFP.LISOUS(/1)
  56 : C     NBSOUS=0 fais un peux chier!
  57 :       JG=MAX(NBSOUS,1)
  58 :       SEGINI MLEFP
  59 :       IF(NBSOUS .EQ. 0)THEN
  60 :          MLEFP.LECT(1)=MELFP
  61 :       ELSE
  62 :          DO ISOUS=1,NBSOUS,1
  63 :             MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS)
  64 :          ENDDO
  65 :       ENDIF
  66 :       SEGDES MELFP
  67 :       NBSOUS=JG
  68 : C
  69 :       IELEMF=0
  70 :       DO ISOUS=1,NBSOUS,1
  71 :          MELFP1=MLEFP.LECT(ISOUS)
  72 :          SEGACT MELFP1
  73 :          NBELEM=MELFP1.NUM(/2)
  74 :          INF=MELFP1.NUM(/1)
  75 :          DO IELEM=1,NBELEM,1
  76 :             IELEMF=IELEMF+1
  77 :             NGF=MELFP1.NUM(INF,IELEM)
  78 :             NLF=MLEFL.LECT(NGF)
  79 :             IF(NLF .EQ. 0)THEN
  80 :                WRITE(IOIMP,*) 'subroutine rleord.eso'
  81 :                WRITE(IOIMP,*) 'FACEL???'
  81 :                CALL ERREUR(5)
  82 :                GOTO 9999
  83 :             ENDIF
  84 :             MELF1.NUM(1,IELEMF)=NGF
  85 :             DO I1 = 1, 3 , 1
  86 :                MELFL1.NUM(I1,IELEMF)=MELFL.NUM(I1,NLF)
  87 :             ENDDO
  88 :          ENDDO
  89 :          SEGDES MELFP1
  90 :       ENDDO
  91 : C
  92 :       SEGDES MELF1
  93 :       SEGDES MELFL1
  94 :       SEGDES MELFL
  95 : C
  96 :       SEGSUP MLEFP
  97 :       SEGSUP MLEFL
  98 : C
  99 :  9999 RETURN
 100 :       END
 101 :          
 102 :       
 103 :       
 104 :       
 105 :  
 106 :  

© Cast3M 2003 - All rights reserved.
Disclaimer