Télécharger kmec.eso

Retour à la liste

Numérotation des lignes :

  1. C KMEC SOURCE PV 16/11/17 21:59:46 9180
  2. SUBROUTINE KMEC(MTABP,MATRAK)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C Operateur KMEC
  7. C
  8. C OBJET : Cree un objet de type MATRAK
  9. C APPELE PAR KMAC
  10. C SYNTAXE : RESU = KMAC RVP <IMPR> ;
  11. C
  12. C RVP : TABLE de soustype EQPR (cree par EQPR)
  13. C IMPR : impression du contenu de l'objet'
  14. C
  15. C REMARQUE : Cet objet n'est pas un objet STANDART CASTEM2000
  16. C Il n'est donc pas listable
  17. C Il est tout juste bon a mettre dans la table RVP pour etre utilise
  18. C par les operateurs de résolution de la matrice de contrainte
  19. C***********************************************************************
  20. -INC CCOPTIO
  21. -INC SMCHPOI
  22. POINTEUR IZCH2.MCHPOI,IZCCH2.MPOVAL
  23. POINTEUR IZDV.MCHPOI,IZDDV.MPOVAL
  24. C-INC SMMATRAKANC
  25. C*************************************************************************
  26. C
  27. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  28. C
  29.  
  30. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  31. * (points CENTRE ) pour chaque operateur de contrainte
  32. * KGEOC SPG pour la totalite des points CENTRE.
  33. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  34. * KLEMC Connectivites de l'ensemble des contraintes
  35. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  36.  
  37. SEGMENT MATRAK
  38. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  39. INTEGER LIZAFM(NBSOUS)
  40. INTEGER IKAM0 (NBSOUS)
  41. INTEGER IMEM (NBELC)
  42. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  43. ENDSEGMENT
  44.  
  45. SEGMENT IZAFM
  46. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  47. ENDSEGMENT
  48.  
  49. POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  50.  
  51. C*******************************************************************
  52. -INC SMLENTI
  53. POINTEUR IZIPAD.MLENTI
  54. -INC SMLMOTS
  55. -INC SMTABLE
  56. POINTEUR MTABP.MTABLE,MTABX.MTABLE,MTABZ.MTABLE
  57. -INC SMELEME
  58. POINTEUR MELEMZ.MELEME,MELEMB.MELEME
  59. POINTEUR MELEM1.MELEME,MELES1.MELEME
  60. POINTEUR IGEOM.MELEME
  61. POINTEUR IZLEMC.MELEME
  62.  
  63. LOGICAL*1 BVAL,VRAI
  64. PARAMETER (NBOPER=4)
  65. CHARACTER*8 LIOPER(NBOPER),TYPE,TYPC,NOML,NOMO,NOM,LMOT(1)
  66. C
  67. DATA LIOPER/'PRESSIO ','VNIMP ','VTIMP ','DPDQ '/
  68. C***
  69. IMPR=0
  70. TYPE=' '
  71. CALL ACMO(MTABP,'LISTOPER',TYPE,MLMOTS)
  72. IF(TYPE.NE.'LISTMOTS')THEN
  73. RETURN
  74. ENDIF
  75. SEGACT MLMOTS
  76. NBOP=MOTS(/2)
  77.  
  78. IZLEMC=0
  79. NBSOUS=0
  80. NBELC=0
  81. KM=1
  82. KMS=1
  83. SEGINI MATRAK
  84.  
  85. DO 1 M=1,NBOP
  86.  
  87. NOML=MOTS(M)
  88. TYPE=' '
  89. CALL ACMO(MTABP,NOML,TYPE,MTABX)
  90. IF(TYPE.NE.'TABLE ')GO TO 90
  91. SEGACT MTABX
  92. TYPE=' '
  93. CALL ACMO(MTABX,'DOMZ',TYPE,MTABZ)
  94. IF(TYPE.NE.'TABLE ')GO TO 90
  95. SEGACT MTABZ
  96. TYPE=' '
  97. CALL ACMO(MTABZ,'CENTRE',TYPE,MELEM1)
  98. IF(TYPE.NE.'MAILLAGE')GO TO 90
  99.  
  100. IF(M.LT.10)THEN
  101. NOMO=MOTS(M)(2:8)
  102. ELSE
  103. NOMO=MOTS(M)(3:8)
  104. ENDIF
  105. CALL OPTLI(IP,LIOPER,NOMO,NBOPER)
  106. C write(6,*)' NOMO=',NOMO,':',' IP=',IP
  107. IF(IP.EQ.0)THEN
  108. WRITE(6,*)' Operateur : ',NOMO,' inconnu '
  109. RETURN
  110. ENDIF
  111.  
  112. IAXI = 0
  113. IF(IFOMOD.EQ.0)IAXI=2
  114.  
  115. C On va chercher ou on construit MELEMZ et MELEMB
  116.  
  117.  
  118. TYPE=' '
  119. CALL ACMO(MTABZ,'MAILLAGE',TYPE,MELEMZ)
  120. IF(TYPE.NE.'MAILLAGE')GO TO 90
  121. CALL KNBEL(MELEMZ,NBELCN)
  122.  
  123. C pour MELEMB c'est plus complique
  124.  
  125. LGEOC(M)=MELEM1
  126.  
  127. IF(IP.EQ.2.OR.IP.EQ.3)THEN
  128. CALL ECRCHA('POI1')
  129. CALL ECROBJ('MAILLAGE',MELEMZ)
  130. CALL PRCHAN
  131. TYPE='MAILLAGE'
  132. CALL LIROBJ(TYPE,MELES1,1,IRET)
  133. IF(IRET.EQ.0)GO TO 90
  134. SEGACT MELES1
  135. IF(IRET.EQ.0)GO TO 90
  136. CALL KAMLPT(MELES1,MELEMZ,IRET)
  137. SEGDES MELES1
  138. MELEMZ=IRET
  139. SEGACT MELEMZ
  140. NBPZ=MELEMZ.NUM(/2)
  141. NBREF=MELEMZ.LISREF(/1)
  142. MELEMB=MELEMZ.LISREF(NBREF)
  143. LGEOC(M)=MELEMB
  144. C il semble que la numerotation soit meilleure sans l'appel de ORDOTA
  145. C au moins pour l'utilisation de VNSIMP et VTSIMP avec des CHPOINTs
  146. C CALL ORDOTA(MELEMZ.NUM,NBPZ)
  147. CALL KRIPAD(MELEMZ,IZIPAD)
  148.  
  149. TYPE='CENTRE'
  150. CALL CRCHPT(TYPE,MELEMB,1,IZCH2)
  151. CALL ECMO(MTABX,'IZCH2','CHPOINT ',IZCH2)
  152. CALL LICHT(IZCH2,IZCCH2,TYPE,IGEOM)
  153.  
  154. ENDIF
  155.  
  156. C La on peut dire qu'on a MELEMZ et MELEMB
  157.  
  158. MELEMB=LGEOC(M)
  159. SEGACT MELEMB
  160. NNELB=MELEMB.NUM(/2)
  161. IDEBS(M)=KMS
  162. IFINS(M)=KMS+NNELB-1
  163. KMS=KMS+NNELB
  164. SEGDES MELEMB
  165.  
  166. CALL CATMEL(IZLEMC,MELEMZ)
  167.  
  168. SEGACT MELEMZ
  169. NBSOUZ=MELEMZ.LISOUS(/1)
  170. IF(NBSOUZ.EQ.0)NBSOUZ=1
  171. NBSOU0=LIZAFM(/1)
  172. NBSOUS=NBSOU0+NBSOUZ
  173. NBELC=IMEM(/1)
  174. SEGADJ MATRAK
  175.  
  176. DO 11 L=1,NBSOUZ
  177. IPT1=MELEMZ
  178. IF(NBSOUZ.NE.1)IPT1=MELEMZ.LISOUS(L)
  179. SEGACT IPT1
  180. NNELP=IPT1.NUM(/2)
  181. NELAX=0
  182. NP=IPT1.NUM(/1)
  183. IESP=IDIM
  184. NBELC0=IMEM(/1)
  185. NBELC=NBELC0+NNELP
  186. SEGADJ MATRAK
  187.  
  188. CALL INITI(IMEM(KM),NNELP,NBSOU0+L)
  189. SEGINI IZAFM
  190. KAM0=KM
  191. LIZAFM(NBSOU0+L)=IZAFM
  192. IKAM0 (NBSOU0+L)=KAM0
  193. C write(6,*)' KAS kmac IP=',IP
  194.  
  195. GO TO (10,20,30,40),IP
  196. 10 CONTINUE
  197. C write(6,*)' Appel a KPRESS'
  198. CALL KPRESS(IPT1,IZAFM,IAXI,IMPR)
  199. C write(6,*)' Retour de KPRESS '
  200. GO TO 9
  201. 20 CONTINUE
  202.  
  203. C write(6,*)' Appel a VNSIMP'
  204. CALL VNSIMP(IPT1,IZAFM,IZCCH2,IZIPAD)
  205. C write(6,*)' Retour de VNSIMP'
  206. SEGDES IZCH2,IZCCH2
  207. SEGSUP IZIPAD
  208. GO TO 9
  209. 30 CONTINUE
  210.  
  211. CALL VTSIMP(IPT1,IZAFM,IZCCH2,IZIPAD)
  212. SEGDES IZCH2,IZCCH2
  213. SEGSUP IZIPAD
  214. GO TO 9
  215.  
  216. 40 CONTINUE
  217.  
  218. C CALL KDPDQ(IPT1,IZAFM,HK,IAXI,IMPR)
  219. C SEGDES IZCH2,IZCCH2
  220. C SEGSUP IZIPAD
  221. write(6,*)' Operateur hors service '
  222. GO TO 9
  223.  
  224. 9 CONTINUE
  225.  
  226. SEGDES IZAFM
  227. SEGDES IPT1
  228. KM=KM+NNELP
  229. 11 CONTINUE
  230. SEGDES MELEMZ
  231. SEGDES MTABX,MTABZ
  232.  
  233. 1 CONTINUE
  234.  
  235. IGEO1=LGEOC(1)
  236.  
  237. IF(NBOP.GT.1)THEN
  238. IGEO1=0
  239. DO 2 M=1,NBOP
  240. MLGEOC=LGEOC(M)
  241. CALL FUSSPG(MLGEOC,IGEO1)
  242. 2 CONTINUE
  243. ENDIF
  244.  
  245. KGEOC=IGEO1
  246.  
  247. KLEMC=IZLEMC
  248.  
  249. TYPE=' '
  250. CALL ACMO(MTABP,'DIAGV',TYPE,IZDV)
  251. IF(TYPE.NE.'CHPOINT')THEN
  252. WRITE(6,*)' l''entree DIAGV n''existe pas dans la table EQPR'
  253. RETURN
  254. ENDIF
  255. CALL LICHT(IZDV,IZDDV,TYPC,IGEOM)
  256. SEGDES IZDV,IZDDV
  257.  
  258. INK=1
  259. CALL KRIPAD(IGEOM,IZIPAD)
  260. NBPT=IZIPAD.LECT(/1)
  261. SEGACT IZLEMC
  262. NBSOUS=IZLEMC.LISOUS(/1)
  263. IF(NBSOUS.EQ.0)NBSOUS=1
  264. DO 401 L=1,NBSOUS
  265. IPT1=IZLEMC
  266. IF(NBSOUS.NE.1)IPT1=IZLEMC.LISOUS(L)
  267. SEGACT IPT1
  268. NP=IPT1.NUM(/1)
  269. NEL=IPT1.NUM(/2)
  270. MLENTI=IZIPAD
  271. DO 402 K=1,NEL
  272. DO 402 I=1,NP
  273. j=IPT1.NUM(I,K)
  274. IF(LECT(J).EQ.0)THEN
  275. INK=0
  276. C write(6,*)' Objet non inclus '
  277. return
  278. endif
  279. 402 CONTINUE
  280. SEGDES IPT1
  281. 401 CONTINUE
  282. SEGDES IZLEMC
  283. SEGSUP IZIPAD
  284.  
  285. KGEOS=IGEOM
  286.  
  287. SEGDES MLMOTS
  288. SEGDES MATRAK
  289. RETURN
  290. 90 CONTINUE
  291. MATRAK=0
  292. RETURN
  293. 1001 FORMAT(20(1X,I5))
  294. END
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  

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