Télécharger konsf1.eso

Retour à la liste

Numérotation des lignes :

  1. C KONSF1 SOURCE PV 09/03/12 21:26:42 6325
  2. SUBROUTINE KONSF1(INDMET,ISF,IVN,INORM,ICHPSU,ICHPDI,
  3. & MELEMC,MELEMF,MELEFE,ICHFLU,DT,LOGAN,
  4. & MESERR)
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : KONSF1
  10. C
  11. C DESCRIPTION : Voir KONV14
  12. C
  13. C Cas 2D/3D
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, DM2S/SFME
  18. C
  19. C************************************************************************
  20. C
  21. C APPELES (Outils
  22. C CASTEM) : KRIPAD, LICHT
  23. C
  24. C APPELES (Calcul) :
  25. C
  26. C************************************************************************
  27. C
  28. C ENTREES
  29. C
  30. C 1) PARAMETRES
  31. C
  32. C INDMET : 1 UPWIND
  33. C
  34. C 2 CENTERED
  35. C
  36. C 2) Pointeurs des MCHAMLs/CHPOINTs
  37. C
  38. C ISF : MCHAML sur "FACEL" contenant les scalaires passifs
  39. C ("gauche" et "droite");
  40. C
  41. C IVN : CHPOINTs sur "FACE" (vitesse aux faces)
  42. C
  43. C 3) Pointeurs de CHPOINTs de la table DOMAINE
  44. C
  45. C INORM : CHPOINT "FACE" contenant les normales aux faces
  46. C
  47. C ICHPSU : CHPOINT "FACE" contenant la surface des faces
  48. C
  49. C ICHPDI : CHPOINT "CENTRE" contenant le diametre minimum
  50. C de chaque element
  51. C
  52. C
  53. C 4) Pointeurs de MELEME de la table DOMAINE
  54. C
  55. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  56. C
  57. C MELEMF : MELEME 'FACE' du SPG des FACES
  58. C
  59. C MELEFE : MELEME 'FACEL' du connectivité FACES -> ELEM
  60. C
  61. C SORTIES
  62. C
  63. C ICHFLU : pointeurs de CHPOINTs "FACE" des flux aux interfaces:
  64. C
  65. C DT : pas de temps pour le respect de la CFL-like condition
  66. C DT < DIAMMIN /2 /max(Lambda_i)
  67. C En maillage regulier cette condition garantie la
  68. C non-interaction des ondes
  69. C
  70. C LOGAN : (LOGICAL): si .TRUE. une anomalie à été detectée
  71. C
  72. C MESERR : pour l'ecriture des messages d'erreurs
  73. C
  74. C************************************************************************
  75. C
  76. C HISTORIQUE (Anomalies et modifications éventuelles)
  77. C
  78. C HISTORIQUE : créée le 29.11.01
  79. C
  80. C************************************************************************
  81. C
  82. C
  83. C**** Variables de COOPTIO
  84. C
  85. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  86. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  87. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  88. C & ,IECHO, IIMPI, IOSPI
  89. C & ,IDIM
  90. C & ,MCOORD
  91. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  92. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  93. C & ,NORINC,NORVAL,NORIND,NORVAD
  94. C & ,NUCROU, IPSAUV
  95. C
  96. IMPLICIT INTEGER(I-N)
  97. INTEGER INDMET, ISF, IVN, INORM
  98. & ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
  99. & ,IGEOMC,IGEOMF
  100. & ,ICHFLU
  101. & ,NFAC
  102. & ,NLCF, NGCEG, NGCED, NLCEG, NLCED
  103. & ,NGCF, NLCF1, NSCA, ISCA
  104. REAL*8 DT, UNSDT, UX, UY, UZ, UN
  105. & , SURF,CNX, CNY, CNZ
  106. & , CELL, DIAM
  107. LOGICAL LOGAN
  108. CHARACTER*(40) MESERR
  109. CHARACTER*(8) TYPE
  110. C
  111. C**** LES INCLUDES
  112. C
  113. -INC CCOPTIO
  114. -INC SMCHAML
  115. -INC SMCHPOI
  116. POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
  117. & , MPOFLU.MPOVAL, MPNORM.MPOVAL, MPOVIT.MPOVAL
  118. -INC SMELEME
  119. -INC SMLMOTS
  120. -INC SMLENTI
  121. C
  122. C**** Les flux aux interface dans le repaire (n,t)
  123. C
  124. INTEGER NFLU
  125. SEGMENT IFLUX
  126. REAL*8 FLUX(NFLU)
  127. ENDSEGMENT
  128. C
  129. C**** Scalaires
  130. C
  131. MCHEL1 = ISF
  132. SEGACT MCHEL1
  133. MCHAM1 = MCHEL1.ICHAML(1)
  134. SEGDES MCHEL1
  135. SEGACT MCHAM1
  136. NSCA= MCHAM1.IELVAL(/1)
  137. DO ISCA=1,NSCA,1
  138. MELVAL=MCHAM1.IELVAL(ISCA)
  139. SEGACT MELVAL
  140. ENDDO
  141. C
  142. C**** La vitesse
  143. C
  144. CALL LICHT(IVN,MPOVIT,TYPE,IGEOMC)
  145. IF(IERR.NE.0)GOTO 9999
  146. C SEGACT MPOVIT
  147. C
  148. C**** Le flux à l'interface
  149. C
  150. NFLU=NSCA
  151. SEGINI IFLUX
  152. C
  153. C**** Lecture des MELEMEs
  154. C
  155. C 'CENTRE', 'FACEL'
  156. C
  157. IPT2 = MELEFE
  158. SEGACT IPT2
  159. NFAC = IPT2.NUM(/2)
  160. C
  161. C**** KRIPAD pour la correspondance global/local de centre
  162. C
  163. CALL KRIPAD(MELEMC,MLENT1)
  164. IF(IERR.NE.0)GOTO 9999
  165. C
  166. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  167. C
  168. C Si i est le numero global d'un noeud de ICEN,
  169. C MLENT1.LECT(i) contient sa position, i.e.
  170. C
  171. C I = numero global du noeud centre
  172. C MLENT1.LECT(i) = numero local du noeud centre
  173. C
  174. C MLENT1 déjà activé, i.e.
  175. C
  176. C SEGACT MLENT1
  177. C
  178. C
  179. C**** KRIPAD pour la correspondance global/local de 'FACE'
  180. C
  181. CALL KRIPAD(MELEMF,MLENT2)
  182. IF(IERR.NE.0)GOTO 9999
  183. C SEGACT MELNT2
  184. C
  185. C**** CHPOINTs de la table DOMAINE
  186. C
  187. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  188. IF(IERR.NE.0)GOTO 9999
  189. CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
  190. IF(IERR.NE.0)GOTO 9999
  191. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  192. IF(IERR.NE.0)GOTO 9999
  193. C
  194. C**** LICHT active les MPOVALs en *MOD
  195. C
  196. C i.e.
  197. C
  198. C SEGACT MPOVSU*MOD
  199. C SEGACT MPOVDI*MOD
  200. C SEGACT MPNORM*MOD
  201. C
  202. C**** Les FLUX aux faces
  203. C
  204. CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
  205. C
  206. C SEGACT MPOFLU*MOD
  207. C
  208. C
  209. C**** Initialisation de 1/DT
  210. C
  211. UNSDT = 0.0D0
  212. C
  213. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  214. C
  215. DO NLCF = 1, NFAC
  216. C
  217. C******* NLCF = numero local du centre de facel
  218. C NGCF = numero global du centre de facel
  219. C NLCF1 = numero local du centre de face
  220. C NGCEG = numero global du centre ELT "gauche"
  221. C NLCEG = numero local du centre ELT "gauche"
  222. C NGCED = numero global du centre ELT "droite"
  223. C NLCED = numero local du centre ELT "droite"
  224. C
  225. NGCEG = IPT2.NUM(1,NLCF)
  226. NGCED = IPT2.NUM(3,NLCF)
  227. NGCF = IPT2.NUM(2,NLCF)
  228. NLCF1 = MLENT2.LECT(NGCF)
  229. NLCEG = MLENT1.LECT(NGCEG)
  230. NLCED = MLENT1.LECT(NGCED)
  231. C
  232. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  233. C
  234. IF(NLCF .NE. NLCF1)THEN
  235. MESERR = 'Il ne faut pas jouer avec la console. '
  236. LOGAN = .TRUE.
  237. GOTO 9999
  238. ENDIF
  239. C
  240. C******* Calcul du flux/DT
  241. C
  242. UX=MPOVIT.VPOCHA(NLCF,1)
  243. UY=MPOVIT.VPOCHA(NLCF,2)
  244. CNX=MPNORM.VPOCHA(NLCF,1)
  245. CNY=MPNORM.VPOCHA(NLCF,2)
  246. UN= (UX*CNX) + (UY*CNY)
  247. IF(IDIM .EQ.3)THEN
  248. UZ=MPOVIT.VPOCHA(NLCF,3)
  249. CNZ=MPNORM.VPOCHA(NLCF,3)
  250. UN=UN+(UZ*CNZ)
  251. ENDIF
  252. C
  253. IF(INDMET .EQ. 1)THEN
  254. IF(UN.GT.0.0D0)THEN
  255. DO ISCA=1,NSCA,1
  256. MELVAL=MCHAM1.IELVAL(ISCA)
  257. IFLUX.FLUX(ISCA)=UN*MELVAL.VELCHE(1,NLCF)
  258. DIAM = MPOVDI.VPOCHA(NLCEG,1)
  259. ENDDO
  260. ELSE
  261. DO ISCA=1,NSCA,1
  262. MELVAL=MCHAM1.IELVAL(ISCA)
  263. IFLUX.FLUX(ISCA)=UN*MELVAL.VELCHE(3,NLCF)
  264. DIAM = MPOVDI.VPOCHA(NLCED,1)
  265. ENDDO
  266. ENDIF
  267. ELSEIF(INDMET .EQ. 2)THEN
  268. DO ISCA=1,NSCA,1
  269. MELVAL=MCHAM1.IELVAL(ISCA)
  270. IFLUX.FLUX(ISCA)=UN*(MELVAL.VELCHE(1,NLCF)+MELVAL
  271. $ .VELCHE(3,NLCF))*0.5D0
  272. DIAM = MIN(MPOVDI.VPOCHA(NLCED,1),MPOVDI.VPOCHA(NLCEG,1))
  273. ENDDO
  274. ENDIF
  275. C
  276. C******* Ecriture des flux
  277. C
  278. SURF = MPOVSU.VPOCHA(NLCF,1)
  279. DO ISCA=1,NSCA,1
  280. MPOFLU.VPOCHA(NLCF,ISCA) =
  281. & (IFLUX.FLUX(ISCA) * SURF )
  282. ENDDO
  283. C
  284. C******* Calcul du pas du temps (CFL)
  285. C
  286. CELL = ABS(UN)/DIAM
  287. IF(CELL .GT. UNSDT)THEN
  288. UNSDT = CELL
  289. ENDIF
  290. C
  291. C**** Fin boucle sur FACEL
  292. C
  293. ENDDO
  294. C
  295. C**** Pas du temps (condition de non interaction en 1D)
  296. C
  297. DT = 0.5D0 / UNSDT
  298. C
  299. C**** Desactivation des segments et
  300. C on detruit les MCHAMLs
  301. C
  302. SEGSUP MLENT1
  303. SEGSUP MLENT2
  304. SEGDES IPT2
  305. C
  306. SEGSUP IFLUX
  307. C
  308. SEGDES MPOVSU
  309. SEGDES MPOVDI
  310. SEGDES MPNORM
  311. C
  312. SEGDES MPOFLU
  313. C
  314. DO ISCA=1,NSCA,1
  315. MELVAL=MCHAM1.IELVAL(ISCA)
  316. SEGDES MELVAL
  317. ENDDO
  318. SEGDES MCHAM1
  319. C
  320. 9999 CONTINUE
  321. C
  322. RETURN
  323. END
  324. C
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  

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