C RLEORD SOURCE PV 20/03/30 21:24:14 10567 SUBROUTINE RLEORD(MELFL,MELFP,MELF1,MELFL1) C C C**** Variables de COOPTIO C C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM CC & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV C IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMELEME INTEGER NBSOUS,NBNN,NBELEM,NBREF POINTEUR MELF1.MELEME,MELFL.MELEME,MELFP.MELEME, & MELFL1.MELEME,MELFP1.MELEME C INTEGER JG -INC SMLENTI POINTEUR MLEFL.MLENTI,MLEFP.MLENTI INTEGER IELEM,NGF,NLF,ISOUS,INF,I1,IELEMF C SEGACT MELFL NBSOUS=MELFL.LISOUS(/1) IF(NBSOUS .NE. 0)THEN WRITE(IOIMP,*) 'subroutine rleord.eso' WRITE(IOIMP,*) 'FACEL???' CALL ERREUR(5) GOTO 9999 ENDIF C SEGINI, MELFL1=MELFL C NBELEM=MELFL.NUM(/2) NBNN=1 NBSOUS=0 NBREF=0 SEGINI MELF1 C JG=nbpts SEGINI MLEFL DO IELEM = 1, NBELEM, 1 NGF=MELFL.NUM(2,IELEM) MLEFL.LECT(NGF)=IELEM ENDDO C SEGACT MELFP NBSOUS=MELFP.LISOUS(/1) C NBSOUS=0 fais un peux chier! JG=MAX(NBSOUS,1) SEGINI MLEFP IF(NBSOUS .EQ. 0)THEN MLEFP.LECT(1)=MELFP ELSE DO ISOUS=1,NBSOUS,1 MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS) ENDDO ENDIF SEGDES MELFP NBSOUS=JG C IELEMF=0 DO ISOUS=1,NBSOUS,1 MELFP1=MLEFP.LECT(ISOUS) SEGACT MELFP1 NBELEM=MELFP1.NUM(/2) INF=MELFP1.NUM(/1) DO IELEM=1,NBELEM,1 IELEMF=IELEMF+1 NGF=MELFP1.NUM(INF,IELEM) NLF=MLEFL.LECT(NGF) IF(NLF .EQ. 0)THEN WRITE(IOIMP,*) 'subroutine rleord.eso' WRITE(IOIMP,*) 'FACEL???' CALL ERREUR(5) GOTO 9999 ENDIF MELF1.NUM(1,IELEMF)=NGF DO I1 = 1, 3 , 1 MELFL1.NUM(I1,IELEMF)=MELFL.NUM(I1,NLF) ENDDO ENDDO SEGDES MELFP1 ENDDO C SEGDES MELF1 SEGDES MELFL1 SEGDES MELFL C SEGSUP MLEFP SEGSUP MLEFL C 9999 RETURN END