1 : C MODICO SOURCE PV 09/03/12 21:29:00 6325 2 : SUBROUTINE MODICO(IPOI1,IEV1,ISOUS,ICOMP,IGA,IDR, 3 : * IEVG,IEVD,XVA,IVA,IEV) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : -INC SMCHAML 7 : -INC CCOPTIO 8 : -INC SMEVOLL 9 : -INC SMLREEL 10 : -INC SMNUAGE 11 : POINTEUR MLREE4.MLREEL 12 : MCHEL1=IPOI1 13 : MCHAM1=MCHEL1.ICHAML(ISOUS) 14 : MELVA1=MCHAM1.IELVAL(ICOMP) 15 : MNUAGE=MELVA1.IELCHE(1,1) 16 : NVFLO=0 17 : IA1=0 18 : IA2=0 19 : DO 203 INO=1,NUANOM(/2) 20 : IF (NUATYP(INO).EQ.'FLOTTANT')THEN 21 : IF (NVFLO.EQ.0)THEN 22 : IA1=INO 23 : ENDIF 24 : IF (NVFLO.EQ.1)THEN 25 : IA2=INO 26 : ENDIF 27 : NVFLO=NVFLO+1 28 : ENDIF 29 : 203 CONTINUE 30 : DO 204 IB=1,NUANOM(/2) 31 : IF (NUATYP(IB).EQ.'EVOLUTIO') GOTO 205 32 : 204 CONTINUE 33 : 205 NUAVFL=NUAPOI(IA1) 34 : IF (NVFLO.EQ.2.AND.IVA.EQ.2) THEN 35 : NUAVF1=NUAPOI(IA2) 36 : ENDIF 37 : NUAVIN=NUAPOI(IB) 38 : C 39 : MEVOL1=IEVG 40 : MEVOL2=IEVD 41 : SEGACT MEVOL1,MEVOL2 42 : KEVOL1=MEVOL1.IEVOLL(1) 43 : KEVOL2=MEVOL2.IEVOLL(1) 44 : SEGACT KEVOL1,KEVOL2 45 : MLREEL=KEVOL1.IPROGX 46 : MLREE1=KEVOL1.IPROGY 47 : MLREE2=KEVOL2.IPROGX 48 : MLREE3=KEVOL2.IPROGY 49 : SEGACT MLREEL,MLREE1,MLREE2,MLREE3 50 : XX=PROG(2)-MLREE2.PROG(2) 51 : YOGA=MLREE1.PROG(2)/PROG(2) 52 : YODR=MLREE3.PROG(2)/MLREE2.PROG(2) 53 : C 54 : C interpolation linéaire de module d'YOUNG 55 : C et de la contrainte de limite élastique 56 : C 57 : IF (IVA.EQ.1)THEN 58 : YOU1=(YOGA-YODR)/(NUAFLO(IGA)-NUAFLO(IDR))* 59 : & (XVA-NUAFLO(IDR))+YODR 60 : SIGY=(MLREE1.PROG(2)-MLREE3.PROG(2))/ 61 : & (NUAFLO(IGA)-NUAFLO(IDR))* 62 : & (XVA-NUAFLO(IDR))+MLREE3.PROG(2) 63 : ENDIF 64 : IF (IVA.EQ.2)THEN 65 : YOU1=(YOGA-YODR)/(NUAVF1.NUAFLO(IGA)-NUAVF1.NUAFLO(IDR))* 66 : & (XVA-NUAVF1.NUAFLO(IDR))+YODR 67 : SIGY=(MLREE1.PROG(2)-MLREE3.PROG(2))/ 68 : & (NUAVF1.NUAFLO(IGA)-NUAVF1.NUAFLO(IDR))* 69 : & (XVA-NUAVF1.NUAFLO(IDR))+MLREE3.PROG(2) 70 : ENDIF 71 : C 72 : SEGDES MEVOL1,MEVOL2,KEVOL1,KEVOL2 73 : SEGDES MLREEL,MLREE1,MLREE2,MLREE3 74 : C 75 : MEVOL1=IEV1 76 : SEGINI,MEVOLL=MEVOL1 77 : IEV=MEVOLL 78 : KEVOL1=IEVOLL(1) 79 : SEGINI,KEVOLL=KEVOL1 80 : IEVOLL(1)=KEVOLL 81 : MLREE1=IPROGX 82 : MLREE2=IPROGY 83 : SEGINI,MLREE3=MLREE1 84 : IPROGX=MLREE3 85 : SEGINI,MLREE4=MLREE2 86 : IPROGY=MLREE4 87 : YOU2=MLREE4.PROG(2)/MLREE3.PROG(2) 88 : C On teste le module d'Young 89 : TEST2=DABS((YOU2 - YOU1)/YOU2) 90 : IF (TEST2.GT.1.D-10) THEN 91 : IEV=0 92 : INTERR(1)=IEV1 93 : MOTERR(1:30)='est mal interpolé. Voir MODICO' 93 : CALL ERREUR(633) 94 : GOTO 1 95 : ENDIF 96 : C On modifie la courbe de traction : le point 2 sur 97 : C la courbe est le point d'intersection de 2 droite 98 : IF (MLREE3.PROG(/1).GT.3) THEN 99 : X1=MLREE3.PROG(3) 100 : X2=MLREE3.PROG(4) 101 : Y1=MLREE4.PROG(3) 102 : Y2=MLREE4.PROG(4) 103 : IF (DABS(XX).GT.1.D-20) THEN 104 : XK2=(Y1-Y2)/(X1-X2) 105 : X2NEW=(XK2*X1-Y1)/(XK2-YOU1) 106 : Y2NEW=YOU1*X2NEW 107 : MLREE3.PROG(2)=X2NEW 108 : MLREE4.PROG(2)=Y2NEW 109 : C write(6,*) 'K : ',XK2 110 : C write(6,*) 'X1 : ',X1 111 : C write(6,*) 'E : ',YOU1 112 : C write(6,*) 'Y1 : ',Y1 113 : C write(6,*) 'e_new : ',X2new 114 : C write(6,*) 'Y_new : ',Y2NEW 115 : C write(6,*) ' ' 116 : C write(6,*) '----------------------------------------' 117 : ENDIF 118 : ENDIF 119 : 1 SEGDES MLREE3,MLREE4,KEVOLL,MEVOLL 120 : RETURN 121 : END 122 : 123 : 124 : 125 : 126 :
© Cast3M 2003 - All rights reserved.
Disclaimer