Télécharger la plaquette Cast3M


fr en

Télécharger bnpore.eso

Retour à la liste

Numérotation des lignes : 

bnpore

  1. C BNPORE    SOURCE    CHAT      05/01/12    21:41:47     5004
  2.       SUBROUTINE BNPORE(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,NN,
  3.      .           DIM3,XEL,SHPTOT,SHP,BGENE,XGENE,DJAC,ICLE)
  4. C-----------------------------------------------------------------------
  5. C
  6. C            CALCULE LES MATRICES B ET N  DU MILIEU POREUX
  7. C
  8. C            LE RESULTAT EST DANS BGENE ET / OU XGENE
  9. C
  10. C            BGENE(NSTB,LRE)     XGENE(NSTN,LRN)
  11. C
  12. C-----------------------------------------------------------------------
  13. C  ENTREE :
  14. C     IGAU=NUMERO DU POINT DE GAUSS
  15. C     NBNO=NOMBRE DE FONCTIONS DE FORME
  16. C     NBBB=NOMBRE DE NOEUDS
  17. C     LRE =NOMBRE DE COLONNES DE LA MATRICE B
  18. C     IFOU=IFOUR DE CCOPTIO
  19. C     NSTB=NOMBRE DE LIGNES DE LA MATRICE B
  20. C     NSTN=NOMBRE DE LIGNES DE LA MATRICE N
  21. C     DIM3=EPAISSEUR DE L'ELEMENT (CONTRAINTES PLANES)
  22. C     NN  =NUMERO DU MODE DE FOURIER
  23. C     XEL =COORDONNEES  DE L ELEMENT
  24. C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  25. C     ICLE  INDICATEUR DE CALCUL
  26. C         = 1    ON CALCULE B ET NP
  27. C         = 2    ON CALCULE BP
  28. C         = 3    ON CALCULE B
  29. C         = 4    ON CALCULE N
  30. C         = 5    ON CALCULE N ET NP
  31. C                ON MET ALORS N DANS BGENE ET NP DANS XGENE
  32. C    AUTRES VALEURS  : COMBINAISONS DES CAS PRECEDENTS
  33. C     SHP(6,NBNO)=TABLEAU DE TRAVAIL
  34. C  SORTIE :
  35. C     DJAC=JACOBIEN
  36. C     BGENE(6,LRE)=MATRICE B
  37. C     XGENE(6,LRE)=MATRICE N
  38. C-----------------------------------------------------------------------
  39.       IMPLICIT INTEGER(I-N)
  40.       IMPLICIT REAL*8(A-H,O-Z)
  41.       DIMENSION XEL(3,*),BGENE(NSTB,*),SHP(6,*),SHPTOT(6,NBNO,*)
  42.       DIMENSION XGENE(NSTN,*)
  43.       DIMENSION BB(3,9),GEOM(20),XX(3),YY(3)
  44.       DATA XX/.5D0,.0D0,.5D0/
  45.       DATA YY/.0D0,.5D0,.5D0/
  46. C
  47.       JCLE1=0
  48.       JCLE2=0
  49.       JCLE3=0
  50.       JCLE4=0
  51.       LRN =NBNO-NBBB
  52.       NB1=NBBB+1
  53.       IF(ICLE.EQ.1) THEN
  54.        JCLE1=1
  55.        JCLE4=1
  56.       ENDIF
  57.       IF(ICLE.EQ.2) THEN
  58.        JCLE3=1
  59.       ENDIF
  60.       IF(ICLE.EQ.3) THEN
  61.        JCLE1=1
  62.       ENDIF
  63.       IF(ICLE.EQ.4) THEN
  64.        JCLE2=1
  65.       ENDIF
  66.       IF(ICLE.EQ.5) THEN
  67.        JCLE2=1
  68.        JCLE4=1
  69.       ENDIF
  70. C
  71.       CALL ZERO(BGENE,NSTB,LRE)
  72.       CALL ZERO(XGENE,NSTN,LRN)
  73. C
  74.       IFR=IFOU+4
  75.       GOTO (666,10,10,20,30,40) ,IFR
  76.       GOTO 666
  77. C
  78. C     ELEMENTS MASSIFS BIDIM   CONT OU DEF PLANES
  79. C
  80.   10  CONTINUE
  81.       DO 101 NP=1,NBNO
  82.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  83.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  84.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  85.   101 CONTINUE
  86.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  87. C
  88.       IF(JCLE1.NE.0) THEN
  89.       K=1
  90.       DO 102 NP=1,NBBB
  91.       BGENE(1,K  )=SHP(2,NP)
  92.       BGENE(2,K+1)=SHP(3,NP)
  93.       BGENE(4,K+1)=SHP(2,NP)
  94.       BGENE(4,K  )=SHP(3,NP)
  95.   102 K=K+2
  96.       ENDIF
  97. C
  98.       IF(JCLE2.NE.0) THEN
  99.       K=0
  100.       DO 1102 NP=1,NBBB
  101.       DO 1103 INST=1,NSTB
  102.       BGENE(INST,K+INST)=SHP(1,NP)
  103.  1103 CONTINUE
  104.  1102 K=K+NSTB
  105.       ENDIF
  106. C
  107.       IF(JCLE3.NE.0) THEN
  108.       K=1
  109.       DO 3102 NP=NB1,NBNO
  110.       BGENE(1,K)=SHP(2,NP)
  111.       BGENE(2,K)=SHP(3,NP)
  112.  3102 K=K+1
  113.       ENDIF
  114. C
  115.       IF(JCLE4.NE.0) THEN
  116.       K=1
  117.       DO 4102 NP=NB1,NBNO
  118.       XGENE(1,K)=SHP(1,NP)
  119.  4102 K=K+1
  120.       ENDIF
  121.       GOTO  666
  122. C
  123. C     ELEMENTS MASSIFS BIDIM AXISYMETRIQUE
  124. C
  125.   20  CONTINUE
  126.       DO 201 NP=1,NBNO
  127.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  128.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  129.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  130.   201 CONTINUE
  131.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  132. C
  133.       IF(JCLE1.NE.0) THEN
  134.       K=1
  135.       DO 202 NP=1,NBBB
  136.       BGENE(1,K  )=SHP(2,NP)
  137.       BGENE(2,K+1)=SHP(3,NP)
  138.       BGENE(3,K  )=SHP(1,NP)/RR
  139.       BGENE(4,K+1)=SHP(2,NP)
  140.       BGENE(4,K  )=SHP(3,NP)
  141.   202 K=K+2
  142.       ENDIF
  143. C
  144.       IF(JCLE2.NE.0) THEN
  145.       K=0
  146.       DO 1202 NP=1,NBBB
  147.       DO 1203 INST=1,NSTB
  148.       BGENE(INST,K+INST)=SHP(1,NP)
  149.  1203 CONTINUE
  150.  1202 K=K+NSTB
  151.       ENDIF
  152. C
  153.       IF(JCLE3.NE.0) THEN
  154.       K=1
  155.       DO 3202 NP=NB1,NBNO
  156.       BGENE(1,K)=SHP(2,NP)
  157.       BGENE(2,K)=SHP(3,NP)
  158.  3202 K=K+1
  159.       ENDIF
  160. C
  161.       IF(JCLE4.NE.0) THEN
  162.       K=1
  163.       DO 4202 NP=NB1,NBNO
  164.       XGENE(1,K)=SHP(1,NP)
  165.  4202 K=K+1
  166.       ENDIF
  167.       GOTO 666
  168. C
  169. C     ELEMENTS MASSIFS BIDIM FOURIER
  170. C
  171.   30  CONTINUE
  172.       DO 301 NP=1,NBNO
  173.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  174.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  175.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  176.   301 CONTINUE
  177.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  178. C
  179.       IF(JCLE1.NE.0) THEN
  180.       XNSUR=DBLE(NN)/RR
  181.       K=1
  182.       DO 302 NP=1,NBBB
  183.       BGENE(1,K  )= SHP(2,NP)
  184.       BGENE(2,K+1)= SHP(3,NP)
  185.       BGENE(3,K  )= SHP(1,NP)/RR
  186.       BGENE(3,K+2)=-SHP(1,NP)*XNSUR
  187.       BGENE(4,K  )= SHP(3,NP)
  188.       BGENE(4,K+1)= SHP(2,NP)
  189.       BGENE(5,K  )= SHP(1,NP)*XNSUR
  190.       BGENE(5,K+2)= SHP(2,NP)-SHP(1,NP)/RR
  191.       BGENE(6,K+1)= SHP(1,NP)*XNSUR
  192.       BGENE(6,K+2)= SHP(3,NP)
  193.   302 K=K+3
  194.       ENDIF
  195. C
  196.       IF(JCLE2.NE.0) THEN
  197.       K=0
  198.       DO 1302 NP=1,NBBB
  199.       DO 1303 INST=1,NSTB
  200.       BGENE(INST,K+INST)=SHP(1,NP)
  201.  1303 CONTINUE
  202.  1302 K=K+NSTB
  203.       ENDIF
  204. C
  205.       IF(JCLE3.NE.0) THEN
  206.       XNSUR=DBLE(NN)/RR
  207.       K=1
  208.       DO 3302 NP=NB1,NBNO
  209.       BGENE(1,K)= SHP(2,NP)
  210.       BGENE(2,K)= SHP(3,NP)
  211.       BGENE(3,K)=-SHP(1,NP)*XNSUR
  212.  3302 K=K+1
  213.       ENDIF
  214. C
  215.       IF(JCLE4.NE.0) THEN
  216.       K=1
  217.       DO 4302 NP=NB1,NBNO
  218.       XGENE(1,K)=SHP(1,NP)
  219.  4302 K=K+1
  220.       ENDIF
  221.       GOTO  666
  222. C
  223. C     ELEMENTS MASSIFS TRIDIM
  224. C
  225.   40  CONTINUE
  226.       DO 401 NP=1,NBNO
  227.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  228.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  229.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  230.       SHP(4,NP)=SHPTOT(4,NP,IGAU)
  231.   401 CONTINUE
  232.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  233. C
  234.       IF(JCLE1.NE.0) THEN
  235.       K=1
  236.       DO 402 NP=1,NBBB
  237.       BGENE(1,K  )=SHP(2,NP)
  238.       BGENE(2,K+1)=SHP(3,NP)
  239.       BGENE(3,K+2)=SHP(4,NP)
  240.       BGENE(4,K  )=SHP(3,NP)
  241.       BGENE(4,K+1)=SHP(2,NP)
  242.       BGENE(5,K  )=SHP(4,NP)
  243.       BGENE(5,K+2)=SHP(2,NP)
  244.       BGENE(6,K+1)=SHP(4,NP)
  245.       BGENE(6,K+2)=SHP(3,NP)
  246.   402 K=K+3
  247.       ENDIF
  248. C
  249.       IF(JCLE2.NE.0) THEN
  250.       K=0
  251.       DO 1402 NP=1,NBBB
  252.       DO 1403 INST=1,NSTB
  253.       BGENE(INST,K+INST)=SHP(1,NP)
  254.  1403 CONTINUE
  255.  1402 K=K+NSTB
  256.       ENDIF
  257. C
  258.       IF(JCLE3.NE.0) THEN
  259.       K=1
  260.       DO 3402 NP=NB1,NBNO
  261.       BGENE(1,K)=SHP(2,NP)
  262.       BGENE(2,K)=SHP(3,NP)
  263.       BGENE(3,K)=SHP(4,NP)
  264.  3402 K=K+1
  265.       ENDIF
  266. C
  267.       IF(JCLE4.NE.0) THEN
  268.       K=1
  269.       DO 4402 NP=NB1,NBNO
  270.       XGENE(1,K)=SHP(1,NP)
  271.  4402 K=K+1
  272.       ENDIF
  273.       GO TO 666
  274. C
  275.  666  RETURN
  276.       END
  277.  
  278.  
  279.  
  280.  

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