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

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