Télécharger ksprjs.eso

Retour à la liste

Numérotation des lignes :

  1. C KSPRJS SOURCE PV 16/11/17 22:00:28 9180
  2. SUBROUTINE KSPRJS
  3. &(MELEME,IPM1,IPM2,IPM3,IAXI,IKAS,INEFMD,KPRE,IZTGG1,IPAD,IK1)
  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
  23. -INC SMELEME
  24. -INC SMLENTI
  25. -INC SMCHPOI
  26. POINTEUR IZTGG1.MPOVAL
  27. -INC CCREEL
  28. DIMENSION KIPM(3),XYZ1(24),UA(3),UB(3)
  29.  
  30.  
  31. C OPERATEUR PRESSION
  32. C
  33. MLENTI=IPAD
  34. DEUPI=1.D0
  35. IF(IAXI.NE.0)DEUPI=2.D0*XPI
  36. IF(IKAS.EQ.3)DEUPI=-DEUPI
  37.  
  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. C write(6,*)' INEFMD=',inefmd,'KPRE=',kpre
  48. IF(KPRE.NE.2)THEN
  49. IF(INEFMD.EQ.3)THEN
  50. IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'
  51. IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'
  52. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'PRF1'
  53. ELSEIF(INEFMD.EQ.2)THEN
  54. IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'
  55. IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'
  56. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'MCF1'
  57. ELSEIF(INEFMD.EQ.4)THEN
  58. NOM0=NOMS(ITYPEL)//' '
  59. ENDIF
  60. C write(6,*)' NOM0=',nom0,' ikas=',ikas,' nel=',nel
  61. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  62.  
  63. SEGACT IZFFM*MOD
  64. IZHR=KZHR(1)
  65. SEGACT IZHR*MOD
  66. NES=GR(/1)
  67. NPG=GR(/3)
  68. IZF1=KTP(1)
  69. SEGACT IZF1*MOD
  70. MP1=FN(/1)
  71.  
  72. DO 30 KE=1,NEL
  73.  
  74. DO 12 I=1,NP
  75. J=NUM(I,KE)
  76. DO 12 N=1,IDIM
  77. XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N)
  78. 12 CONTINUE
  79.  
  80. CALL CALJBR
  81. &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  82. C write(6,*)' Retour caljbr ',mp1,np,npg
  83.  
  84. DO 324 K=1,IDIM
  85. IPM4=KIPM(K)
  86. KG=(IK1-4)*(K-1)+1
  87.  
  88. DO 323 M=1,MP1
  89.  
  90. DO 323 I=1,NP
  91. U=0.D0
  92. DO 333 L=1,NPG
  93.  
  94. CALL INITD(UA,3,0.D0)
  95. CALL INITD(UB,3,0.D0)
  96.  
  97. DO 533 J=1,NP
  98. J1=LECT(NUM(J,KE))
  99. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  100. UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  101. 533 CONTINUE
  102.  
  103. U=U+FN(M,L)*
  104. &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(KG))*PGSQ(L)*DEUPI*RPG(L)
  105. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  106. U=U+FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
  107. ENDIF
  108.  
  109. 333 CONTINUE
  110.  
  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.  
  121. 37 CONTINUE
  122. 30 CONTINUE
  123.  
  124. SEGSUP IZHR,IZFFM
  125.  
  126.  
  127. C CAS MACRO CENTRE
  128.  
  129. ELSEIF(KPRE.EQ.2)THEN
  130. NOM0=NOMS(ITYPEL)//' '
  131. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  132.  
  133. SEGACT IZFFM*MOD
  134. IZHR=KZHR(1)
  135. SEGACT IZHR*MOD
  136. NES=GR(/1)
  137. NPG=GR(/3)
  138. IZF1=KTP(1)
  139. SEGACT IZF1*MOD
  140. MPG=IZF1.FN(/2)
  141. c modif tc initialisation de M à 1 ??? (izf1.fn(/1))
  142. M=1
  143.  
  144. NP=GR(/2)
  145.  
  146. DO 40 KE=1,NEL
  147.  
  148. IX=0
  149. DO 42 I=1,NP
  150. J=NUM(I,KE)
  151. DO 42 N=1,IDIM
  152. IX=IX+1
  153. XYZ1(IX)=XCOOR((J-1)*(IDIM+1) +N)
  154. 42 CONTINUE
  155.  
  156. CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,
  157. & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  158.  
  159. DO 424 K=1,IDIM
  160. IPM4=KIPM(K)
  161. KG=(IK1-4)*(K-1)+1
  162.  
  163. DO 423 I=1,NP
  164. U=0.D0
  165. DO 433 L=1,NPG
  166.  
  167. CALL INITD(UA,3,0.D0)
  168. CALL INITD(UB,3,0.D0)
  169. DO 633 J=1,NP
  170. J1=LECT(NUM(J,KE))
  171. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  172. UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  173. 633 CONTINUE
  174.  
  175. U=U+IZF1.FN(M,L)*
  176. &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(KG))*PGSQ(L)*DEUPI*RPG(L)
  177. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  178. U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
  179. ENDIF
  180.  
  181. 433 CONTINUE
  182.  
  183. if(ikas.ne.2)then
  184. IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U
  185. else
  186. IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U
  187. endif
  188.  
  189. 423 CONTINUE
  190. 424 CONTINUE
  191.  
  192. 40 CONTINUE
  193.  
  194. SEGSUP IZHR,IZFFM
  195.  
  196. ENDIF
  197.  
  198. RETURN
  199. 1002 FORMAT(10(1X,1PE11.4))
  200. 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))
  201. END
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  

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