C MODICO SOURCE CB215821 19/10/08 21:15:14 10329 SUBROUTINE MODICO(IPOI1,IEV1,ISOUS,ICOMP,IGA,IDR, * IEVG,IEVD,XVA,IVA,IEV) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC SMCHAML -INC PPARAM -INC CCOPTIO -INC SMEVOLL -INC SMLREEL -INC SMNUAGE POINTEUR MLREE4.MLREEL MCHEL1=IPOI1 MCHAM1=MCHEL1.ICHAML(ISOUS) MELVA1=MCHAM1.IELVAL(ICOMP) MNUAGE=MELVA1.IELCHE(1,1) NVFLO=0 IA1=0 IA2=0 DO 203 INO=1,NUANOM(/2) IF (NUATYP(INO).EQ.'FLOTTANT')THEN IF (NVFLO.EQ.0)THEN IA1=INO ENDIF IF (NVFLO.EQ.1)THEN IA2=INO ENDIF NVFLO=NVFLO+1 ENDIF 203 CONTINUE DO 204 IB=1,NUANOM(/2) IF (NUATYP(IB).EQ.'EVOLUTIO') GOTO 205 204 CONTINUE 205 NUAVFL=NUAPOI(IA1) IF (NVFLO.EQ.2.AND.IVA.EQ.2) THEN NUAVF1=NUAPOI(IA2) ENDIF NUAVIN=NUAPOI(IB) C MEVOL1=IEVG MEVOL2=IEVD KEVOL1=MEVOL1.IEVOLL(1) KEVOL2=MEVOL2.IEVOLL(1) MLREEL=KEVOL1.IPROGX MLREE1=KEVOL1.IPROGY MLREE2=KEVOL2.IPROGX MLREE3=KEVOL2.IPROGY XX=PROG(2)-MLREE2.PROG(2) YOGA=MLREE1.PROG(2)/PROG(2) YODR=MLREE3.PROG(2)/MLREE2.PROG(2) C C interpolation linéaire de module d'YOUNG C et de la contrainte de limite élastique C IF (IVA.EQ.1)THEN YOU1=(YOGA-YODR)/(NUAFLO(IGA)-NUAFLO(IDR))* & (XVA-NUAFLO(IDR))+YODR SIGY=(MLREE1.PROG(2)-MLREE3.PROG(2))/ & (NUAFLO(IGA)-NUAFLO(IDR))* & (XVA-NUAFLO(IDR))+MLREE3.PROG(2) ENDIF IF (IVA.EQ.2)THEN YOU1=(YOGA-YODR)/(NUAVF1.NUAFLO(IGA)-NUAVF1.NUAFLO(IDR))* & (XVA-NUAVF1.NUAFLO(IDR))+YODR SIGY=(MLREE1.PROG(2)-MLREE3.PROG(2))/ & (NUAVF1.NUAFLO(IGA)-NUAVF1.NUAFLO(IDR))* & (XVA-NUAVF1.NUAFLO(IDR))+MLREE3.PROG(2) ENDIF MEVOL1=IEV1 SEGINI,MEVOLL=MEVOL1 IEV=MEVOLL KEVOL1=IEVOLL(1) SEGINI,KEVOLL=KEVOL1 IEVOLL(1)=KEVOLL MLREE1=IPROGX MLREE2=IPROGY SEGINI,MLREE3=MLREE1 IPROGX=MLREE3 SEGINI,MLREE4=MLREE2 IPROGY=MLREE4 YOU2=MLREE4.PROG(2)/MLREE3.PROG(2) C On teste le module d'Young TEST2=ABS((YOU2 - YOU1)/YOU2) IF (TEST2.GT.1.D-10) THEN IEV=0 INTERR(1)=IEV1 MOTERR(1:30)='est mal interpolé. Voir MODICO' CALL ERREUR(633) RETURN ENDIF C On modifie la courbe de traction : le point 2 sur C la courbe est le point d'intersection de 2 droite IF (MLREE3.PROG(/1).GT.3) THEN X1=MLREE3.PROG(3) X2=MLREE3.PROG(4) Y1=MLREE4.PROG(3) Y2=MLREE4.PROG(4) IF (ABS(XX).GT.1.D-20) THEN XK2=(Y1-Y2)/(X1-X2) X2NEW=(XK2*X1-Y1)/(XK2-YOU1) Y2NEW=YOU1*X2NEW MLREE3.PROG(2)=X2NEW MLREE4.PROG(2)=Y2NEW C write(6,*) 'K : ',XK2 C write(6,*) 'X1 : ',X1 C write(6,*) 'E : ',YOU1 C write(6,*) 'Y1 : ',Y1 C write(6,*) 'e_new : ',X2new C write(6,*) 'Y_new : ',Y2NEW C write(6,*) ' ' C write(6,*) '----------------------------------------' ENDIF ENDIF END