C RLEXF2 SOURCE PV 09/03/12 21:33:53 6325 SUBROUTINE RLEXF2(MCHCEN,MCHLIM,MCHELM,MCHFAC) 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 C & ,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 CCOPTIO INTEGER NBNN, NBELEM -INC SMELEME -INC SMCHAML C -INC SMCHPOI POINTEUR MCHCEN.MCHPOI, MCHLIM.MCHPOI, MCHFAC.MCHPOI POINTEUR MPOCEN.MPOVAL, MPOLIM.MPOVAL, MPOFAC.MPOVAL C -INC SMLENTI POINTEUR MLECEN.MLENTI, MLELIM.MLENTI, MLEFAC.MLENTI C INTEGER IGEOM, NCOM, NBSOUS, ISOUS, IELEM, NGF, NLF, NGV, NLV & ,IVOI, ICOM, I2 REAL*8 VAL CHARACTER*8 NOM1 C LOGICAL LOGCEN CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM) IF(IERR.NE.0)GOTO 9999 NCOM=MPOCEN.VPOCHA(/2) C En LICHT SEGACT*MOD MPOCEN CALL KRIPAD(IGEOM,MLECEN) IF(IERR.NE.0)GOTO 9999 C C**** En KRIPAD C SEGACT IGEOM C SEGINI MLECEN C MELEME=IGEOM SEGDES MELEME C IF(MCHLIM.GT.0)THEN CALL LICHT(MCHLIM,MPOLIM,NOM1,IGEOM) IF(IERR.NE.0)GOTO 9999 C En LICHT SEGACT*MOD MPOLIM CALL KRIPAD(IGEOM,MLELIM) IF(IERR.NE.0)GOTO 9999 C C**** En KRIPAD C SEGACT IGEOM C SEGINI MLELIM C MELEME=IGEOM SEGDES MELEME ELSE MPOLIM=0 MLELIM=0 ENDIF C CALL LICHT(MCHFAC,MPOFAC,NOM1,IGEOM) IF(IERR.NE.0)GOTO 9999 C En LICHT SEGACT*MOD MPOFAC CALL KRIPAD(IGEOM,MLEFAC) IF(IERR.NE.0)GOTO 9999 C C**** En KRIPAD C SEGACT IGEOM C SEGINI MLEFAC C MELEME=IGEOM SEGDES MELEME C SEGACT MCHELM NBSOUS=MCHELM.IMACHE(/1) C DO ISOUS=1,NBSOUS,1 MELEME=MCHELM.IMACHE(ISOUS) MCHAM1=MCHELM.ICHAML(ISOUS) SEGACT MELEME SEGACT MCHAM1 MELVA1=MCHAM1.IELVAL(1) MELVA2=MCHAM1.IELVAL(2) SEGACT MELVA1 SEGACT MELVA2 NOM1=MCHAM1.NOMCHE(1) IF(NOM1 .NE. 'alphax ')THEN WRITE(IOIMP,*) NOM1, '!=', 'alphax ' C 21 2 C Données incompatibles CALL ERREUR(21) GOTO 9999 ENDIF NOM1=MCHAM1.NOMCHE(2) IF(NOM1 .NE. 'alphay ')THEN WRITE(IOIMP,*) NOM1, '!=', 'alphay ' C 21 2 C Données incompatibles CALL ERREUR(21) GOTO 9999 ENDIF IF(IDIM.EQ.3)THEN MELVA3=MCHAM1.IELVAL(3) SEGACT MELVA3 NOM1=MCHAM1.NOMCHE(3) IF(NOM1 .NE. 'alphaz ')THEN WRITE(IOIMP,*) NOM1, '!=', 'alphaz ' C 21 2 C Données incompatibles CALL ERREUR(21) GOTO 9999 ENDIF ENDIF C NBNN=MELEME.NUM(/1) NBELEM=MELEME.NUM(/2) C DO IELEM=1,NBELEM,1 NGF=MELEME.NUM(1,IELEM) NLF=MLEFAC.LECT(NGF) IF(NLF.EQ.0)THEN WRITE (IOIMP,*) 'subroutine rlexf2.eso' CALL ERREUR(5) GOTO 9999 ENDIF DO IVOI=2,NBNN,1 NGV=MELEME.NUM(IVOI,IELEM) NLV=MLECEN.LECT(NGV) IF(NLV.NE.0)THEN LOGCEN=.TRUE. ELSE LOGCEN=.FALSE. NLV=MLELIM.LECT(NGV) IF(NLV.EQ.0)THEN WRITE(IOIMP,*) 'subroutine rlexf2.eso' CALL ERREUR(5) GOTO 9999 ENDIF ENDIF DO ICOM = 1, NCOM, 1 IF(LOGCEN)THEN VAL=MPOCEN.VPOCHA(NLV,ICOM) ELSE VAL=MPOLIM.VPOCHA(NLV,ICOM) ENDIF I2=(ICOM-1)*IDIM+1 MPOFAC.VPOCHA(NLF,I2)=MPOFAC.VPOCHA(NLF,I2)+ & (MELVA1.VELCHE(IVOI,IELEM)*VAL) MPOFAC.VPOCHA(NLF,I2+1)=MPOFAC.VPOCHA(NLF,I2+1)+ & (MELVA2.VELCHE(IVOI,IELEM)*VAL) IF(IDIM.EQ.3) & MPOFAC.VPOCHA(NLF,I2+2)=MPOFAC.VPOCHA(NLF,I2+2)+ & (MELVA3.VELCHE(IVOI,IELEM)*VAL) ENDDO ENDDO ENDDO SEGDES MELEME SEGDES MCHAM1 SEGDES MELVA1 SEGDES MELVA2 IF(IDIM.EQ.3) SEGDES MELVA3 ENDDO C SEGDES MCHELM IF(MPOLIM .NE. 0) THEN SEGDES MPOLIM SEGSUP MLELIM ENDIF SEGDES MPOFAC SEGDES MPOCEN SEGSUP MLECEN SEGSUP MLEFAC C 9999 RETURN END