C CMAXTA SOURCE OF166741 25/02/20 21:15:35 12165 SUBROUTINE CMAXTA(WRK52,WRK53,WRK54,WR12,IB,IGAU,NBGMAT, & NELMAT,NWA,NCHAIN) C MAXTRA SOURCE AM 00/12/13 21:38:27 4045 * SUBROUTINE MAXTRA(WRK0,WRK1,WRK5,WR12,WTRAV,IB,IGAU,NBGMAT, * & NELMAT,NPINT,NWA,NSTRS,NCHAIN,CMATE,MFR) * * MODELE DE MAXWELL : RECUPERATION DES INFORMATIONS * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC PPARAM -INC CCOPTIO -INC SMEVOLL -INC SMLREEL -INC CCHAMP -INC DECHE * * SEGMENT WR12 REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) REAL*8 SM8(NSTRS) ENDSEGMENT * DIMENSION NWA(9),IPX(9),IPY(9) * ncxmat=xmat(/1) DO JC=1,9 NWA(JC)=0 IPX(JC)=0 IPY(JC)=0 END DO * ******* Cas d'une formulation isotrope IF(CMATE.EQ.'ISOTROPE') THEN * em0 MEVOLL=NINT(XMAT(3)) SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX IPX(1)=IPROGX IPY(1)=IPROGY SEGACT MLREEL NWA(1)=PROG(/1) SEGDES KEVOLL*NOMOD SEGDES MEVOLL*NOMOD * * em1 a em4 * KED=4 DO JC=2,5 MEVOLL=NINT(XMAT(KED)) KED=KED+2 SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX IPX(JC)=IPROGX IPY(JC)=IPROGY SEGACT MLREEL NWA(JC)=PROG(/1) SEGDES KEVOLL*NOMOD SEGDES MEVOLL*NOMOD END DO * NCHAIN=5 JED=0 IF(IFOUR.EQ.-2) JED=1 KED=15+JED DO JC=6,9 MEVOLL=NINT(XMAT(KED)) KED= KED+2 IF(MEVOLL.GT.0) THEN SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX IPX(JC)=IPROGX IPY(JC)=IPROGY SEGACT MLREEL NWA(JC)=PROG(/1) NCHAIN=NCHAIN+1 SEGDES KEVOLL*NOMOD SEGDES MEVOLL*NOMOD ENDIF END DO * ******* Cas d'une formulation unidirectionnelle ELSE IF(CMATE.EQ.'UNIDIREC') THEN * JED=0 IF(IFOUR.EQ.2) JED=4 * em0 MEVOLL=NINT(XMAT(4+JED)) SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX IPX(1)=IPROGX IPY(1)=IPROGY SEGACT MLREEL NWA(1)=PROG(/1) SEGDES KEVOLL*NOMOD SEGDES MEVOLL*NOMOD * * em1 a em4 * KED=5+JED DO JC=2,5 MEVOLL=NINT(XMAT(KED)) KED=KED+2 SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX IPX(JC)=IPROGX IPY(JC)=IPROGY SEGACT MLREEL NWA(JC)=PROG(/1) SEGDES KEVOLL*NOMOD SEGDES MEVOLL*NOMOD END DO * NCHAIN=5 JED=0 IF(IFOUR.EQ.-2) JED=1 IF(IFOUR.EQ. 2) JED=4 KED=15+JED DO JC=6,9 MEVOLL=NINT(XMAT(KED)) KED=KED+2 IF(MEVOLL.GT.0) THEN SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX IPX(JC)=IPROGX IPY(JC)=IPROGY SEGACT MLREEL NWA(JC)=PROG(/1) NCHAIN=NCHAIN+1 SEGDES KEVOLL*NOMOD SEGDES MEVOLL*NOMOD ENDIF END DO ENDIF * * creation du segment de travail * IF (WR12 .EQ. 0) THEN SEGINI,WR12 ELSE IF (EM0(/1).NE.2 .OR. EM0(/2).NE.NWA(1) .OR. & EM1(/2).NE.NWA(2) .OR. EM2(/2).NE.NWA(3) .OR. & EM3(/2).NE.NWA(4) .OR. EM4(/2).NE.NWA(5) .OR. & EM5(/2).NE.NWA(6) .OR. EM5(/2).NE.NWA(7) .OR. & EM7(/2).NE.NWA(8) .OR. EM8(/2).NE.NWA(9) .OR. & SM0(/1).NE. NSTRS) THEN SEGADJ,WR12 ENDIF ENDIF * * recuperation des proprietes materielles * et des variables internes * D'abord les composantes obligatoires * DO JC=1,5 MLREEL=IPX(JC) MLREE1=IPY(JC) SEGACT MLREE1 MLREE2=NINT(VAR0(JC+1)) SEGACT MLREE2 IF(JC.EQ.1) THEN DO JD=1,NWA(1) EM0(1,JD)=PROG(JD) EM0(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM0(JD)=MLREE2.PROG(JD) END DO ELSE IF(JC.EQ.2) THEN DO JD=1,NWA(2) EM1(1,JD)=PROG(JD) EM1(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM1(JD)=MLREE2.PROG(JD) END DO ELSE IF(JC.EQ.3) THEN DO JD=1,NWA(3) EM2(1,JD)=PROG(JD) EM2(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM2(JD)=MLREE2.PROG(JD) END DO ELSE IF(JC.EQ.4) THEN DO JD=1,NWA(4) EM3(1,JD)=PROG(JD) EM3(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM3(JD)=MLREE2.PROG(JD) END DO ELSE IF(JC.EQ.5) THEN DO JD=1,NWA(5) EM4(1,JD)=PROG(JD) EM4(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM4(JD)=MLREE2.PROG(JD) END DO ENDIF END DO * * traitement des composantes facultatives * DO JC=6,9 IF(IPX(JC).NE.0) THEN MLREEL=IPX(JC) MLREE1=IPY(JC) SEGACT MLREE1 MLREE2=NINT(VAR0(JC+1)) SEGACT MLREE2 IF(JC.EQ.6) THEN DO JD=1,NWA(6) EM5(1,JD)=PROG(JD) EM5(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM5(JD)=MLREE2.PROG(JD) END DO ELSE IF(JC.EQ.7) THEN DO JD=1,NWA(7) EM6(1,JD)=PROG(JD) EM6(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM6(JD)=MLREE2.PROG(JD) END DO ELSE IF(JC.EQ.8) THEN DO JD=1,NWA(8) EM7(1,JD)=PROG(JD) EM7(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM7(JD)=MLREE2.PROG(JD) END DO ELSE IF(JC.EQ.9) THEN DO JD=1,NWA(9) EM8(1,JD)=PROG(JD) EM8(2,JD)=MLREE1.PROG(JD) END DO DO JD=1,NSTRS SM8(JD)=MLREE2.PROG(JD) END DO ENDIF ENDIF END DO * * ROTATION DES TENSEURS SI BESOIN * * ******* Cas d'une formulation unidirectionnelle * IF(CMATE.EQ.'UNIDIREC') THEN IF(MFR.EQ.1.OR.MFR.EQ.33) THEN CALL CMAXRO(wrk52,wrk53,wrk54,IB,IGAU,NBGMAT,NELMAT) IF(IERR.NE.0) RETURN ICAS=1 CALL CMAXR2(wrk52,wrk53,wrk54,ICAS,WR12,NCHAIN) ELSE CALL ERREUR(251) RETURN ENDIF ENDIF * * DESACTIVATION DES SEGMENTS PROG * DO 10 JC=1,9 C# MC : la dimension est definie au depart = 9 IF (IPX(JC).EQ.0) GO TO 10 MLREEL=IPX(JC) SEGDES MLREEL*NOMOD MLREE1=IPY(JC) SEGDES MLREE1*NOMOD MLREE2=NINT(VAR0(JC+1)) SEGDES MLREE2*NOMOD 10 CONTINUE * RETURN END