1 : C VERINU SOURCE PV 09/03/12 21:36:55 6325 2 : SUBROUTINE VERINU(IPOI1,ISOUS,IYOUN,ICOMP) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : * 6 : -INC SMCHAML 7 : -INC CCOPTIO 8 : -INC SMEVOLL 9 : -INC SMLREEL 10 : -INC SMNUAGE 11 : DATA NCOMAX/130/ 12 : C 13 : MCHEL1=IPOI1 14 : MCHAM1=MCHEL1.ICHAML(ISOUS) 15 : MELVA1=MCHAM1.IELVAL(ICOMP) 16 : MNUAGE=MELVA1.IELCHE(1,1) 17 : DO 203 IA=1,NUANOM(/2) 18 : IF (NUATYP(IA).EQ.'FLOTTANT') GOTO 204 19 : 203 CONTINUE 20 : 204 CONTINUE 21 : DO 205 IB=1,NUANOM(/2) 22 : IF (NUATYP(IB).EQ.'EVOLUTIO') GOTO 206 23 : 205 CONTINUE 24 : 206 CONTINUE 25 : NUAVFL=NUAPOI(IA) 26 : NUAVIN=NUAPOI(IB) 27 : NBC1=NUAFLO(/1) 28 : MELVA2=MCHAM1.IELVAL(IYOUN) 29 : SEGACT MELVA2 30 : C 31 : C Le module d'Young est défini par un FLOTTANT 32 : C 33 : IF(MCHAM1.TYPCHE(IYOUN)(1:6).EQ.'REAL*8') THEN 34 : IF (MELVA2.VELCHE(/1).NE.1) THEN 34 : CALL ERREUR(632) 35 : GOTO 214 36 : ENDIF 37 : YOU1=MELVA2.VELCHE(1,1) 38 : DO 211 IC=1,NBC1 39 : MEVOLL=NUAINT(IC) 40 : INTERR(1)=MEVOLL 41 : SEGACT MEVOLL 42 : KEVOLL=IEVOLL(1) 43 : SEGACT KEVOLL 44 : MLREEL=IPROGX 45 : MLREE1=IPROGY 46 : SEGDES MEVOLL,KEVOLL 47 : SEGACT MLREEL,MLREE1 48 : C Verif des points définis la courbe de traction 49 : IF(PROG(/1).LT.3) THEN 50 : MOTERR(1:30)='n a pas assze de points ' 51 : GOTO 212 52 : ENDIF 53 : IF(PROG(/1).GT.NCOMAX+1) THEN 54 : MOTERR(1:30)='est définie par trop de points' 55 : GOTO 212 56 : ENDIF 57 : C Verif de la croissance de l'abscisse 58 : DO 218 I=2,PROG(/1) 59 : IF(PROG(I).LE.PROG(I-1)) THEN 60 : MOTERR(1:30)='doit être en axe X croissante ' 61 : GOTO 212 62 : ENDIF 63 : 218 CONTINUE 64 : C Verif de l'origine 65 : IF(MLREE1.PROG(1).NE.0.D0.OR.PROG(1).NE.0.D0 66 : $ .OR.PROG(2).EQ.0.D0) THEN 67 : MOTERR(1:30)='manque l origine ' 68 : GOTO 212 69 : ENDIF 70 : C Verif de la limite élastique 71 : IF(MLREE1.PROG(2).EQ.0.D0) THEN 72 : MOTERR(1:30)='a une limite élastique nulle ' 73 : GOTO 212 74 : ENDIF 75 : C Verif de la pente avec le module D'YOUNG 76 : PENTE=MLREE1.PROG(2)/PROG(2) 77 : RA=ABS(PENTE-YOU1)/YOU1 78 : IF(RA.GT.5.D-3) THEN 79 : MOTERR(1:30)='a une pente non égale à E (MY)' 80 : GOTO 212 81 : ENDIF 82 : C Verif des autres pentes 83 : DO 213 IX=3,PROG(/1) 84 : IY=IX-1 85 : DEPS=PROG(IX)-PROG(IY) 86 : IF(DEPS.EQ.0.D0) THEN 87 : MOTERR(1:30)='a des EPSI en x de même valeur' 88 : GOTO 212 89 : ENDIF 90 : PENT1=(MLREE1.PROG(IX)-MLREE1.PROG(IY))/DEPS 91 : IF(PENT1.GE.PENTE) THEN 92 : MOTERR(1:30)='a une pente >EG à son E (MY) ' 93 : GO TO 212 94 : ENDIF 95 : 213 CONTINUE 96 : SEGDES MLREEL,MLREE1 97 : 211 CONTINUE 98 : GOTO 214 99 : 212 CONTINUE 100 : SEGDES MLREEL,MLREE1 100 : CALL ERREUR(633) 101 : ELSEIF (MCHAM1.TYPCHE(IYOUN)(9:16).EQ.'EVOLUTIO')THEN 102 : C Le module d'Young est défini par un objet EVOLUTIO 103 : MEVOLL=MELVA2.IELCHE(1,1) 104 : SEGACT MEVOLL 105 : IF(MEVOLL.IEVOLL(/1).NE.1) THEN 106 : MOTERR(1:8)='EVOLUTIO' 107 : INTERR(1)=MEVOLL 107 : CALL ERREUR(110) 108 : SEGDES MEVOLL 109 : GOTO 214 110 : ENDIF 111 : IF(MEVOLL.ITYEVO.NE.'REEL ')THEN 112 : MOTERR(1:8)='EVOLUTIO' 113 : MOTERR(9:16)='REEL ' 113 : CALL ERREUR(79) 114 : SEGDES MEVOLL 115 : GOTO 214 116 : ENDIF 117 : KEVOLL=IEVOLL(1) 118 : SEGACT KEVOLL 119 : IF(KEVOLL.TYPX.NE.'LISTREEL'.OR. 120 : $ KEVOLL.TYPY.NE.'LISTREEL')THEN 121 : MOTERR(1:8)='EVOLUTIO' 122 : MOTERR(9:16)='LISTREEL' 123 : INTERR(1)=MEVOLL 123 : CALL ERREUR(630) 124 : SEGDES MEVOLL,KEVOLL 125 : GOTO 214 126 : ENDIF 127 : MLREEL=IPROGX 128 : MLREE1=IPROGY 129 : SEGACT MLREEL,MLREE1 130 : LON=MLREE1.PROG(/1) 131 : DO 215 IC=1,NBC1 132 : VA1=NUAFLO(IC) 132 : CALL INTER2(VA1,MLREEL,MLREE1,LON,YOU1,IRET) 133 : IF (IRET.EQ.0) THEN 134 : SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 135 : GOTO 214 136 : ENDIF 137 : MEVOL1=NUAINT(IC) 138 : INTERR(1)=MEVOL1 139 : SEGACT MEVOL1 140 : KEVOL1=MEVOL1.IEVOLL(1) 141 : SEGACT KEVOL1 142 : IF(KEVOLL.NOMEVX(1:8).NE.NUANOM(IA)(1:8)) THEN 143 : INTERR(1)=MEVOLL 144 : INTERR(2)=IA 145 : INTERR(3)=MNUAGE 145 : CALL ERREUR(634) 146 : SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 147 : SEGDES MEVOL1,KEVOL1 148 : GOTO 214 149 : ENDIF 150 : MLREE2=KEVOL1.IPROGX 151 : MLREE3=KEVOL1.IPROGY 152 : SEGACT MLREE2,MLREE3 153 : C Verif des points définis la courbe de traction 154 : IF(MLREE2.PROG(/1).LT.3) THEN 155 : MOTERR(1:30)='n a pas assze de points ' 156 : GOTO 216 157 : ENDIF 158 : IF(MLREE2.PROG(/1).GT.NCOMAX+1) THEN 159 : MOTERR(1:30)='est définie par trop de points' 160 : GOTO 216 161 : ENDIF 162 : C Verif de la croissance de l'abscisse 163 : DO 219 I=2,MLREE2.PROG(/1) 164 : IF(MLREE2.PROG(I).LE.MLREE2.PROG(I-1)) THEN 165 : MOTERR(1:30)='doit être en axe X croissante ' 166 : GOTO 216 167 : ENDIF 168 : 219 CONTINUE 169 : C Verif de l'origine 170 : IF(MLREE3.PROG(1).NE.0.D0.OR.MLREE2.PROG(1).NE.0.D0 171 : $ .OR.MLREE2.PROG(2).EQ.0.D0) THEN 172 : MOTERR(1:30)='manque l origine ' 173 : GOTO 216 174 : ENDIF 175 : C Verif de la limite élastique 176 : IF(MLREE3.PROG(2).EQ.0.D0) THEN 177 : MOTERR(1:30)='a une limite élastique nulle ' 178 : GOTO 216 179 : ENDIF 180 : C Verif de la pente avec le module D'YOUNG 181 : PENTE=MLREE3.PROG(2)/MLREE2.PROG(2) 182 : RA=ABS(PENTE-YOU1)/YOU1 183 : IF(RA.GT.5.D-3) THEN 184 : MOTERR(1:30)='a une pente non égale à E (MY)' 185 : GOTO 216 186 : ENDIF 187 : C Verif des autres pentes 188 : DO 217 IX=3,MLREE2.PROG(/1) 189 : IY=IX-1 190 : DEPS=MLREE2.PROG(IX)-MLREE2.PROG(IY) 191 : IF(DEPS.EQ.0.D0) THEN 192 : MOTERR(1:30)='a des EPSI en x de même valeur' 193 : GOTO 216 194 : ENDIF 195 : PENT1=(MLREE3.PROG(IX)-MLREE3.PROG(IY))/DEPS 196 : IF(PENT1.GE.PENTE) THEN 197 : MOTERR(1:30)='a une pente >EG à son E (MY) ' 198 : GO TO 216 199 : ENDIF 200 : 217 CONTINUE 201 : SEGDES MEVOL1,KEVOL1,MLREE2,MLREE3 202 : 215 CONTINUE 203 : SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 204 : GOTO 214 205 : 216 CONTINUE 206 : SEGDES MEVOL1,KEVOL1,MLREE2,MLREE3 207 : SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 207 : CALL ERREUR(633) 208 : ENDIF 209 : 214 CONTINUE 210 : SEGDES MELVA2 211 : RETURN 212 : END 213 : 214 : 215 :
© Cast3M 2003 - All rights reserved.
Disclaimer