1 : C SIGPOR SOURCE CHAT 05/01/13 03:18:08 5004 2 : SUBROUTINE SIGPOR(COBMA,UNSRM,XGENE,NSTN,XDDL,IFOUR,NSTRS, 3 : . XSTRS,LRB,LRN,LPP,MELE,IRTD,COBB,XKBB,IDECAP) 4 : *---------------------------------------------------------------------- 5 : * 6 : * ON AJOUTE LES CONTRAINTES DUES A LA PRESSION POREUSE 7 : * N'EST VALABLE QUE POUR LES ELEMENTS POREUX 8 : * (JOINTS POREUX INCLUS) 9 : * 10 : * ENTREE 11 : * COBMA COEFFICIENTS DE BIOT 12 : * UNSRM INVERSE DU MODULE DE BIOT 13 : * XGENE(NSTN,LRN) MATRICE DES FONCTIONS DE FORME DE P 14 : * NSTN NOMBRE DE LIGNES DE XGENE 15 : * XDDL(LRE) D D L DE LA FORMULATION 16 : * IFOUR VARIABLE IFOUR 17 : * NSTRS NOMBRE DE CONTRAINTES 18 : * XSTRS(NSTRS) CONTRAINTES DHO*EPS1 19 : * LRB LRN DIMENSIONS ( VOIR RIGI1 ) 20 : * MELE NUMERO DE L ELEMENT FINI DANS NOMTP 21 : * 22 : * SORTIE 23 : * XSTRS(NSTRS) CONTRAINTES DHO*EPS1 - COBMA * P 24 : * ET P 25 : *---------------------------------------------------------------------- 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : DIMENSION XGENE(NSTN,*),XSTRS(*),XDDL(*),COBMA(*) 29 : DIMENSION XNTH(12,12),XNTB(12,12),XNTT(12),VP(3) 30 : DIMENSION COBB(IDECAP),XKBB(IDECAP,IDECAP) 31 : 32 : * 33 : * CALCUL DE LA PRESSION 34 : * 35 : P=0.D0 36 : * 37 : IF(MELE.GE.108.AND.MELE.LE.110)THEN 38 : * 38 : CALL INTDEL(XNTH,XNTB,XNTT,LRN,MELE) 39 : * 40 : DO 1 J=1,LRN 41 : JJ=J+LRB 42 : P=P+XNTT(J)*XGENE(1,J)*XDDL(JJ) 43 : 1 CONTINUE 44 : * 45 : LHOOK=NSTRS-1 46 : SIGP=COBMA(LHOOK)*P 47 : XSTRS(LHOOK)=XSTRS(LHOOK) - SIGP 48 : XSTRS(NSTRS)=XSTRS(NSTRS) + P*UNSRM 49 : * 50 : ELSE IF (MELE.GE.79.AND.MELE.LE.83) THEN 51 : * 52 : DO 2 J=1,LRN 53 : JJ=J+LRB 54 : P=P+XGENE(1,J)*XDDL(JJ) 55 : 2 CONTINUE 56 : * 57 : LHOOK=NSTRS-1 58 : DO 20 IA=1,LHOOK 59 : SIGP=COBMA(IA)*P 60 : IF(IFOUR.EQ.-2.AND.IA.EQ.3) SIGP=0.D0 61 : XSTRS(IA)=XSTRS(IA) - SIGP 62 : 20 CONTINUE 63 : XSTRS(NSTRS)=XSTRS(NSTRS) + P*UNSRM 64 : * 65 : ELSE IF (MELE.GE.173.AND.MELE.LE.182) THEN 66 : * 67 : IE=LRB 68 : DO 33 IPR=1,IDECAP 69 : P=0.D0 70 : IPR1=(IPR-1)*LPP 71 : DO 3 ID=1,LPP 72 : IE=IE+1 73 : P=P+XGENE(IPR,ID+IPR1)*XDDL(IE) 74 : 3 CONTINUE 75 : * 76 : LHOOK=NSTRS-IDECAP 77 : ********* DO 30 IA=1,LHOOK 78 : DO 30 IA=1,3 79 : SIGP=COBB(IPR)*P 80 : IF(IFOUR.EQ.-2.AND.IA.EQ.3) SIGP=0.D0 81 : XSTRS(IA)=XSTRS(IA) - SIGP 82 : 30 CONTINUE 83 : * 84 : DO 32 JPR=1,IDECAP 85 : XSTRS(NSTRS-IDECAP+JPR)=XSTRS(NSTRS-IDECAP+JPR) + 86 : & XKBB(JPR,IPR)*P 87 : 32 CONTINUE 88 : 89 : 33 CONTINUE 90 : 91 : * 92 : END IF 93 : * 94 : * ON FINIT PAR MSR0 95 : * 96 : RETURN 97 : * 98 : 666 CONTINUE 99 : IRTD=1 100 : RETURN 101 : END 102 : 103 : 104 : 105 :
© Cast3M 2003 - All rights reserved.
Disclaimer