Numérotation des lignes :

C CMODFI    SOURCE    PV        17/12/08    21:16:13     9660                    SUBROUTINE CMODFI(TPS1,TPS2,NBR,WR12,wrk52,wrk53,NWA,     1                       EFIC,TR,E1,E2)C MODFIC    SOURCE    AM        99/08/13    21:22:31     3647*         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***   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 CCOPTIO-INC DECHE*      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)******** 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(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******** 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

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