Télécharger la plaquette Cast3M


fr en

Télécharger bnqorj.eso

Retour à la liste

Numérotation des lignes : 

bnqorj

  1. C BNQORJ    SOURCE    AM        15/08/21    21:15:03     8599
  2.       SUBROUTINE BNQORJ(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,XE,XEL,
  3.      .              SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,IDECAP,ICLE)
  4. C-----------------------------------------------------------------------
  5. C            BGENE(NSTB,LRE)     XGENE(NSTN,LRN)
  6. C-----------------------------------------------------------------------
  7. C  ENTREE :
  8. C     IGAU =NUMERO DU POINT DE GAUSS
  9. C     NBNO =NOMBRE DE FONCTIONS DE FORME
  10. C     NBBB =NOMBRE DE NOEUDS
  11. C     LRE  =NOMBRE DE COLONNES DE LA MATRICE N
  12. C     IFOU =IFOUR DE CCOPTIO
  13. C     NSTB =NOMBRE DE LIGNES DE LA MATRICE N
  14. C     NSTN =NOMBRE DE LIGNES DE LA MATRICE NP
  15. C     XE   =COORDONNEES GLOBALES DE L ELEMENT
  16. C     XEL  =COORDONNEES LOCALES DE L ELEMENT
  17. C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  18. C     SHP(6,NBNO)         =TABLEAU DE TRAVAIL
  19. C     BPSS=MATRICE DE PASSAGE REPERE GLOBAL/REPERE LOCAL
  20. C     ICLE  INDICATEUR DE CALCUL
  21. C         = 1    ON CALCULE  dNP (bgene)
  22. C  SORTIE :
  23. C     BGENE(NSTB,LRE)=MATRICE dNP
  24. C     XGENE(NSTN,LRN)=MATRICE NP
  25. C     DJAC=JACOBIEN
  26. C-----------------------------------------------------------------------
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.       DIMENSION XEL(3,*),BGENE(NSTB,*),SHP(6,*),SHPTOT(6,NBNO,*)
  30.       DIMENSION XGENE(NSTN,*),BPSS(3,3),XE(3,*)
  31. C
  32.       LPP=(NBNO-NBBB)*3/2
  33.       LRN=IDECAP*LPP
  34.       LNAP =LPP / 3
  35.       NBNB=(3*NBBB-NBNO)/2
  36.       NFAC=NBNB/2
  37.       NB1=NBNB+1
  38. C
  39.       CALL ZERO(BGENE,NSTB,LRE)
  40. C
  41.       IFR=IFOU+4
  42.       GOTO (666,10,10,10,666,40) ,IFR
  43.       GOTO 666
  44. C
  45. C   CONT PLANES, DEF PLANES OU AXISYMETRIQUE
  46. C
  47.   10  CONTINUE
  48. C
  49.       DO 101 NP=1,NBNO
  50.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  51.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  52.   101 CONTINUE
  53. C
  54.       CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  55. C
  56. C
  57.       IF(ICLE.EQ.1)  THEN
  58.  
  59.       DO 3200 IPR=1,IDECAP
  60.       II=(IPR-1)*3
  61.       JJ=(IPR-1)*LPP
  62.       DO 200 IP1=1,LNAP
  63.       IP2 = IP1 + LNAP
  64.       IP3 = IP2 + LNAP
  65. ***** JP2 = 2*LNAP + 1 - IP1
  66. * LIGNE 1
  67.       BGENE(II+1,JJ+IP1)= SHP(1,NBNB+IP1)
  68.       BGENE(II+1,JJ+IP3)=-SHP(1,NBNB+IP3)
  69. * LIGNE 2
  70. ****  BGENE(II+2,JJ+IP2)=-SHP(1,NBNB+JP2)
  71.       BGENE(II+2,JJ+IP2)=-SHP(1,NBNB+IP2)
  72.       BGENE(II+2,JJ+IP3)= SHP(1,NBNB+IP3)
  73. * LIGNE 3
  74.       BGENE(II+3,JJ+IP3)= SHP(2,NBNB+IP3)
  75. 200   CONTINUE
  76. 3200  CONTINUE
  77.       ENDIF
  78.       GOTO  666
  79. C
  80. C   TRIDIMMENSIONNEL
  81. C
  82.   40  CONTINUE
  83. C
  84.       DO 201 NP=1,NBNO
  85.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  86.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  87.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  88.   201 CONTINUE
  89. C
  90.       CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  91. C
  92. C
  93.       IF(ICLE.EQ.1)  THEN
  94.       DO 3300 IPR=1,IDECAP
  95.       II=(IPR-1)*4
  96.       JJ=(IPR-1)*LPP
  97.       DO 300 IP1=1,LNAP
  98.       IP2 = IP1 + LNAP
  99.       IP3 = IP2 + LNAP
  100. * LIGNE 1
  101.       BGENE(II+1,JJ+IP1)= SHP(1,NBNB+IP1)
  102.       BGENE(II+1,JJ+IP3)=-SHP(1,NBNB+IP3)
  103. * LIGNE 2
  104.       BGENE(II+2,JJ+IP2)=-SHP(1,NBNB+IP2)
  105.       BGENE(II+2,JJ+IP3)= SHP(1,NBNB+IP3)
  106. * LIGNE 3
  107.       BGENE(II+3,JJ+IP3)= SHP(2,NBNB+IP3)
  108. * LIGNE 4
  109.       BGENE(II+4,JJ+IP3)= SHP(3,NBNB+IP3)
  110. 300   CONTINUE
  111. 3300  CONTINUE
  112.       ENDIF
  113.       GOTO  666
  114. C
  115.   666 CONTINUE
  116.       RETURN
  117.       END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  

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