Télécharger kprjss.eso

Retour à la liste

Numérotation des lignes :

kprjss
  1. C KPRJSS SOURCE CB215821 20/11/25 13:32:50 10792
  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 I=1,NP
  86. J=NUM(I,KE)
  87. DO N=1,IDIM
  88. XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N)
  89. ENDDO
  90. ENDDO
  91.  
  92. CALL CALJBR
  93. &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  94. C write(6,*)' Retour caljbr ',mp1,np,npg
  95.  
  96. DO 324 K=1,IDIM
  97. IPM4=KIPM(K)
  98. KG=(IK1-4)*(K-1)+1
  99.  
  100. DO M=1,MP1
  101.  
  102. DO I=1,NP
  103. U=0.D0
  104. DO 333 L=1,NPG
  105.  
  106. CALL INITD(UA,3,0.D0)
  107. CALL INITD(UB,3,0.D0)
  108.  
  109. DO 633 J=1,NP
  110. J1=LECT(NUM(J,KE))
  111. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  112. UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  113. 633 CONTINUE
  114.  
  115. U=U+IZF1.FN(M,L)*
  116. &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)
  117. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  118. U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
  119. ENDIF
  120.  
  121. 333 CONTINUE
  122.  
  123.  
  124. if(ikas.ne.2)then
  125. IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
  126. else
  127. IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
  128. endif
  129.  
  130. ENDDO
  131. ENDDO
  132. 324 CONTINUE
  133. C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% IKOMP = 0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  134. ELSE
  135. DO I=1,NP
  136. J=NUM(I,KE)
  137. DO N=1,IDIM
  138. IZH2.XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N)
  139. ENDDO
  140. ENDDO
  141.  
  142. CALL CALJBR(IZF1.FN,IZF1.GR,PG,
  143. & IZH2.XYZ,IZH2.HR,IZH2.PGSQ,IZH2.RPG,NES,IDIM,MP1,NPG,IAXI,AIRE,
  144. & IZH2.AJ,SGN)
  145.  
  146. C? CALL CALJBR
  147. C? &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  148. C write(6,*)' Retour caljbr ',mp1,np,npg
  149.  
  150. DO 524 K=1,IDIM
  151. IPM4=KIPM(K)
  152. KG=(IK1-4)*(K-1)+1
  153.  
  154. DO M=1,MP1
  155.  
  156. DO I=1,NP
  157. U=0.D0
  158. DO 533 L=1,NPG
  159.  
  160. CALL INITD(UA,3,0.D0)
  161. CALL INITD(UB,3,0.D0)
  162.  
  163. DO 733 J=1,NP
  164. J1=LECT(NUM(J,KE))
  165. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  166. UB(K)=UB(K)+IZH2.HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  167. 733 CONTINUE
  168.  
  169. U=U+IZF1.FN(M,L)*
  170. &(IZH2.HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))
  171. & *IZH2.PGSQ(L)*DEUPI*IZH2.RPG(L)
  172.  
  173. 533 CONTINUE
  174.  
  175.  
  176. if(ikas.ne.2)then
  177. IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
  178. else
  179. IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
  180. endif
  181.  
  182. ENDDO
  183. ENDDO
  184. 524 CONTINUE
  185.  
  186. ENDIF
  187. C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  188. 30 CONTINUE
  189.  
  190. SEGSUP IZHR,IZFFM,IZH2
  191.  
  192. C CAS MACRO CENTRE
  193.  
  194. ELSEIF(KPRE.EQ.2)THEN
  195. NOM0=NOMS(ITYPEL)//' '
  196. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  197.  
  198. SEGACT IZFFM*MOD
  199. IZHR=KZHR(1)
  200. IZH2=KZHR(2)
  201. SEGACT IZHR*MOD,IZH2*MOD
  202. NES=GR(/1)
  203. NPG=GR(/3)
  204. IZF1=KTP(1)
  205. SEGACT IZF1*MOD
  206. NPG=IZF1.FN(/2)
  207. MP1=IZF1.FN(/1)
  208. NP=GR(/2)
  209.  
  210. DO 40 KE=1,NEL
  211.  
  212. IX=0
  213. DO I=1,NP
  214. J=NUM(I,KE)
  215. DO N=1,IDIM
  216. IX=IX+1
  217. XYZ1(IX)=XCOOR((J-1)*(IDIM+1) +N)
  218. ENDDO
  219. ENDDO
  220.  
  221. CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,
  222. & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  223.  
  224. DO 424 K=1,IDIM
  225. IPM4=KIPM(K)
  226. KG=(IK1-4)*(K-1)+1
  227.  
  228. DO M=1,MP1
  229. DO I=1,NP
  230. U=0.D0
  231. DO 433 L=1,NPG
  232.  
  233. CALL INITD(UA,3,0.D0)
  234. CALL INITD(UB,3,0.D0)
  235. DO 833 J=1,NP
  236. J1=LECT(NUM(J,KE))
  237. UA(KG)=UA(KG)+FN(J,L)*IZTGG1.VPOCHA(J1,KG)
  238. UB(K)=UB(K)+HR(K,J,L)*IZTGG1.VPOCHA(J1,KG)
  239. 833 CONTINUE
  240.  
  241. U=U+IZF1.FN(M,L)*
  242. &(HR(K,I,L)*UA(KG) + FN(I,L)*UB(K ))*PGSQ(L)*DEUPI*RPG(L)
  243. IF(IAXI.NE.0.AND.K.EQ.1)THEN
  244. U=U+IZF1.FN(M,L)*FN(I,L)*UA(KG)*PGSQ(L)*DEUPI
  245. ENDIF
  246.  
  247. 433 CONTINUE
  248.  
  249. if(ikas.ne.2)then
  250. IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U
  251. else
  252. IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U
  253. endif
  254.  
  255. ENDDO
  256. ENDDO
  257. 424 CONTINUE
  258.  
  259. 40 CONTINUE
  260.  
  261. SEGSUP IZHR,IZFFM,IZH2
  262.  
  263. ENDIF
  264.  
  265. RETURN
  266. 1002 FORMAT(10(1X,1PE11.4))
  267. 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))
  268. END
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  

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