Télécharger bnpqrj.eso

Retour à la liste

Numérotation des lignes :

  1. C BNPQRJ SOURCE AM 15/08/21 21:15:00 8599
  2. SUBROUTINE BNPQRJ(IGAU,NBNO,NBBB,LRE,IFOU,LHOOK,NSTN,XE,XEL,
  3. . SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,IDECAP,NSTB,ICLE)
  4. C-----------------------------------------------------------------------
  5. C
  6. C CALCULE LES MATRICES N, NP ET dNP DU JOINT 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 N
  18. C IFOU =IFOUR DE CCOPTIO
  19. C NSTB =NOMBRE DE LIGNES DE LA MATRICE N
  20. C NSTN =NOMBRE DE LIGNES DE LA MATRICE NP
  21. C XE =COORDONNEES GLOBALES DE L ELEMENT
  22. C XEL =COORDONNEES LOCALES DE L ELEMENT
  23. C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  24. C SHP(6,NBNO) =TABLEAU DE TRAVAIL
  25. C BPSS=MATRICE DE PASSAGE REPERE GLOBAL/REPERE LOCAL
  26. C ICLE INDICATEUR DE CALCUL
  27. C = 1 ON CALCULE N (bgene) ET NP (xgene)
  28. C = 2 ON CALCULE N (bgene)
  29. C = 3 ON CALCULE NP (xgene) ET dNP (bgene)
  30. C SORTIE :
  31. C BGENE(LHOOK,LRE)=MATRICE N OU dNP (NSTB LIGNES UTILES)
  32. C XGENE(NSTN,LRN)=MATRICE NP
  33. C DJAC=JACOBIEN
  34. C-----------------------------------------------------------------------
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8(A-H,O-Z)
  37. DIMENSION XEL(3,*),BGENE(LHOOK,*),SHP(6,*),SHPTOT(6,NBNO,*)
  38. DIMENSION XGENE(NSTN,*),BPSS(3,3),XE(3,*)
  39. C
  40. JCLE1=0
  41. JCLE2=0
  42. JCLE3=0
  43.  
  44. LPP=(NBNO-NBBB)*3/2
  45. LRN= IDECAP * LPP
  46. NBNB=(3*NBBB-NBNO)/2
  47. NFAC=NBNB/2
  48. NB1=NBNB+1
  49. IF(ICLE.EQ.1) THEN
  50. JCLE1=1
  51. JCLE2=1
  52. ENDIF
  53. IF(ICLE.EQ.2) THEN
  54. JCLE1=1
  55. ENDIF
  56. IF(ICLE.EQ.3) THEN
  57. JCLE2=1
  58. JCLE3=1
  59. ENDIF
  60. C
  61. CALL ZERO(BGENE,LHOOK,LRE)
  62. CALL ZERO(XGENE,NSTN,LRN)
  63. C
  64. IFR=IFOU+4
  65. GOTO (666,10,10,10,666,40) ,IFR
  66. GOTO 666
  67. C
  68. C CONT PLANES, DEF PLANES OU AXISYMETRIQUE
  69. C
  70. 10 CONTINUE
  71. C
  72. DO 101 NP=1,NBNO
  73. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  74. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  75. 101 CONTINUE
  76. C
  77. CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  78. C
  79. IF(JCLE1.NE.0) THEN
  80. DO 110 I=1,NSTB
  81. DO 111 J=1,NFAC
  82. DO 112 K=1,NSTB
  83. L=NSTB*(J-1)+K
  84. M=L+NSTB*(2*(NFAC-J)+1)
  85. BGENE(I,L)=BPSS(I,K)*SHP(1,J)
  86. BGENE(I,M)=-BGENE(I,L)
  87. 112 CONTINUE
  88. 111 CONTINUE
  89. 110 CONTINUE
  90. ENDIF
  91. C
  92. IF(JCLE2.NE.0) THEN
  93. K=1
  94. DO 4113 IPR=1,IDECAP
  95. DO 113 NP=NB1,NBNO
  96. XGENE(IPR,K)=SHP(1,NP)
  97. K=K+1
  98. 113 CONTINUE
  99. 4113 CONTINUE
  100. ENDIF
  101. C
  102. IF(JCLE3.NE.0) THEN
  103. K=1
  104. DO 4114 IPR=1,IDECAP
  105. DO 114 NP=NB1,NBNO
  106. BGENE(IPR,K)=SHP(2,NP)
  107. K=K+1
  108. 114 CONTINUE
  109. 4114 CONTINUE
  110. ENDIF
  111. GOTO 666
  112. C
  113. C TRIDIMMENSIONNEL
  114. C
  115. 40 CONTINUE
  116. C
  117. DO 201 NP=1,NBNO
  118. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  119. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  120. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  121. 201 CONTINUE
  122. C
  123. CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  124. C
  125. IF(JCLE1.NE.0) THEN
  126. DO 210 I=1,NSTB
  127. DO 211 J=1,NFAC
  128. DO 212 K=1,NSTB
  129. L=NSTB*(J-1)+K
  130. M=L+NFAC*NSTB
  131. BGENE(I,L)=BPSS(I,K)*SHP(1,J)
  132. BGENE(I,M)=-BGENE(I,L)
  133. 212 CONTINUE
  134. 211 CONTINUE
  135. 210 CONTINUE
  136. ENDIF
  137. C
  138. IF(JCLE2.NE.0) THEN
  139. K=1
  140. DO 4213 IPR=1,IDECAP
  141. DO 213 NP=NB1,NBNO
  142. XGENE(IPR,K)=SHP(1,NP)
  143. K=K+1
  144. 213 CONTINUE
  145. 4213 CONTINUE
  146. ENDIF
  147. C
  148. IF(JCLE3.NE.0) THEN
  149. DO 4214 IPR=1,IDECAP
  150. K=(IPR-1)*NBBB +1
  151. IPR2=2*IPR
  152. DO 214 NP=NB1,NBNO
  153. BGENE(IPR2-1,K)=SHP(2,NP)
  154. BGENE(IPR2 ,K)=SHP(3,NP)
  155. K=K+1
  156. 214 CONTINUE
  157. 4214 CONTINUE
  158. ENDIF
  159. GOTO 666
  160. C
  161. 666 CONTINUE
  162. RETURN
  163. END
  164.  
  165.  
  166.  
  167.  
  168.  

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