Télécharger la plaquette Cast3M


fr en

Télécharger sigpor.eso

Retour à la liste

Numérotation des lignes : 

sigpor

  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. *
  39.         CALL INTDEL(XNTH,XNTB,XNTT,LRN,MELE)
  40. *
  41.         DO 1 J=1,LRN
  42.           JJ=J+LRB
  43.           P=P+XNTT(J)*XGENE(1,J)*XDDL(JJ)
  44.  1      CONTINUE
  45. *
  46.         LHOOK=NSTRS-1
  47.         SIGP=COBMA(LHOOK)*P
  48.         XSTRS(LHOOK)=XSTRS(LHOOK) - SIGP
  49.         XSTRS(NSTRS)=XSTRS(NSTRS) + P*UNSRM
  50. *
  51.       ELSE IF (MELE.GE.79.AND.MELE.LE.83) THEN
  52. *
  53.         DO 2 J=1,LRN
  54.           JJ=J+LRB
  55.           P=P+XGENE(1,J)*XDDL(JJ)
  56.  2      CONTINUE
  57. *
  58.         LHOOK=NSTRS-1
  59.         DO 20 IA=1,LHOOK
  60.           SIGP=COBMA(IA)*P
  61.           IF(IFOUR.EQ.-2.AND.IA.EQ.3)  SIGP=0.D0
  62.           XSTRS(IA)=XSTRS(IA) - SIGP
  63.  20     CONTINUE
  64.         XSTRS(NSTRS)=XSTRS(NSTRS) + P*UNSRM
  65. *
  66.       ELSE IF (MELE.GE.173.AND.MELE.LE.182) THEN
  67. *
  68.         IE=LRB
  69.         DO 33 IPR=1,IDECAP
  70.           P=0.D0
  71.           IPR1=(IPR-1)*LPP
  72.           DO 3 ID=1,LPP
  73.             IE=IE+1
  74.             P=P+XGENE(IPR,ID+IPR1)*XDDL(IE)
  75.  3        CONTINUE
  76. *
  77.           LHOOK=NSTRS-IDECAP
  78. ********* DO 30 IA=1,LHOOK
  79.           DO 30 IA=1,3
  80.             SIGP=COBB(IPR)*P
  81.             IF(IFOUR.EQ.-2.AND.IA.EQ.3)  SIGP=0.D0
  82.             XSTRS(IA)=XSTRS(IA) - SIGP
  83.  30       CONTINUE
  84. *
  85.           DO 32 JPR=1,IDECAP
  86.           XSTRS(NSTRS-IDECAP+JPR)=XSTRS(NSTRS-IDECAP+JPR) +
  87.      &                     XKBB(JPR,IPR)*P
  88.   32     CONTINUE
  89.  
  90.  33   CONTINUE
  91.  
  92. *
  93.       END IF
  94. *
  95. *     ON FINIT PAR MSR0
  96. *
  97.       RETURN
  98. *
  99.   666 CONTINUE
  100.       IRTD=1
  101.       RETURN
  102.       END
  103.  
  104.  
  105.  
  106.  
  107.  

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