Télécharger kprjss.eso

Retour à la liste

Numérotation des lignes :

  1. C KPRJSS SOURCE PV 16/11/17 22:00:19 9180
  2. SUBROUTINE KPRJSS(MELEME,MELEM2,
  3. &IPM1,IPM2,IPM3,IAXI,IKAS,INEFMD,KPRE,IZTGG1,IPAD,IK1,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 SMLENTI
  28. -INC SMCHPOI
  29. POINTEUR IZTGG1.MPOVAL
  30. -INC CCREEL
  31. DIMENSION KIPM(3),XYZ1(24),UA(3),UB(3)
  32.  
  33.  
  34. C OPERATEUR PRESSION
  35. C
  36. MLENTI=IPAD
  37. DEUPI=1.D0
  38. IF(IAXI.NE.0)DEUPI=2.D0*XPI
  39. IF(IKAS.EQ.3)DEUPI=-DEUPI
  40.  
  41. IF(IDIM.EQ.2)IPM3=IPM1
  42. KIPM(1)=IPM1
  43. KIPM(2)=IPM2
  44. KIPM(3)=IPM3
  45. SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD
  46.  
  47. NP=NUM(/1)
  48. NEL=NUM(/2)
  49.  
  50. C write(6,*)' INEFMD=',inefmd,'KPRE=',kpre
  51. IF(KPRE.NE.2)THEN
  52. IF(INEFMD.EQ.3)THEN
  53. IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'
  54. IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'
  55. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'PFP1'
  56. ELSEIF(INEFMD.EQ.2)THEN
  57. IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'
  58. IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'
  59. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'MCF1'
  60. ELSEIF(INEFMD.EQ.1)THEN
  61. IF(KPRE.EQ.5)NOM0=NOMS(ITYPEL)//'P1P1'
  62. ELSEIF(INEFMD.EQ.4)THEN
  63. NOM0=NOMS(ITYPEL)//' '
  64. ENDIF
  65. C write(6,*)' NOM0=',nom0,' ikas=',ikas,' nel=',nel
  66. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  67.  
  68. SEGACT IZFFM*MOD
  69. IZHR=KZHR(1)
  70. IZH2=KZHR(2)
  71.  
  72. SEGACT IZHR*MOD,IZH2*MOD
  73.  
  74. NES=GR(/1)
  75. NPG=GR(/3)
  76. IZF1=KTP(1)
  77. SEGACT IZF1*MOD
  78. MP1=IZF1.FN(/1)
  79. MP=MELEM2.NUM(/1)
  80.  
  81. DO 30 KE=1,NEL
  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. C write(6,*)' Retour caljbr ',mp1,np,npg
  94.  
  95. DO 324 K=1,IDIM
  96. IPM4=KIPM(K)
  97. KG=(IK1-4)*(K-1)+1
  98.  
  99. DO 323 M=1,MP1
  100.  
  101. DO 323 I=1,NP
  102. U=0.D0
  103. DO 333 L=1,NPG
  104.  
  105. CALL INITD(UA,3,0.D0)
  106. CALL INITD(UB,3,0.D0)
  107.  
  108. DO 633 J=1,NP
  109. J1=LECT(NUM(J,KE))
  110. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  111. UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  112. 633 CONTINUE
  113.  
  114. U=U+IZF1.FN(M,L)*
  115. &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)
  116. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  117. U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
  118. ENDIF
  119.  
  120. 333 CONTINUE
  121.  
  122.  
  123. if(ikas.ne.2)then
  124. IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
  125. else
  126. IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
  127. endif
  128.  
  129. 323 CONTINUE
  130. 324 CONTINUE
  131. C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  132. ELSE
  133. DO 13 I=1,NP
  134. J=NUM(I,KE)
  135. DO 13 N=1,IDIM
  136. IZH2.XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N)
  137. 13 CONTINUE
  138.  
  139. CALL CALJBR(IZF1.FN,IZF1.GR,PG,
  140. & IZH2.XYZ,IZH2.HR,IZH2.PGSQ,IZH2.RPG,NES,IDIM,MP1,NPG,IAXI,AIRE,
  141. & IZH2.AJ,SGN)
  142.  
  143. C? CALL CALJBR
  144. C? &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  145. C write(6,*)' Retour caljbr ',mp1,np,npg
  146.  
  147. DO 524 K=1,IDIM
  148. IPM4=KIPM(K)
  149. KG=(IK1-4)*(K-1)+1
  150.  
  151. DO 523 M=1,MP1
  152.  
  153. DO 523 I=1,NP
  154. U=0.D0
  155. DO 533 L=1,NPG
  156.  
  157. CALL INITD(UA,3,0.D0)
  158. CALL INITD(UB,3,0.D0)
  159.  
  160. DO 733 J=1,NP
  161. J1=LECT(NUM(J,KE))
  162. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  163. UB(K)=UB(K)+IZH2.HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  164. 733 CONTINUE
  165.  
  166. U=U+IZF1.FN(M,L)*
  167. &(IZH2.HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))
  168. & *IZH2.PGSQ(L)*DEUPI*IZH2.RPG(L)
  169.  
  170. 533 CONTINUE
  171.  
  172.  
  173. if(ikas.ne.2)then
  174. IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
  175. else
  176. IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
  177. endif
  178.  
  179. 523 CONTINUE
  180. 524 CONTINUE
  181.  
  182. ENDIF
  183. C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  184. 30 CONTINUE
  185.  
  186. SEGSUP IZHR,IZFFM,IZH2
  187.  
  188. C CAS MACRO CENTRE
  189.  
  190. ELSEIF(KPRE.EQ.2)THEN
  191. NOM0=NOMS(ITYPEL)//' '
  192. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  193.  
  194. SEGACT IZFFM*MOD
  195. IZHR=KZHR(1)
  196. IZH2=KZHR(2)
  197. SEGACT IZHR*MOD,IZH2*MOD
  198. NES=GR(/1)
  199. NPG=GR(/3)
  200. IZF1=KTP(1)
  201. SEGACT IZF1*MOD
  202. NPG=IZF1.FN(/2)
  203. MP1=IZF1.FN(/1)
  204. NP=GR(/2)
  205.  
  206. DO 40 KE=1,NEL
  207.  
  208. IX=0
  209. DO 42 I=1,NP
  210. J=NUM(I,KE)
  211. DO 42 N=1,IDIM
  212. IX=IX+1
  213. XYZ1(IX)=XCOOR((J-1)*(IDIM+1) +N)
  214. 42 CONTINUE
  215.  
  216. CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,
  217. & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  218.  
  219. DO 424 K=1,IDIM
  220. IPM4=KIPM(K)
  221. KG=(IK1-4)*(K-1)+1
  222.  
  223. DO 423 M=1,MP1
  224. DO 423 I=1,NP
  225. U=0.D0
  226. DO 433 L=1,NPG
  227.  
  228. CALL INITD(UA,3,0.D0)
  229. CALL INITD(UB,3,0.D0)
  230. DO 833 J=1,NP
  231. J1=LECT(NUM(J,KE))
  232. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  233. UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  234. 833 CONTINUE
  235.  
  236. U=U+IZF1.FN(M,L)*
  237. &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)
  238. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  239. U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
  240. ENDIF
  241.  
  242. 433 CONTINUE
  243.  
  244. if(ikas.ne.2)then
  245. IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U
  246. else
  247. IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U
  248. endif
  249.  
  250. 423 CONTINUE
  251. 424 CONTINUE
  252.  
  253. 40 CONTINUE
  254.  
  255. SEGSUP IZHR,IZFFM,IZH2
  256.  
  257. ENDIF
  258.  
  259. RETURN
  260. 1002 FORMAT(10(1X,1PE11.4))
  261. 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))
  262. END
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  

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