Télécharger cli252.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI252 SOURCE PV 16/11/17 21:58:45 9180
  2. SUBROUTINE CLI252(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  3. & ICHPVO,ICHPSU,LRECP,LRECV,
  4. & IROC,IVITC,IPC,IYC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : CLI252
  10. C
  11. C DESCRIPTION : Subroutine appellée par CLIM22
  12. C Jacobian for 'OUTP '
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15. C
  16. C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C APPELES (Calcul) :
  21. C
  22. C************************************************************************
  23. C
  24. C HISTORIQUE (Anomalies et modifications éventuelles)
  25. C
  26. C HISTORIQUE :
  27. C
  28. C************************************************************************
  29. C
  30. C----------------------------------------------------
  31. C**** Variables de COOPTIO
  32. C----------------------------------------------------
  33. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  34. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  35. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  36. C & ,IECHO, IIMPI, IOSPI
  37. C & ,IDIM, IFICLE, IPREFI
  38. C & ,MCOORD
  39. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  40. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  41. C & ,NORINC,NORVAL,NORIND,NORVAD
  42. C & ,NUCROU, IPSAUV
  43. C
  44. IMPLICIT INTEGER(I-N)
  45. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  46. & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
  47. & ,NGF,NGC,NLF,NLC,NLCB
  48. & ,ILIINC,ILIINP,IJAC,II,JJ
  49. & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  50. & ,NSP,I, IYC,J, LRECP,LRECV,KV
  51. REAL*8 VOLU,SURF,RC,PC,UXC,UYC,CNX,CNY,CTX,CTY
  52. & ,PF,COEF
  53. REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2)
  54. CHARACTER*(8) TYPE
  55. -INC CCOPTIO
  56. -INC SMLMOTS
  57. -INC SMELEME
  58. POINTEUR MELEFC.MELEME
  59. -INC SMLENTI
  60. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  61. -INC SMCHPOI
  62. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  63. & MPVC.MPOVAL, MPPC.MPOVAL, MPLIM.MPOVAL, MPYC.MPOVAL
  64. POINTEUR CELL.IZAFM
  65. C-------------------------------------------------------
  66. -INC SMLREEL
  67. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  68. C-------------------------------------------------------
  69. C********* Les Jacobians ******************************
  70. C-------------------------------------------------------
  71. SEGMENT JACEL
  72. REAL*8 JAC(3+NSP,3+NSP)
  73. ENDSEGMENT
  74. POINTEUR JLL.JACEL,JPL.JACEL,JTL.JACEL,JTT.JACEL
  75. C-------------------------------------------------------------
  76. C******* Les fractionines massiques **************************
  77. C-------------------------------------------------------------
  78. SEGMENT FRAMAS
  79. REAL*8 YET(NSP)
  80. ENDSEGMENT
  81. POINTEUR YC.FRAMAS
  82. C-------------------------------------------------------
  83. C********** Les CP's and CV's ***********************
  84. C-------------------------------------------------------
  85. SEGMENT GCONST
  86. REAL*8 GC(NSP)
  87. ENDSEGMENT
  88. POINTEUR CP.GCONST, CV.GCONST
  89. C----------------------------------------------------
  90. C**** KRIPAD pour la correspondance global/local
  91. C----------------------------------------------------
  92. CALL KRIPAD(MELEMC,MLEMC)
  93. CALL KRIPAD(MELECB,MLEMCB)
  94. CALL KRIPAD(MELEMF,MLEMF)
  95. C----------------------------------------------------
  96. C**** CHPOINTs de la table DOMAINE
  97. C----------------------------------------------------
  98. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  99. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  100. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  101. C----------------------------------------------------
  102. C**** CHPOINTs des variables
  103. C----------------------------------------------------
  104. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  105. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  106. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  107. CALL LICHT(IYC,MPYC,TYPE,ICEL)
  108. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  109. C--------------------------------------------------------
  110. C**** Boucle sur le face pour le calcul des invariants de
  111. C Riemann et du flux
  112. C--------------------------------------------------------
  113. SEGACT MELEFC
  114. NFAC=MELEFC.NUM(/2)
  115. C---------------------------------
  116. C**** Objet MATRIK
  117. C---------------------------------
  118. NRIGE = 7
  119. NMATRI = 1
  120. NKID = 9
  121. NKMT = 7
  122. C---------------------------------
  123. SEGINI MATRIK
  124. IJACO = MATRIK
  125. MATRIK.IRIGEL(1,1) = MELRES
  126. MATRIK.IRIGEL(2,1) = MELRES
  127. C---------------------------------
  128. C**** Matrice non symetrique
  129. C---------------------------------
  130. MATRIK.IRIGEL(7,1) = 2
  131. C---------------------------------
  132. NBME = (3+NSP)*(3+NSP)
  133. NBSOUS = 1
  134. SEGINI IMATRI
  135. IF(IJAC.EQ.1)THEN
  136. MLMOTS=ILIINC
  137. ELSEIF(IJAC.EQ.2)THEN
  138. MLMOTS=ILIINP
  139. ENDIF
  140. SEGACT MLMOTS
  141. MATRIK.IRIGEL(4,1) = IMATRI
  142. C-------------------------------------------
  143. DO 1 J=1,(NSP+3)
  144. KV=(J-1)*(3+NSP)
  145. IMATRI.LISPRI(KV+1) = MLMOTS.MOTS(1)
  146. IMATRI.LISPRI(KV+2) = MLMOTS.MOTS(2)
  147. IMATRI.LISPRI(KV+3) = MLMOTS.MOTS(3)
  148. IMATRI.LISPRI(KV+4) = MLMOTS.MOTS(4)
  149. DO 2 I=1,(NSP-1)
  150. IMATRI.LISPRI(KV+4+I) = MLMOTS.MOTS(4+I)
  151. 2 CONTINUE
  152. 1 CONTINUE
  153. C-----------------------------------------------
  154. SEGDES MLMOTS
  155. MLMOTS=ILIINC
  156. SEGACT MLMOTS
  157. C-----------------------------------------------
  158. DO 3 J=1,(NSP+3)
  159. KV=(J-1)*(3+NSP)
  160. IMATRI.LISDUA(KV+1) = MLMOTS.MOTS(j)
  161. IMATRI.LISDUA(KV+2) = MLMOTS.MOTS(j)
  162. IMATRI.LISDUA(KV+3) = MLMOTS.MOTS(j)
  163. IMATRI.LISDUA(KV+4) = MLMOTS.MOTS(j)
  164. DO 4 I=1,(NSP-1)
  165. IMATRI.LISDUA(KV+4+I) = MLMOTS.MOTS(j)
  166. 4 CONTINUE
  167. 3 CONTINUE
  168. C-----------------------------------------------
  169. C-----------------------------------------------
  170. SEGDES MLMOTS
  171. NBEL = NFAC
  172. NBSOUS = 1
  173. NP = 1
  174. MP = 1
  175. C-----------------------------------------------------------
  176. C-----------------------------------------------------------
  177. DO 5 I=1,NBME
  178. SEGINI CELL
  179. IMATRI.LIZAFM(1,I) = CELL
  180. 5 CONTINUE
  181. C---------------------------------
  182. C**** Fin definition MATRIK
  183. C---------------------------------
  184. DO IFAC=1,NFAC,1
  185. NGF=MELEFC.NUM(1,IFAC)
  186. NGC=MELEFC.NUM(2,IFAC)
  187. NLF=MLEMF.LECT(NGF)
  188. NLC=MLEMC.LECT(NGC)
  189. NLCB=MLEMCB.LECT(NGF)
  190. VOLU=MPVOL.VPOCHA(NLC,1)
  191. SURF=MPSURF.VPOCHA(NLF,1)
  192. C In CASTEM les normales sont sortantes
  193. CNX=MPNORM.VPOCHA(NLF,1)
  194. CNY=MPNORM.VPOCHA(NLF,2)
  195. CTX=-1.0D0*CNY
  196. CTY=CNX
  197. C----------------------------------------------
  198. SEGINI CP, CV
  199. MLRECP = LRECP
  200. MLRECV = LRECV
  201. SEGACT MLRECP, MLRECV
  202. DO 10 I=1,(NSP-1)
  203. CP.GC(I)=MLRECP.PROG(I)
  204. CV.GC(I)=MLRECV.PROG(I)
  205. 10 CONTINUE
  206. CP.GC(NSP)=MLRECP.PROG(NSP)
  207. CV.GC(NSP)=MLRECV.PROG(NSP)
  208. C---------------------------------
  209. C Variables au centre
  210. C---------------------------------
  211. RC=MPRC.VPOCHA(NLC,1)
  212. PC=MPPC.VPOCHA(NLC,1)
  213. UXC=MPVC.VPOCHA(NLC,1)
  214. UYC=MPVC.VPOCHA(NLC,2)
  215. SEGINI YC
  216. SEGACT MPYC
  217. DO 100 I=1,(NSP-1)
  218. YC.YET(I)=MPYC.VPOCHA(NLC,I)
  219. 100 CONTINUE
  220. C---------------------------------
  221. C Variables à la face
  222. C---------------------------------
  223. PF=MPLIM.VPOCHA(NLCB,1)
  224. C------------------------------
  225. C******* Derivatives
  226. C------------------------------
  227. wvec_l(1)=RC
  228. wvec_l(2)=UXC
  229. wvec_l(3)=UYC
  230. wvec_l(4)=PC
  231. C--------------------------
  232. wvec_r(1)=RC
  233. wvec_r(2)=UXC
  234. wvec_r(3)=UYC
  235. wvec_r(4)=PF
  236. C--------------------------
  237. nvect(1)=CNX
  238. nvect(2)=CNY
  239. tvect(1)=CTX
  240. tvect(2)=CTY
  241. call copmsp(nsp,jpl,jll,wvec_l,wvec_r,nvect,tvect,
  242. & mpyc,lrecp,lrecv,nlc,nlc)
  243. C-----------------------------------------------
  244. COEF=-SURF/VOLU
  245. C----------------------------------------
  246. JTT=JLL
  247. JTL=JPL
  248. SEGACT JTT
  249. SEGACT JTL
  250. C----------------------------------------
  251. C----------------------------------------------------------------
  252. C******* Jacobian with respect to conservative variables
  253. C----------------------------------------------------------------
  254. IF(IJAC.EQ.1)THEN
  255. DO 9 II = 1,(3+NSP)
  256. DO 15 JJ = 1,(3+NSP)
  257. KV = (II-1)*(3+NSP)
  258. C----------------------------------
  259. CELL = IMATRI.LIZAFM(1,KV+JJ)
  260. CELL.AM(IFAC,1,1) = JTT.JAC(II,JJ)*COEF
  261. 15 CONTINUE
  262. 9 CONTINUE
  263. ELSEIF(IJAC.EQ.2)THEN
  264. DO 20 II = 1,(3+NSP)
  265. DO 25 JJ = 1,(3+NSP)
  266. KV = (II-1)*(3+NSP)
  267. C----------------------------------
  268. CELL = IMATRI.LIZAFM(1,KV+JJ)
  269. CELL.AM(IFAC,1,1) = JTL.JAC(II,JJ)*COEF
  270. 25 CONTINUE
  271. 20 CONTINUE
  272. ENDIF
  273. c--------------------------------------------------
  274. ENDDO
  275. C
  276. SEGDES MELEFC
  277. C
  278. SEGSUP MLEMC
  279. SEGSUP MLEMCB
  280. SEGSUP MLEMF
  281. C
  282. SEGDES MPNORM
  283. SEGDES MPVOL
  284. SEGDES MPSURF
  285. SEGDES MPRC
  286. SEGDES MPPC
  287. SEGDES MPVC
  288. SEGDES MPYC
  289. SEGDES MPLIM
  290. SEGDES YC
  291. c SEGDES YF
  292. SEGDES CP
  293. SEGDES CV
  294. SEGDES JTL
  295. SEGDES JTT
  296. c SEGDES WL
  297. c SEGDES DYDG1, DFRYG1,
  298. c & DG1DY, DGDYC
  299. SEGDES MATRIK
  300. DO 80 II=1,NBME
  301. CELL = IMATRI.LIZAFM(1,II)
  302. SEGDES CELL
  303. 80 CONTINUE
  304. SEGDES IMATRI
  305. C---------------------------------------------
  306. 9999 CONTINUE
  307. RETURN
  308. END
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  

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