Télécharger bnqorj.eso

Retour à la liste

Numérotation des lignes :

  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