Télécharger cakizd.eso

Retour à la liste

Numérotation des lignes :

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

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