Télécharger la plaquette Cast3M


fr en

Télécharger bnqore.eso

Retour à la liste

Numérotation des lignes : 

bnqore

  1. C BNQORE    SOURCE    AM        15/08/21    21:15:02     8599
  2.       SUBROUTINE BNQORE(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,NN,
  3.      .    DIM3,XEL,SHPTOT,SHP,BGENE,XGENE,DJAC,IDECAP,LHOOK,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(LHOOK,LRE)=MATRICE B
  37. C     XGENE(NSTN,LRN)=MATRICE N
  38. C-----------------------------------------------------------------------
  39.       IMPLICIT INTEGER(I-N)
  40.       IMPLICIT REAL*8(A-H,O-Z)
  41.       DIMENSION XEL(3,*),BGENE(LHOOK,*),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.  
  52.       LPP = NBNO-NBBB
  53.       LRN=IDECAP*LPP
  54.       NB1=NBBB+1
  55.       IF(ICLE.EQ.1) THEN
  56.        JCLE1=1
  57.        JCLE4=1
  58.       ENDIF
  59.       IF(ICLE.EQ.2) THEN
  60.        JCLE3=1
  61.       ENDIF
  62.       IF(ICLE.EQ.3) THEN
  63.        JCLE1=1
  64.       ENDIF
  65.       IF(ICLE.EQ.4) THEN
  66.        JCLE2=1
  67.       ENDIF
  68.       IF(ICLE.EQ.5) THEN
  69.        JCLE2=1
  70.        JCLE4=1
  71.       ENDIF
  72.  
  73.       CALL ZERO(BGENE,LHOOK,LRE)
  74.       CALL ZERO(XGENE,NSTN,LRN)
  75. C
  76.       IFR=IFOU+4
  77.       GOTO (666,10,10,20,30,40) ,IFR
  78.       GOTO 666
  79. C
  80. C     ELEMENTS MASSIFS BIDIM   CONT OU DEF PLANES
  81. C
  82.   10  CONTINUE
  83.       DO 101 NP=1,NBNO
  84.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  85.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  86.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  87.   101 CONTINUE
  88.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  89. C
  90.       IF(JCLE1.NE.0) THEN
  91.       K=1
  92.       DO 102 NP=1,NBBB
  93.       BGENE(1,K  )=SHP(2,NP)
  94.       BGENE(2,K+1)=SHP(3,NP)
  95.       BGENE(4,K+1)=SHP(2,NP)
  96.       BGENE(4,K  )=SHP(3,NP)
  97.   102 K=K+2
  98.       ENDIF
  99. C
  100.       IF(JCLE2.NE.0) THEN
  101.       K=0
  102.       DO 1102 NP=1,NBBB
  103.       DO 1103 INST=1,NSTB
  104.       BGENE(INST,K+INST)=SHP(1,NP)
  105.  1103 CONTINUE
  106.  1102 K=K+NSTB
  107.       ENDIF
  108. C
  109.       IF(JCLE3.NE.0) THEN
  110.       DO 3122 IPR=1,IDECAP
  111.          K=(IPR-1)*NBBB +1
  112.          IPR2=2*IPR
  113.          DO 3102 NP=NB1,NBNO
  114.          BGENE(IPR2-1,K)=SHP(2,NP)
  115.          BGENE(IPR2  ,K)=SHP(3,NP)
  116.  3102    K=K+1
  117.  3122 CONTINUE
  118.       ENDIF
  119. C
  120.       IF(JCLE4.NE.0) THEN
  121.       K=1
  122.       DO 4122 IPR=1,IDECAP
  123.          DO 4102 NP=NB1,NBNO
  124.          XGENE(IPR,K)=SHP(1,NP)
  125.  4102    K=K+1
  126.  4122 CONTINUE
  127.       ENDIF
  128.       GOTO  666
  129. C
  130. C     ELEMENTS MASSIFS BIDIM AXISYMETRIQUE
  131. C
  132.   20  CONTINUE
  133.       DO 201 NP=1,NBNO
  134.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  135.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  136.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  137.   201 CONTINUE
  138.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  139. C
  140.       IF(JCLE1.NE.0) THEN
  141.       K=1
  142.       DO 202 NP=1,NBBB
  143.       BGENE(1,K  )=SHP(2,NP)
  144.       BGENE(2,K+1)=SHP(3,NP)
  145.       BGENE(3,K  )=SHP(1,NP)/RR
  146.       BGENE(4,K+1)=SHP(2,NP)
  147.       BGENE(4,K  )=SHP(3,NP)
  148.   202 K=K+2
  149.       ENDIF
  150. C
  151.       IF(JCLE2.NE.0) THEN
  152.       K=0
  153.       DO 1202 NP=1,NBBB
  154.       DO 1203 INST=1,NSTB
  155.       BGENE(INST,K+INST)=SHP(1,NP)
  156.  1203 CONTINUE
  157.  1202 K=K+NSTB
  158.       ENDIF
  159. C
  160.       IF(JCLE3.NE.0) THEN
  161.       DO 3222 IPR=1,IDECAP
  162.          K=(IPR-1)*NBBB +1
  163.          IPR2=2*IPR
  164.          DO 3202 NP=NB1,NBNO
  165.            BGENE(IPR2-1,K)=SHP(2,NP)
  166.            BGENE(IPR2  ,K)=SHP(3,NP)
  167.  3202      K=K+1
  168.  3222 CONTINUE
  169.       ENDIF
  170. C
  171.       IF(JCLE4.NE.0) THEN
  172.       K=1
  173.       DO 4222 IPR=1,IDECAP
  174.          DO 4202 NP=NB1,NBNO
  175.          XGENE(IPR,K)=SHP(1,NP)
  176.  4202    K=K+1
  177.  4222 CONTINUE
  178.       ENDIF
  179.       GOTO 666
  180. C
  181. C     ELEMENTS MASSIFS BIDIM FOURIER
  182. C
  183.   30  CONTINUE
  184.       DO 301 NP=1,NBNO
  185.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  186.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  187.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  188.   301 CONTINUE
  189.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  190. C
  191.       IF(JCLE1.NE.0) THEN
  192.       XNSUR=DBLE(NN)/RR
  193.       K=1
  194.       DO 302 NP=1,NBBB
  195.       BGENE(1,K  )= SHP(2,NP)
  196.       BGENE(2,K+1)= SHP(3,NP)
  197.       BGENE(3,K  )= SHP(1,NP)/RR
  198.       BGENE(3,K+2)=-SHP(1,NP)*XNSUR
  199.       BGENE(4,K  )= SHP(3,NP)
  200.       BGENE(4,K+1)= SHP(2,NP)
  201.       BGENE(5,K  )= SHP(1,NP)*XNSUR
  202.       BGENE(5,K+2)= SHP(2,NP)-SHP(1,NP)/RR
  203.       BGENE(6,K+1)= SHP(1,NP)*XNSUR
  204.       BGENE(6,K+2)= SHP(3,NP)
  205.   302 K=K+3
  206.       ENDIF
  207. C
  208.       IF(JCLE2.NE.0) THEN
  209.       K=0
  210.       DO 1302 NP=1,NBBB
  211.       DO 1303 INST=1,NSTB
  212.       BGENE(INST,K+INST)=SHP(1,NP)
  213.  1303 CONTINUE
  214.  1302 K=K+NSTB
  215.       ENDIF
  216. C
  217.       IF(JCLE3.NE.0) THEN
  218.       XNSUR=DBLE(NN)/RR
  219.       DO 3322 IPR=1,IDECAP
  220.          K=(IPR-1)*NBBB +1
  221.          IPR3=3*IPR
  222.          DO 3302 NP=NB1,NBNO
  223.          BGENE(IPR3-2,K)= SHP(2,NP)
  224.          BGENE(IPR3-1,K)= SHP(3,NP)
  225.          BGENE(IPR3  ,K)=-SHP(1,NP)*XNSUR
  226.  3302    K=K+1
  227.  3322 CONTINUE
  228.       ENDIF
  229. C
  230.       IF(JCLE4.NE.0) THEN
  231.       K=1
  232.       DO 4322 IPR=1,IDECAP
  233.          DO 4302 NP=NB1,NBNO
  234.          XGENE(IPR,K)=SHP(1,NP)
  235.  4302    K=K+1
  236.  4322 CONTINUE
  237.       ENDIF
  238.       GOTO  666
  239. C
  240. C     ELEMENTS MASSIFS TRIDIM
  241. C
  242.   40  CONTINUE
  243.       DO 401 NP=1,NBNO
  244.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  245.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  246.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  247.       SHP(4,NP)=SHPTOT(4,NP,IGAU)
  248.   401 CONTINUE
  249.       CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  250. C
  251.       IF(JCLE1.NE.0) THEN
  252.       K=1
  253.       DO 402 NP=1,NBBB
  254.       BGENE(1,K  )=SHP(2,NP)
  255.       BGENE(2,K+1)=SHP(3,NP)
  256.       BGENE(3,K+2)=SHP(4,NP)
  257.       BGENE(4,K  )=SHP(3,NP)
  258.       BGENE(4,K+1)=SHP(2,NP)
  259.       BGENE(5,K  )=SHP(4,NP)
  260.       BGENE(5,K+2)=SHP(2,NP)
  261.       BGENE(6,K+1)=SHP(4,NP)
  262.       BGENE(6,K+2)=SHP(3,NP)
  263.   402 K=K+3
  264.       ENDIF
  265. C
  266.       IF(JCLE2.NE.0) THEN
  267.       K=0
  268.       DO 1402 NP=1,NBBB
  269.       DO 1403 INST=1,NSTB
  270.       BGENE(INST,K+INST)=SHP(1,NP)
  271.  1403 CONTINUE
  272.  1402 K=K+NSTB
  273.       ENDIF
  274. C
  275.       IF(JCLE3.NE.0) THEN
  276.       DO 3422 IPR=1,IDECAP
  277.          K=(IPR-1)*NBBB +1
  278.          IPR3=3*IPR
  279.          DO 3402 NP=NB1,NBNO
  280.          BGENE(IPR3-2,K)=SHP(2,NP)
  281.          BGENE(IPR3-1,K)=SHP(3,NP)
  282.          BGENE(IPR3  ,K)=SHP(4,NP)
  283.  3402    K=K+1
  284.  3422 CONTINUE
  285.       ENDIF
  286. C
  287.       IF(JCLE4.NE.0) THEN
  288.       K=1
  289.       DO 4422 IPR=1,IDECAP
  290.          DO 4402 NP=NB1,NBNO
  291.          XGENE(IPR,K)=SHP(1,NP)
  292.  4402    K=K+1
  293.  4422 CONTINUE
  294.       ENDIF
  295.       GO TO 666
  296. C
  297.  666  RETURN
  298.       END
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  

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