Sources Esope | Cast3M

modico
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