Sources Esope | Cast3M

modfic
C MODFIC    SOURCE    CHAT      05/01/13    01:49:20     5004
         SUBROUTINE MODFIC(TPS1,TPS2,NBR,WR12,WRK0,NWA,
     1                       EFIC,TR,E1,E2,KERRE,CMATE)
*
*
*==============================================================
*        calcul du module fictif d'une chaine de Maxwell
*==============================================================
*
*
* entrees
*
*   WRK0
*        XMAT(NCOMAT) = CARACTERISTIQUES MECANIQUES DU MATERIAU
*
*   WRK12
*        EMi(2,NWA(i+1))    i=0 a 8
*                        = EVOLUTION DU MODUE D'YOUNG DE LA BRANCHE i
*        SMi(NSTRS)         i=1 a 8
*                        = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION
*
*        TPS1 = TEMPS AU DEBUT DU PAS D'INTEGRATION
*        TPS2 = TEMPS A LA FIN DU PAS D'INTEGRATION
*        NBR = INDICE DE LA CHAINE DE MAXWELL CONCERNEE
*        NWA = TABLEAU DES DIMENSIONS DES EVOLUTIONS DES MODULES DE CHAQUE CHAINE
*
*
* sortie
*
*        EFIC = MODULE FICTIF DE LA CHAINE DE MAXWELL
*        TR = TEMPS DE RELAXATION DE LA CHAINE DE MAXWELL
*        E1 = MODULE DE LA CHAINE DE MAXWELL AU DEBUT DU PAS
*        E2 = MODULE DE LA CHAINE DE MAXWELL A LA FIN DU PAS
*        KERRE = INDICATEUR D'ERREUR
*
*
*
*==============================================================
*
      IMPLICIT INTEGER(I-N)
       IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
*
      SEGMENT WRK0
        REAL*8 XMAT(NCXMAT)
      ENDSEGMENT
*
      SEGMENT WR12
        REAL*8  EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
        REAL*8  EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
        REAL*8  EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
        REAL*8  SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
        REAL*8  SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
        REAL*8  SM8(NSTRS)
      ENDSEGMENT
*
       DIMENSION NWA(9)
        CHARACTER*8 CMATE
*
******* Cas d'une formulation isotrope
*
      IF(CMATE.EQ.'ISOTROPE') THEN
 
*
        JED=0
        IF (IFOUR.EQ.-2) JED=1
*
*     test sur la branche
*
       IF (NBR.EQ.0) THEN
         CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2)
         EFIC=(FTPS2+FTPS1)/2
         TR=0.
         E1=FTPS1
         E2=FTPS2
         GOTO 10
       ELSE IF (NBR.EQ.1) THEN
         CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2)
         TR=XMAT(5)
       ELSE IF (NBR.EQ.2) THEN
         CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2)
         TR=XMAT(7)
       ELSE IF (NBR.EQ.3) THEN
         CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2)
         TR=XMAT(9)
       ELSE IF (NBR.EQ.4) THEN
         CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2)
         TR=XMAT(11)
*
*    5 et plus
*
       ELSE IF (NBR.EQ.5) THEN
         CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2)
         TR=XMAT(15+JED)
       ELSE IF (NBR.EQ.6) THEN
         CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2)
         TR=XMAT(17+JED)
       ELSE IF (NBR.EQ.7) THEN
         CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2)
         TR=XMAT(19+JED)
       ELSE IF (NBR.EQ.8) THEN
         CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2)
         TR=XMAT(21+JED)
       ENDIF
*
******* Cas d'une formulation unidirectionnelle
*
        ELSE IF(CMATE.EQ.'UNIDIREC') THEN
 
*
        JED=0
        IF (IFOUR.EQ.-2) JED=1
        IF (IFOUR.EQ. 2) JED=4
*
        KED=0
        IF (IFOUR.EQ. 2) KED=4
 
*     test sur la branche
*
        IF (NBR.EQ.0) THEN
         CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2)
         EFIC=(FTPS2+FTPS1)/2
         TR=0.
         E1=FTPS1
         E2=FTPS2
         GOTO 10
        ELSE IF (NBR.EQ.1) THEN
         CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2)
         TR=XMAT(6+KED)
        ELSE IF (NBR.EQ.2) THEN
         CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2)
         TR=XMAT(8+KED)
        ELSE IF (NBR.EQ.3) THEN
         CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2)
         TR=XMAT(10+KED)
        ELSE IF (NBR.EQ.4) THEN
         CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2)
         TR=XMAT(12+KED)
*
*    5 et plus
*
        ELSE IF (NBR.EQ.5) THEN
         CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2)
         TR=XMAT(16+JED)
        ELSE IF (NBR.EQ.6) THEN
         CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2)
         TR=XMAT(18+JED)
        ELSE IF (NBR.EQ.7) THEN
         CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2)
         TR=XMAT(20+JED)
        ELSE IF (NBR.EQ.8) THEN
         CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1)
         CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2)
         TR=XMAT(22+JED)
        ENDIF
       ENDIF
*
*
       E1=FTPS1
       E2=FTPS2
       IF(TPS2-TPS1.EQ.0.D0) THEN
         EFIC =FTPS1
       ELSE
         EFIC=1.D0/(TR*(TPS2-TPS1))*
     1        ((FTPS1*(1.D0-EXP(-TR*(TPS2-TPS1))))
     2      +(FTPS2-FTPS1)*(1.D0-(1.D0-EXP(-TR*(TPS2-TPS1)))/
     3      (TR*(TPS2-TPS1))))
       ENDIF
*
*
10     IF (IRET1.EQ.0) THEN
         CALL ERREUR(854)
         RETURN
       ELSE IF (IRET2.EQ.0) THEN
         CALL ERREUR(854)
         RETURN
       ENDIF
       END