C VERINU SOURCE PV 09/03/12 21:36:55 6325 SUBROUTINE VERINU(IPOI1,ISOUS,IYOUN,ICOMP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC SMCHAML -INC CCOPTIO -INC SMEVOLL -INC SMLREEL -INC SMNUAGE DATA NCOMAX/130/ C MCHEL1=IPOI1 MCHAM1=MCHEL1.ICHAML(ISOUS) MELVA1=MCHAM1.IELVAL(ICOMP) MNUAGE=MELVA1.IELCHE(1,1) DO 203 IA=1,NUANOM(/2) IF (NUATYP(IA).EQ.'FLOTTANT') GOTO 204 203 CONTINUE 204 CONTINUE DO 205 IB=1,NUANOM(/2) IF (NUATYP(IB).EQ.'EVOLUTIO') GOTO 206 205 CONTINUE 206 CONTINUE NUAVFL=NUAPOI(IA) NUAVIN=NUAPOI(IB) NBC1=NUAFLO(/1) MELVA2=MCHAM1.IELVAL(IYOUN) SEGACT MELVA2 C C Le module d'Young est défini par un FLOTTANT C IF(MCHAM1.TYPCHE(IYOUN)(1:6).EQ.'REAL*8') THEN IF (MELVA2.VELCHE(/1).NE.1) THEN CALL ERREUR(632) GOTO 214 ENDIF YOU1=MELVA2.VELCHE(1,1) DO 211 IC=1,NBC1 MEVOLL=NUAINT(IC) INTERR(1)=MEVOLL SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX MLREE1=IPROGY SEGDES MEVOLL,KEVOLL SEGACT MLREEL,MLREE1 C Verif des points définis la courbe de traction IF(PROG(/1).LT.3) THEN MOTERR(1:30)='n a pas assze de points ' GOTO 212 ENDIF IF(PROG(/1).GT.NCOMAX+1) THEN MOTERR(1:30)='est définie par trop de points' GOTO 212 ENDIF C Verif de la croissance de l'abscisse DO 218 I=2,PROG(/1) IF(PROG(I).LE.PROG(I-1)) THEN MOTERR(1:30)='doit être en axe X croissante ' GOTO 212 ENDIF 218 CONTINUE C Verif de l'origine IF(MLREE1.PROG(1).NE.0.D0.OR.PROG(1).NE.0.D0 $ .OR.PROG(2).EQ.0.D0) THEN MOTERR(1:30)='manque l origine ' GOTO 212 ENDIF C Verif de la limite élastique IF(MLREE1.PROG(2).EQ.0.D0) THEN MOTERR(1:30)='a une limite élastique nulle ' GOTO 212 ENDIF C Verif de la pente avec le module D'YOUNG PENTE=MLREE1.PROG(2)/PROG(2) RA=ABS(PENTE-YOU1)/YOU1 IF(RA.GT.5.D-3) THEN MOTERR(1:30)='a une pente non égale à E (MY)' GOTO 212 ENDIF C Verif des autres pentes DO 213 IX=3,PROG(/1) IY=IX-1 DEPS=PROG(IX)-PROG(IY) IF(DEPS.EQ.0.D0) THEN MOTERR(1:30)='a des EPSI en x de même valeur' GOTO 212 ENDIF PENT1=(MLREE1.PROG(IX)-MLREE1.PROG(IY))/DEPS IF(PENT1.GE.PENTE) THEN MOTERR(1:30)='a une pente >EG à son E (MY) ' GO TO 212 ENDIF 213 CONTINUE SEGDES MLREEL,MLREE1 211 CONTINUE GOTO 214 212 CONTINUE SEGDES MLREEL,MLREE1 CALL ERREUR(633) ELSEIF (MCHAM1.TYPCHE(IYOUN)(9:16).EQ.'EVOLUTIO')THEN C Le module d'Young est défini par un objet EVOLUTIO MEVOLL=MELVA2.IELCHE(1,1) SEGACT MEVOLL IF(MEVOLL.IEVOLL(/1).NE.1) THEN MOTERR(1:8)='EVOLUTIO' INTERR(1)=MEVOLL CALL ERREUR(110) SEGDES MEVOLL GOTO 214 ENDIF IF(MEVOLL.ITYEVO.NE.'REEL ')THEN MOTERR(1:8)='EVOLUTIO' MOTERR(9:16)='REEL ' CALL ERREUR(79) SEGDES MEVOLL GOTO 214 ENDIF KEVOLL=IEVOLL(1) SEGACT KEVOLL IF(KEVOLL.TYPX.NE.'LISTREEL'.OR. $ KEVOLL.TYPY.NE.'LISTREEL')THEN MOTERR(1:8)='EVOLUTIO' MOTERR(9:16)='LISTREEL' INTERR(1)=MEVOLL CALL ERREUR(630) SEGDES MEVOLL,KEVOLL GOTO 214 ENDIF MLREEL=IPROGX MLREE1=IPROGY SEGACT MLREEL,MLREE1 LON=MLREE1.PROG(/1) DO 215 IC=1,NBC1 VA1=NUAFLO(IC) CALL INTER2(VA1,MLREEL,MLREE1,LON,YOU1,IRET) IF (IRET.EQ.0) THEN SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 GOTO 214 ENDIF MEVOL1=NUAINT(IC) INTERR(1)=MEVOL1 SEGACT MEVOL1 KEVOL1=MEVOL1.IEVOLL(1) SEGACT KEVOL1 IF(KEVOLL.NOMEVX(1:8).NE.NUANOM(IA)(1:8)) THEN INTERR(1)=MEVOLL INTERR(2)=IA INTERR(3)=MNUAGE CALL ERREUR(634) SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 SEGDES MEVOL1,KEVOL1 GOTO 214 ENDIF MLREE2=KEVOL1.IPROGX MLREE3=KEVOL1.IPROGY SEGACT MLREE2,MLREE3 C Verif des points définis la courbe de traction IF(MLREE2.PROG(/1).LT.3) THEN MOTERR(1:30)='n a pas assze de points ' GOTO 216 ENDIF IF(MLREE2.PROG(/1).GT.NCOMAX+1) THEN MOTERR(1:30)='est définie par trop de points' GOTO 216 ENDIF C Verif de la croissance de l'abscisse DO 219 I=2,MLREE2.PROG(/1) IF(MLREE2.PROG(I).LE.MLREE2.PROG(I-1)) THEN MOTERR(1:30)='doit être en axe X croissante ' GOTO 216 ENDIF 219 CONTINUE C Verif de l'origine IF(MLREE3.PROG(1).NE.0.D0.OR.MLREE2.PROG(1).NE.0.D0 $ .OR.MLREE2.PROG(2).EQ.0.D0) THEN MOTERR(1:30)='manque l origine ' GOTO 216 ENDIF C Verif de la limite élastique IF(MLREE3.PROG(2).EQ.0.D0) THEN MOTERR(1:30)='a une limite élastique nulle ' GOTO 216 ENDIF C Verif de la pente avec le module D'YOUNG PENTE=MLREE3.PROG(2)/MLREE2.PROG(2) RA=ABS(PENTE-YOU1)/YOU1 IF(RA.GT.5.D-3) THEN MOTERR(1:30)='a une pente non égale à E (MY)' GOTO 216 ENDIF C Verif des autres pentes DO 217 IX=3,MLREE2.PROG(/1) IY=IX-1 DEPS=MLREE2.PROG(IX)-MLREE2.PROG(IY) IF(DEPS.EQ.0.D0) THEN MOTERR(1:30)='a des EPSI en x de même valeur' GOTO 216 ENDIF PENT1=(MLREE3.PROG(IX)-MLREE3.PROG(IY))/DEPS IF(PENT1.GE.PENTE) THEN MOTERR(1:30)='a une pente >EG à son E (MY) ' GO TO 216 ENDIF 217 CONTINUE SEGDES MEVOL1,KEVOL1,MLREE2,MLREE3 215 CONTINUE SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 GOTO 214 216 CONTINUE SEGDES MEVOL1,KEVOL1,MLREE2,MLREE3 SEGDES MEVOLL,KEVOLL,MLREEL,MLREE1 CALL ERREUR(633) ENDIF 214 CONTINUE SEGDES MELVA2 RETURN END