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

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