Télécharger la plaquette Cast3M


fr en

Télécharger verinu.eso

Retour à la liste

Numérotation des lignes : 

verinu

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales