Télécharger bnporj.eso

Retour à la liste

Numérotation des lignes :

  1. C BNPORJ SOURCE CHAT 05/01/12 21:41:52 5004
  2. SUBROUTINE BNPORJ(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,XE,XEL,
  3. . SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,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(NSTB,LRE)=MATRICE N OU dNP
  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(NSTB,*),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. LRN=(NBNO-NBBB)*3/2
  44. NBNB=(3*NBBB-NBNO)/2
  45. NFAC=NBNB/2
  46. NB1=NBNB+1
  47. IF(ICLE.EQ.1) THEN
  48. JCLE1=1
  49. JCLE2=1
  50. ENDIF
  51. IF(ICLE.EQ.2) THEN
  52. JCLE1=1
  53. ENDIF
  54. IF(ICLE.EQ.3) THEN
  55. JCLE2=1
  56. JCLE3=1
  57. ENDIF
  58. C
  59. CALL ZERO(BGENE,NSTB,LRE)
  60. CALL ZERO(XGENE,NSTN,LRN)
  61. C
  62. IFR=IFOU+4
  63. GOTO (666,10,10,10,666,40) ,IFR
  64. GOTO 666
  65. C
  66. C CONT PLANES, DEF PLANES OU AXISYMETRIQUE
  67. C
  68. 10 CONTINUE
  69. C
  70. DO 101 NP=1,NBNO
  71. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  72. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  73. 101 CONTINUE
  74. C
  75. CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  76. C
  77. IF(JCLE1.NE.0) THEN
  78. DO 110 I=1,NSTB
  79. DO 111 J=1,NFAC
  80. DO 112 K=1,NSTB
  81. L=NSTB*(J-1)+K
  82. M=L+NSTB*(2*(NFAC-J)+1)
  83. BGENE(I,L)=BPSS(I,K)*SHP(1,J)
  84. BGENE(I,M)=-BGENE(I,L)
  85. 112 CONTINUE
  86. 111 CONTINUE
  87. 110 CONTINUE
  88. ENDIF
  89. C
  90. IF(JCLE2.NE.0) THEN
  91. K=1
  92. DO 113 NP=NB1,NBNO
  93. XGENE(1,K)=SHP(1,NP)
  94. K=K+1
  95. 113 CONTINUE
  96. ENDIF
  97. C
  98. IF(JCLE3.NE.0) THEN
  99. K=1
  100. DO 114 NP=NB1,NBNO
  101. BGENE(1,K)=SHP(2,NP)
  102. K=K+1
  103. 114 CONTINUE
  104. ENDIF
  105. GOTO 666
  106. C
  107. C TRIDIMMENSIONNEL
  108. C
  109. 40 CONTINUE
  110. C
  111. DO 201 NP=1,NBNO
  112. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  113. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  114. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  115. 201 CONTINUE
  116. C
  117. CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  118. C
  119. IF(JCLE1.NE.0) THEN
  120. DO 210 I=1,NSTB
  121. DO 211 J=1,NFAC
  122. DO 212 K=1,NSTB
  123. L=NSTB*(J-1)+K
  124. M=L+NFAC*NSTB
  125. BGENE(I,L)=BPSS(I,K)*SHP(1,J)
  126. BGENE(I,M)=-BGENE(I,L)
  127. 212 CONTINUE
  128. 211 CONTINUE
  129. 210 CONTINUE
  130. ENDIF
  131. C
  132. IF(JCLE2.NE.0) THEN
  133. K=1
  134. DO 213 NP=NB1,NBNO
  135. XGENE(1,K)=SHP(1,NP)
  136. K=K+1
  137. 213 CONTINUE
  138. ENDIF
  139. C
  140. IF(JCLE3.NE.0) THEN
  141. K=1
  142. DO 214 NP=NB1,NBNO
  143. BGENE(1,K)=SHP(2,NP)
  144. BGENE(2,K)=SHP(3,NP)
  145. K=K+1
  146. 214 CONTINUE
  147. ENDIF
  148. GOTO 666
  149. C
  150. 666 CONTINUE
  151. RETURN
  152. END
  153.  
  154.  
  155.  
  156.  

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