Télécharger cakizd.eso

Retour à la liste

Numérotation des lignes :

  1. C CAKIZD SOURCE PV 14/01/30 21:15:05 7931
  2. SUBROUTINE CAKIZD
  3. C************************************************************************
  4. C OBJET :
  5. C Cet operateur construit une table KIZD
  6. C SYNTAXE
  7. C kdia RV ;
  8. C************************************************************************
  9. C
  10. C Aout 96 : correction d'erreurs pour le calcul de la matrice masse
  11. C diagonale dans le cas d'un CHPO centre sans C.L
  12. C (testé uniquement dans ce cas : P.Galon)
  13. C
  14. C 26/10/98 : lecture d'une table domaine OU d'un objet modèle
  15. C************************************************************************
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8 (A-H,O-Z)
  18. C
  19. CHARACTER*8 NOMI,TYPE,NOM,NOMZ,TYP0,TYPC
  20. CHARACTER*4 NOC,NOM4(9)
  21. C
  22. -INC CCOPTIO
  23. -INC CCREEL
  24. -INC SMTABLE
  25. POINTEUR MTABD.MTABLE,INCO.MTABLE
  26. POINTEUR KIZD.MTABLE
  27. C
  28. -INC SMCHPOI
  29. POINTEUR IPHI.MPOVAL
  30. POINTEUR IZD.MCHPOI ,IZD0.MCHPOI
  31. POINTEUR IZDD.MPOVAL,IZDD0.MPOVAL
  32. C
  33. -INC SMLMOTS
  34. POINTEUR MINCOG.MLMOTS
  35. C
  36. -INC SMELEME
  37. POINTEUR MELEMI.MELEME
  38. C
  39. -INC SMLENTI
  40. POINTEUR IZIPAD.MLENTI
  41. C
  42. PARAMETER (NTB=1)
  43. DIMENSION KTAB(NTB)
  44. CHARACTER*8 LTAB(NTB)
  45. DATA LTAB/'EQEX '/
  46. C
  47. NTO=1
  48. Cne sert jamais IAXI=0
  49. Cne sert jamais IF(IFOMOD.EQ.0)IAXI=2
  50. C
  51. C ---- Lecture de la Table "RV"
  52. C -----------------------
  53. CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  54. IF(IRET.EQ.0)RETURN
  55. C
  56. MTABLE=KTAB(1)
  57. SEGACT MTABLE
  58. C
  59. C ----- Lecture de la Table DOMINC
  60. C --------------------------
  61. TYPE=' '
  62. CALL ACMO(MTABLE,'DOMINC',TYPE,MDOMC)
  63. IF(TYPE.NE.'TABLE')THEN
  64. MOTERR(1:40)='On ne trouve pas DOMINC ds la Table EQEX'
  65. CALL ERREUR(-301)
  66. RETURN
  67. ENDIF
  68. C
  69. C ----- Lecture de la Table INCO
  70. C ------------------------
  71. TYPE=' '
  72. CALL ACMO(MTABLE,'INCO',TYPE,INCO)
  73. IF(TYPE.NE.'TABLE')THEN
  74. MOTERR(1:40)='On ne trouve pas INCO ds la Table EQEX '
  75. CALL ERREUR(-301)
  76. RETURN
  77. ENDIF
  78. C
  79. C ----- Lecture de la liste des inconnues
  80. C ---------------------------------
  81. TYPE=' '
  82. CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2)
  83. IF(TYPE.NE.'LISTMOTS')THEN
  84. MOTERR(1:40)='On ne trouve pas LISTINCO dans EQEX '
  85. CALL ERREUR(-301)
  86. RETURN
  87. ENDIF
  88. C
  89. SEGACT MLMOT2
  90. NBINC1=MLMOT2.MOTS(/2)
  91. C
  92. C ----- Lecture du CHPO des conditions limites (facultatif)
  93. C --------------------------------------
  94. TYPE=' '
  95. CALL ACMO(MTABLE,'CLIM',TYPE,MCHPOI)
  96. IF(TYPE.NE.'CHPOINT')THEN
  97. KCLIM=0
  98. ELSE
  99. KCLIM=1
  100. SEGACT MCHPOI
  101. NSOUPO=IPCHP(/1)
  102. ENDIF
  103. C
  104. C ----- Creation de la Table KIZD
  105. C -------------------------
  106. CALL CRTABL(KIZD)
  107. CALL ECMM(KIZD,'SOUSTYPE','KIZD')
  108. CALL ECMO(MTABLE,'KIZD','TABLE ',KIZD)
  109. C
  110. C ----- On Boucle sur la liste des inconnues
  111. C ====================================
  112. C
  113. C WRITE(IOIMP,*)' NBINC1=',nbinc1
  114. DO 1 L=1,NBINC1
  115. NOMI=MLMOT2.MOTS(L)
  116. C WRITE(IOIMP,*)' CAKIZD : NOMI=',nomi
  117. C
  118. C ----- lecture de la table domaine ou de l'objet modèle N-Stokes
  119. C ---------------------------------------------------------
  120. TYPE=' '
  121. CALL ACMO(MDOMC,NOMI,TYPE,MTABD)
  122. * WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type
  123. IF(TYPE.NE.'TABLE')THEN
  124. IF (TYPE.EQ.'MMODEL') THEN
  125. CALL LEKMOD(MTABD,MTABD2,INEFMD)
  126. MTABD=MTABD2
  127. ELSE
  128. MOTERR(1:40)='On ne trouve pas la Table Domaine '
  129. CALL ERREUR(-301)
  130. RETURN
  131. ENDIF
  132. ENDIF
  133. C
  134. C ----- la table sous table INCO contient elle l'inconnue
  135. C -------------------------------------------------
  136.  
  137. TYPE=' '
  138. CALL ACMO(INCO,NOMI,TYPE,MCHPHI)
  139. C WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type
  140. IF(TYPE.NE.'CHPOINT ')THEN
  141. MOTERR(1:40)='L inconnue n est pas dans la Table INCO '
  142. CALL ERREUR(-301)
  143. MOTERR(1:40)='ou l inconnue n est pas un Champoint '
  144. CALL ERREUR(-301)
  145. GO TO 1
  146. ELSE
  147. CALL LICHT(MCHPHI,IPHI,TYPC,IGEOM)
  148. ENDIF
  149. C
  150. NPT=IPHI.VPOCHA(/1)
  151. NC=IPHI.VPOCHA(/2)
  152. C WRITE(IOIMP,*)' NPT,NC,TYPC=',NPT,NC,TYPC
  153. IF(TYPC.EQ.'SOMMET')THEN
  154. C
  155. C ----- On cree une diagonale 'SOMMET'
  156. C -----------------------------
  157. CALL ECROBJ('TABLE ',MTABD)
  158. CALL CADGSI
  159. CALL LIROBJ('CHPOINT ',IZD0,1,IRET)
  160. CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0)
  161. ELSEIF(TYPC.EQ.'CENTRE')THEN
  162. C
  163. C ----- On cree une diagonale 'CENTRE'
  164. C -----------------------------
  165. CALL LEKTAB(MTABD,'XXVOLUM',IZD0)
  166. C
  167. IF(IZD0.EQ.0)RETURN
  168. CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0)
  169. ELSE
  170. MOTERR(1:40)='CHPO CENTRE ou SOMMET pour l inconnue '
  171. CALL ERREUR(-301)
  172. RETURN
  173. ENDIF
  174. C
  175. SEGDES IPHI
  176. C
  177. C ----- Creation des CHPO de la Table KIZD
  178. C ----------------------------------
  179. TYPE=' '
  180. CALL ACMO(KIZD,NOMI,TYPE,IZD)
  181. C
  182. IF(TYPE.NE.'CHPOINT ')THEN
  183. IF(NC.EQ.1)THEN
  184. NOM4(1)=NOMI(1:4)
  185. CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOM4)
  186. ELSE
  187. DO 15 I=1,NC
  188. WRITE(NOM4(I),FMT='(I1,A3)')I,NOMI(1:3)
  189. 15 CONTINUE
  190. CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOM4)
  191. ENDIF
  192. CALL LICHT(IZD,IZDD,TYPC,IGEOM)
  193. C
  194. DO 2 I=1,NC
  195. CALL RSETD(IZDD.VPOCHA(1,I),IZDD0.VPOCHA,NPT)
  196. 2 CONTINUE
  197. C
  198. CALL ECMO(KIZD,NOMI,'CHPOINT ',IZD)
  199. ELSE
  200. CALL LICHT(IZD,IZDD,TYPC,IGEOM)
  201. ENDIF
  202. C
  203. CALL KRIPAD(IGEOM,IZIPAD)
  204. C
  205. C ----- Boucle sur les composantes du Champoint
  206. C =======================================
  207. DO 3 I=1,NC
  208. IF(NC.EQ.1)THEN
  209. NOC=NOMI(1:4)
  210. ELSE
  211. WRITE(NOC,FMT='(I1,A3)')I,NOMI(1:3)
  212. ENDIF
  213. C
  214. C ---- Si pas de condition limite on ne fait rien de plus
  215. C --------------------------------------------------
  216. IF(KCLIM.EQ.0)GO TO 3
  217. C
  218. DO 10111 NSP=1,NSOUPO
  219. C
  220. MSOUPO=IPCHP(NSP)
  221. SEGACT MSOUPO
  222. NCOMP=NOCOMP(/2)
  223. C
  224. DO 10112 NCP=1,NCOMP
  225. IF(NOCOMP(NCP).EQ.NOC)THEN
  226. MELEMI=IGEOC
  227. SEGACT MELEMI
  228. LONG=MELEMI.NUM(/2)
  229. CALL VERPAD(IZIPAD,MELEMI,IRET)
  230. IF(IRET.NE.0)THEN
  231. MOTERR(1:40)
  232. $ ='C.Limites non incluses dans le domaine '
  233. CALL ERREUR(-301)
  234. RETURN
  235. ENDIF
  236. CALL RSETX1
  237. & (IZDD.VPOCHA(1,I),MELEMI.NUM,LONG,XGRAND
  238. $ ,IZIPAD.LECT)
  239. SEGDES MELEMI
  240. ENDIF
  241. 10112 CONTINUE
  242. C
  243. SEGDES MSOUPO
  244. C
  245. 10111 CONTINUE
  246. C
  247. 3 CONTINUE
  248. C
  249. SEGSUP IZIPAD
  250. SEGDES IZD,IZDD
  251. SEGDES IZD0,IZDD0
  252. 1 CONTINUE
  253. C
  254. C ---- FIN DE LA BOUCLE SUR LES INCONNUES
  255. C ----------------------------------
  256. SEGDES KIZD,INCO
  257. C
  258. IF(KCLIM.NE.0)SEGDES MCHPOI
  259. SEGDES MTABLE
  260. C
  261. RETURN
  262. END
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  

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