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

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