Télécharger caljcc.eso

Retour à la liste

Numérotation des lignes :

  1. C CALJCC SOURCE CHAT 05/01/12 21:46:46 5004
  2. SUBROUTINE CALJCC(FN,GR,PG,XYZ,HR,PGSQ,RPG,IES,ND,NP,NPG,IAXI,
  3. &AIRE,AJ,HHR)
  4. C************************************************************************
  5. C
  6. C CE SP DIFFERRE DE CALICC PAR LE RANGEMENT DE HR
  7. C
  8. C HR(IES,NP,1)
  9. C HHR(ND,NP,1)
  10. C
  11. C DANS LE CAS DES ELEMENTS COQUES LE CHANGEMENT DE REPERE SE FAIT EN
  12. C TEMPS 1/ DANS LE PLAN DE L'ELEMENT : HHR
  13. C 2/ ROTATION 3D : HR
  14. C
  15. C CALCUL DE L'INVERSE DU JACOBIEN AJ=1/J
  16. C CALCUL DE L'AIRE OU VOLUME AIRE
  17. C CALCUL DE PGSQ(L)
  18. C CALCUL DE RPG(L)
  19. C CALCUL DE DES GRADIENTS HR(ND,NP)
  20. C CALCUL INTERMEDIAIRE DE L'ELEMENT D'AIRE SQ=DET(J)
  21. C DANS LES CAS 2D ET 3D
  22. C
  23. C IES DIMENSION ESPACE
  24. C ND DIMENSION ESPACE DE L'ELEMENT
  25. C NP NOMBRE DE NOEUDS DE L'ELEMENT
  26. C NPG NOMBRE DE POINTS D'INTEGRATION
  27. C
  28. C XYZ COORDONNEES
  29. C GR GRADIENT
  30. C B & KAUX TABLEAUX DE TRAVAIL
  31. C************************************************************************
  32. IMPLICIT INTEGER(I-N)
  33. IMPLICIT REAL*8 (A-H,O-Z)
  34. C
  35. -INC CCREEL
  36. C
  37. REAL*8 FN(NP,NPG),GR(ND,NP,1),HR(IES,NP,1),HHR(ND,NP,1)
  38. REAL*8 PG(NPG),XYZ(IES,NP),PGSQ(NPG),RPG(NPG),XY(2,9)
  39. REAL*8 SQ(9),B(3),AJ(IES,IES,NPG),AJJ(3,3,9)
  40. C
  41. DIMENSION KAUX(3)
  42. C
  43. C***
  44. C WRITE(6,*) ' *** SUB CALJCC *** IES=',IES
  45.  
  46. IF(IES.NE.2)GO TO 30
  47.  
  48. C ---------- 2D ----------
  49. C CAS DES ELEMENTS POUTRE 2D
  50.  
  51. TX=XYZ(1,NP)-XYZ(1,1)
  52. TY=XYZ(2,NP)-XYZ(2,1)
  53.  
  54. AIRE=TX*TX+TY*TY
  55. AIRE=SQRT(AIRE)
  56.  
  57. TX=TX/AIRE
  58. TY=TY/AIRE
  59.  
  60. PX=-TY
  61. PY=TX
  62.  
  63. C WRITE(6,*)' TX,TY=',TX,TY
  64. C WRITE(6,*)' PX,PY=',PX,PY
  65. C WRITE(6,*)' AIRE =',AIRE,' NPG=',NPG
  66. C WRITE(6,*)' PG =',PG
  67. C WRITE(6,*)' GR =',GR
  68. C CALL ARRET(0)
  69.  
  70.  
  71.  
  72. DO 20 L=1,NPG
  73.  
  74. AJ(1,1,L)=TX
  75. AJ(1,2,L)=TY
  76. AJ(2,1,L)=PX
  77. AJ(2,2,L)=PY
  78. PGSQ(L)=PG(L)*AIRE
  79.  
  80. DO 20 I=1,NP
  81. HR(1,I,L)=AJ(1,1,L)*GR(1,I,L)/PGSQ(L)
  82. HR(2,I,L)=AJ(1,2,L)*GR(1,I,L)/PGSQ(L)
  83. 20 CONTINUE
  84.  
  85. IF(IAXI.EQ.0)RETURN
  86. C
  87. ID=3-IAXI
  88. IF(IAXI.EQ.3)CALL ARRET(0)
  89. DO 25 L=1,NPG
  90. RPG(L)=XZERO
  91. DO 26 I=1,NP
  92. RPG(L)=RPG(L)+XYZ(ID,I)*FN(I,L)
  93. 26 CONTINUE
  94. 25 CONTINUE
  95. C
  96. AIRE=XZERO
  97. DO 27 L=1,NPG
  98. PGSQ(L)=PGSQ(L)*2.0D0*XPI*RPG(L)
  99. AIRE=AIRE+PGSQ(L)
  100. 27 CONTINUE
  101. RETURN
  102.  
  103. 30 CONTINUE
  104. C ---------- 3D ----------
  105. IF(ND.NE.1)GO TO 40
  106. C CAS DES ELEMENTS POUTRE 3D
  107.  
  108. TX=XYZ(1,NP)-XYZ(1,1)
  109. TY=XYZ(2,NP)-XYZ(2,1)
  110. TZ=XYZ(3,NP)-XYZ(3,1)
  111.  
  112. AIRE=TX*TX+TY*TY+TZ*TZ
  113. AIRE=SQRT(AIRE)
  114.  
  115. TX=TX/AIRE
  116. TY=TY/AIRE
  117. TZ=TZ/AIRE
  118.  
  119. QX=3*TY-2*TZ
  120. QY=TZ-3*TX
  121. QZ=2*TX-TY
  122.  
  123. QQ=QX*QX+QY*QY+QZ*QZ
  124. QQ=SQRT(QQ)
  125.  
  126. QX=QX/QQ
  127. QY=QY/QQ
  128. QZ=QZ/QQ
  129.  
  130. PX=QY*TZ-QZ*TY
  131. PY=QZ*TX-QX*TZ
  132. PZ=QX*TY-QY*TX
  133.  
  134.  
  135. DO 31 L=1,NPG
  136.  
  137. AJ(1,1,L)=TX
  138. AJ(1,2,L)=TY
  139. AJ(1,3,L)=TZ
  140. AJ(2,1,L)=PX
  141. AJ(2,2,L)=PY
  142. AJ(2,3,L)=PZ
  143. AJ(3,1,L)=QX
  144. AJ(3,2,L)=QY
  145. AJ(3,3,L)=QZ
  146. PGSQ(L)=PG(L)*AIRE
  147.  
  148. DO 31 I=1,NP
  149. C HR(1,I,L)=AJ(1,1,L)*GR(1,I,L)
  150. HR(1,I,L)=GR(1,I,L)/AIRE
  151. C HR(2,I,L)=AJ(1,2,L)*GR(1,I,L)
  152. HR(2,I,L)=XZERO
  153. C HR(3,I,L)=AJ(1,3,L)*GR(1,I,L)
  154. HR(3,I,L)=XZERO
  155. 31 CONTINUE
  156. RETURN
  157.  
  158. 40 CONTINUE
  159. C WRITE(6,*)' *** CAS DES ELEMENTS COQUES 3D ***'
  160.  
  161.  
  162. CALL CALJQB(XYZ,AJJ,3,NP)
  163. CALL CALJXY(XYZ,AJJ,IES,XY,ND,NP)
  164.  
  165.  
  166.  
  167. C WRITE(6,*)' SUB CALJCC : APPEL A CALJ22 '
  168. C WRITE(6,*)' ND,NP,NPG,IAXI=',ND,NP,NPG,IAXI
  169.  
  170. C DO 441 L=1,NPG
  171. C WRITE(6,*)' L=',L
  172. C WRITE(6,1002) (GR(1,I,L),I=1,NP)
  173. C WRITE(6,1002) (GR(2,I,L),I=1,NP)
  174. C441 CONTINUE
  175.  
  176. CALL CALJ22(FN,GR,PG,XY,HHR,PGSQ,RPG,ND,NP,NPG,IAXI,AIRE,AJ)
  177.  
  178. DO 41 L=1,NPG
  179. PGSQ(L)=PG(L)*AIRE
  180. DO 41 I=1,NP
  181. DO 41 N=1,IES
  182. HR(N,I,L)=XZERO
  183. DO 41 M=1,ND
  184. HR(N,I,L)=HR(N,I,L)+AJJ(M,N,1)*HHR(M,I,L)
  185. 41 CONTINUE
  186.  
  187. RETURN
  188. 1002 FORMAT(10(1X,1PE11.4))
  189. 1001 FORMAT(20(1X,I5))
  190. END
  191.  
  192.  
  193.  
  194.  
  195.  

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