Télécharger kpruss.eso

Retour à la liste

Numérotation des lignes :

  1. C KPRUSS SOURCE PV 16/11/17 22:00:20 9180
  2. SUBROUTINE KPRUSS(MELEME,MELEM2,
  3. &IPM1,IPM2,IPM3,IAXI,IKAS,INEFMD,KPRE,IZTGG1,IK1,K0,IKOMP)
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C*****************************************************************************
  8. C
  9. C Ce SP calcule les matrices elementaires de divergence alias C
  10. C
  11. C IKAS=1 KMCT calcul de Ct (Div U)
  12. C IKAS=2 KMAC calcul de C uniquement (Grad p)
  13. C IKAS=3 KCCT calcul de C assemblage pour C et Ct
  14. C
  15. C*****************************************************************************
  16. CHARACTER*8 NOM0
  17.  
  18. -INC CCOPTIO
  19. -INC CCGEOME
  20. -INC SMCOORD
  21. -INC SIZFFB
  22. POINTEUR IZF1.IZFFM,IZH2.IZHR
  23. -INC SMELEME
  24. POINTEUR MELEM2.MELEME
  25. -INC SMCHPOI
  26. POINTEUR IZTGG1.MPOVAL
  27. -INC CCREEL
  28. DIMENSION KIPM(3),XYZ1(24)
  29.  
  30.  
  31. C OPERATEUR PRESSION
  32. C
  33. DEUPI=1.D0
  34. IF(IAXI.NE.0)DEUPI=2.D0*XPI
  35. IF(IKAS.EQ.3)DEUPI=-DEUPI
  36.  
  37. C write(6,*)' DEUPI=',deupi
  38. IF(IDIM.EQ.2)IPM3=IPM1
  39. KIPM(1)=IPM1
  40. KIPM(2)=IPM2
  41. KIPM(3)=IPM3
  42. SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD
  43.  
  44. NP=NUM(/1)
  45. NEL=NUM(/2)
  46.  
  47. IF(KPRE.NE.2)THEN
  48. IF(INEFMD.EQ.3)THEN
  49. IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'
  50. IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'
  51. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'PFP1'
  52. ELSEIF(INEFMD.EQ.2)THEN
  53. IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'
  54. IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'
  55. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'MCF1'
  56. ELSEIF(INEFMD.EQ.1)THEN
  57. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'P1P1'
  58. ELSEIF(INEFMD.EQ.4)THEN
  59. NOM0=NOMS(ITYPEL)//' '
  60. ENDIF
  61.  
  62. C write(6,*)' Kpruss : NOM0=',nom0,' ikas=',ikas,' nel=',nel
  63. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  64.  
  65. SEGACT IZFFM*MOD
  66. IZHR=KZHR(1)
  67. IZH2=KZHR(2)
  68.  
  69. SEGACT IZHR*MOD,IZH2*MOD
  70.  
  71. NES=GR(/1)
  72. NPG=GR(/3)
  73. IZF1=KTP(1)
  74. SEGACT IZF1*MOD
  75. MP1=IZF1.FN(/1)
  76. MP=MELEM2.NUM(/1)
  77.  
  78. DO 30 KE=1,NEL
  79. NK=K0+KE
  80.  
  81. C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  82. IF(IKOMP.EQ.1)THEN
  83. DO 12 I=1,NP
  84. J=NUM(I,KE)
  85. DO 12 N=1,IDIM
  86. XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N)
  87. 12 CONTINUE
  88.  
  89. CALL CALJBR
  90. &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  91.  
  92. DO 324 K=1,IDIM
  93. IPM4=KIPM(K)
  94.  
  95. DO 323 M=1,MP1
  96.  
  97. DO 323 I=1,NP
  98. U=0.D0
  99. DO 333 L=1,NPG
  100. U=U+IZF1.FN(M,L)*HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L)
  101. 333 CONTINUE
  102.  
  103. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  104. DO 334 L=1,NPG
  105. U=U+IZF1.FN(M,L)*FN(I,L)*PGSQ(L)*DEUPI
  106. 334 CONTINUE
  107. ENDIF
  108.  
  109. K1=1+(1-IK1)*(NK-1)
  110. U=U*IZTGG1.VPOCHA(K1,1)
  111.  
  112. if(ikas.ne.2)then
  113. IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
  114. else
  115. IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
  116. endif
  117.  
  118. 323 CONTINUE
  119. 324 CONTINUE
  120. C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  121. ELSE
  122.  
  123. DO 13 I=1,MP1
  124. J=MELEM2.NUM(I,KE)
  125. DO 13 N=1,IDIM
  126. IZH2.XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N)
  127. 13 CONTINUE
  128.  
  129. CALL CALJBR(IZF1.FN,IZF1.GR,PG,
  130. & IZH2.XYZ,IZH2.HR,IZH2.PGSQ,IZH2.RPG,NES,IDIM,MP1,NPG,IAXI,AIRE,
  131. & IZH2.AJ,SGN)
  132.  
  133. DO 524 K=1,IDIM
  134. IPM4=KIPM(K)
  135.  
  136. DO 523 M=1,MP1
  137.  
  138. DO 523 I=1,NP
  139. U=0.D0
  140. DO 533 L=1,NPG
  141. U=U+FN(I,L)*IZH2.HR(K,M,L)*IZH2.PGSQ(L)*DEUPI*IZH2.RPG(L)
  142. 533 CONTINUE
  143.  
  144. K1=1+(1-IK1)*(NK-1)
  145. U=U*IZTGG1.VPOCHA(K1,1)
  146.  
  147. if(ikas.ne.2)then
  148. IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
  149. else
  150. IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
  151. endif
  152.  
  153. 523 CONTINUE
  154. 524 CONTINUE
  155.  
  156. ENDIF
  157. C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  158.  
  159. 37 CONTINUE
  160. 30 CONTINUE
  161.  
  162. SEGSUP IZHR,IZFFM,IZH2
  163.  
  164.  
  165. C CAS MACRO CENTRE
  166.  
  167. ELSEIF(KPRE.EQ.2)THEN
  168. NOM0=NOMS(ITYPEL)//' '
  169. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  170.  
  171. SEGACT IZFFM*MOD
  172. IZHR=KZHR(1)
  173. IZH2=KZHR(2)
  174. SEGACT IZHR*MOD,IZH2*MOD
  175. NES=GR(/1)
  176. NPG=GR(/3)
  177. IZF1=KTP(1)
  178. SEGACT IZF1*MOD
  179. MPG=IZF1.FN(/2)
  180. NP=GR(/2)
  181.  
  182. DO 40 KE=1,NEL
  183.  
  184. NK=K0+KE
  185.  
  186. IX=0
  187. DO 42 I=1,NP
  188. J=NUM(I,KE)
  189. DO 42 N=1,IDIM
  190. IX=IX+1
  191. XYZ1(IX)=XCOOR((J-1)*(IDIM+1) +N)
  192. 42 CONTINUE
  193.  
  194. CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,
  195. & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  196.  
  197. DO 424 K=1,IDIM
  198. IPM4=KIPM(K)
  199.  
  200. DO 423 I=1,NP
  201. U=0.D0
  202. DO 433 L=1,NPG
  203. U=U+HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L)
  204. 433 CONTINUE
  205.  
  206. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  207. DO 434 L=1,NPG
  208. U=U+FN(I,L)*PGSQ(L)*DEUPI
  209. 434 CONTINUE
  210. ENDIF
  211.  
  212. K1=1+(1-IK1)*(NK-1)
  213. U=U*IZTGG1.VPOCHA(K1,1)
  214.  
  215. if(ikas.ne.2)then
  216. IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U
  217. else
  218. IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U
  219. endif
  220.  
  221. 423 CONTINUE
  222. 424 CONTINUE
  223.  
  224. 40 CONTINUE
  225.  
  226. SEGSUP IZHR,IZFFM,IZH2
  227.  
  228. ENDIF
  229.  
  230. C write(6,*)' Retour KPRUSS'
  231. RETURN
  232. 1002 FORMAT(10(1X,1PE11.4))
  233. 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))
  234. END
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  

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