Télécharger laplvf.eso

Retour à la liste

Numérotation des lignes :

laplvf
  1. C LAPLVF SOURCE CB215821 20/11/25 13:33:25 10792
  2. SUBROUTINE LAPLVF(PKIZX)
  3. C------------------------------------------------------------
  4. C------------------------------------------------------------
  5. C
  6. C--------------------------
  7. C Paramètre Entrée/Sortie :
  8. C--------------------------
  9. C E/ PDOMA : TABLE de sous-type DOMAINE
  10. C E/ PKIZX : TABLE de sous-type KIZX
  11. C E/ KIMPL : Indicateur précisant l'intégration en temps
  12. C
  13. C------------------------------------------------------------
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8 (A-H,O-Z)
  16. C
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20. -INC SMLMOTS
  21. -INC SMLENTI
  22. -INC SMCHPOI
  23. -INC SMCHAML
  24. -INC SMELEME
  25. -INC SMTABLE
  26. C
  27. POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME
  28. POINTEUR MELEMA.MELEME, MELEMP.MELEME
  29. POINTEUR PKIZX.MTABLE , PINCO.TABLE , PDOMA.MTABLE, PEQEX.TABLE
  30. POINTEUR IPADC.MLENTI,IPADF.MLENTI
  31. CHARACTER*8 NOMI, NOMA, NOM
  32. CHARACTER*8 TYPE, TYPC
  33. DIMENSION IXV(3)
  34. C
  35. C- Récupération de la table EQEX
  36. C
  37. CALL LEKTAB(PKIZX,'EQEX',PEQEX)
  38. IF (PEQEX.EQ.0) THEN
  39. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  40. MOTERR( 1: 8) = ' EQEX '
  41. MOTERR( 9:16) = ' EQEX '
  42. MOTERR(17:24) = ' KIZX '
  43. CALL ERREUR(786)
  44. RETURN
  45. ENDIF
  46. C
  47. C- Récupération de la table INCO
  48. C
  49. CALL LEKTAB(PEQEX,'INCO',PINCO)
  50. IF (PINCO.EQ.0) THEN
  51. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  52. MOTERR( 1: 8) = ' INCO '
  53. MOTERR( 9:16) = ' INCO '
  54. MOTERR(17:24) = ' KIZX '
  55. CALL ERREUR(786)
  56. RETURN
  57. ENDIF
  58. C
  59. C- Récupération de la table DOMAINE
  60. C
  61. CALL LEKTAB(PKIZX,'DOMZ',PDOMA)
  62. IF(PDOMA.EQ.0) THEN
  63. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  64. MOTERR( 1: 8) = ' DOMZ '
  65. MOTERR( 9:16) = ' DOMZ '
  66. MOTERR(17:24) = ' KIZX '
  67. CALL ERREUR(786)
  68. RETURN
  69. ENDIF
  70. C
  71. C- Récupération de la table KOPT
  72. C
  73. CALL LEKTAB(PKIZX,'KOPT',KOPTI)
  74. IF (KOPTI.EQ.0) THEN
  75. C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
  76. MOTERR( 1: 8) = ' EQEX '
  77. MOTERR( 9:16) = ' EQEX '
  78. MOTERR(17:24) = ' KIZX '
  79. CALL ERREUR(786)
  80. RETURN
  81. ELSE
  82. CALL ACME(KOPTI,'KIMPL',KIMPL)
  83. IF (IERR.NE.0) RETURN
  84. CALL ACME(KOPTI,'KFORM',KFORM)
  85. IF (IERR.NE.0) RETURN
  86. ENDIF
  87. IF (KIMPL.NE.1) THEN
  88. C Tentative d'utilisation d'une option non implémentée
  89. CALL ERREUR(251)
  90. RETURN
  91. ENDIF
  92. C
  93. C- Récupérations des informations de la table DOMAINE
  94. C
  95. CALL LEKTAB(PDOMA,'CENTRE' ,MELEMC)
  96. CALL LEKTAB(PDOMA,'FACE' ,MELEMF)
  97. CALL LEKTAB(PDOMA,'XXSURFAC',MCHPO1)
  98. CALL LEKTAB(PDOMA,'XXNORMAF',MCHPO2)
  99. CALL LEKTAB(PDOMA,'FACEL' ,MELEFE)
  100. CALL LEKTAB(PDOMA,'ELTFA' ,MELEMA)
  101. CALL LEKTAB(PDOMA,'XXNORMAE',MCHEL1)
  102. IF (IERR.NE.0) RETURN
  103. C
  104. SEGACT MELEMA
  105. NBSOUS = MELEMA.LISOUS(/1)
  106. NBNN = MELEMA.NUM(/1)
  107. NBELEM = MELEMA.NUM(/2)
  108. NBREF = MELEMA.LISREF(/1)
  109. IF (NBSOUS.EQ.0) NBSOUS=1
  110. NBPART = NBSOUS
  111. C
  112. C- Lecture de la viscosité
  113. C
  114. IXV(1) = MELEMC
  115. IXV(2) = 1
  116. IXV(3) = 0
  117. IRET = 0
  118. CALL LEKCOF('OPERATEUR LAPN :',
  119. & PKIZX,PINCO,1,IXV,MCHPO3,MPOVA3,NPT3,NC3,IK3,IRET)
  120. IF (IRET.EQ.0) RETURN
  121. C
  122. C- Récupération du nom de l'inconnue
  123. C
  124. TYPE='LISTMOTS'
  125. CALL ACMO(PKIZX,'LISTINCO',TYPE,MLMOTS)
  126. SEGACT MLMOTS
  127. NBINC = MOTS(/2)
  128. NOMI = MOTS(1)
  129. NOMA = NOMI
  130. IF (NBINC.EQ.2) NOMA=MOTS(2)
  131. SEGDES MLMOTS
  132. C
  133. C- Récupération de l'inconnue duale
  134. C
  135. TYPE = ' '
  136. CALL ACMO(PINCO,NOMA,TYPE,MCHPOI)
  137. IF (TYPE.NE.'CHPOINT ') THEN
  138. C Indice %m1:8 : ne contient pas un objet de type %m9:16
  139. MOTERR( 1: 8) = 'INC '//NOMA
  140. MOTERR( 9:16) = 'CHPOINT '
  141. CALL ERREUR(800)
  142. RETURN
  143. ELSE
  144. CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEME)
  145. NINKO = VPOCHA(/2)
  146. IF (NINKO.NE.1.AND.NINKO.NE.IDIM) THEN
  147. C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes
  148. MOTERR( 1: 8) = 'INC '//NOMA
  149. MOTERR( 9:16) = 'CHPOINT '
  150. CALL ERREUR(784)
  151. RETURN
  152. ENDIF
  153. ENDIF
  154. C
  155. C- Vérification de la compatibilité des supports
  156. C
  157. CALL KRIPAD(MELEME,MLENT1)
  158. CALL VERPAD(MLENT1,MELEMC,IRET)
  159. IF (IRET.NE.0) THEN
  160. C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  161. MOTERR( 1: 8) = 'INC '//NOMA
  162. MOTERR( 9:16) = 'CHPOINT '
  163. CALL ERREUR(784)
  164. ENDIF
  165. SEGSUP MLENT1
  166. C
  167. C --------------------------------------------
  168. C TRAITEMENT DU SEGMENT DE STOKAGE MATRIK
  169. C DE LA MATRICE ELEMENTAIRE.
  170. C --------------------------------------------
  171. C
  172. NRIGE = 7
  173. NMATRI = 1
  174. NKID = 9
  175. NKMT = 7
  176. SEGINI MATRIK
  177. NBME = NINKO
  178. NBSOUS = NBPART
  179. SEGINI IMATRI
  180. IRIGEL(4,1) = IMATRI
  181. IRIGEL(7,1) = 0
  182. KSPGP = MELEMC
  183. KSPGD = MELEMC
  184. IF (NBME.EQ.1) THEN
  185. LISPRI(1)=NOMI(1:4)//' '
  186. LISDUA(1)=NOMA(1:4)//' '
  187. ELSE
  188. DO I=1,NBME
  189. WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7)
  190. LISPRI(I)=NOM(1:4)//' '
  191. WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7)
  192. LISDUA(I)=NOM(1:4)//' '
  193. ENDDO
  194. ENDIF
  195. C
  196. C- Création des connectivités entre inconnues primales
  197. C
  198. IF (NBPART.GT.1) THEN
  199. NBNN = 0
  200. NBELEM = 0
  201. NBSOUS = NBPART
  202. NBREF = 0
  203. ENDIF
  204. SEGINI MELEMP
  205. C
  206. C- Construction des matrices élémentaires associées à chaque LISOUS
  207. C
  208. C NUTOEL : Nombre d'éléments déjà traité
  209. C
  210. NUTOEL= 0
  211. CALL KRIPAD(MELEMF,IPADF)
  212. CALL KRIPAD(MELEMC,IPADC)
  213. SEGACT MELEMC,MELEMF,MELEFE,MELEMA
  214. CALL LICHT(MCHPO1,MPOVA1,TYPC,MELEME)
  215. CALL LICHT(MCHPO2,MPOVA2,TYPC,MELEME)
  216. SEGACT MCHEL1
  217. DO L=1,NBPART
  218. IPT1= MELEMA
  219. IF (NBSOUS.GT.1) THEN
  220. IPT1= MELEMA.LISOUS(L)
  221. ENDIF
  222. SEGACT IPT1
  223. NBEL = IPT1.NUM(/2)
  224. MCHAM1 = MCHEL1.ICHAML(L)
  225. SEGACT MCHAM1
  226. MELVA1 = MCHAM1.IELVAL(1)
  227. SEGACT MELVA1
  228. CALL LAPVF2(MPOVA1,MPOVA2,MPOVA3,IK3,MELEMC,MELEMF,MELEFE,
  229. & IPT1,MELVA1,IPADF,IPADC,L,NUTOEL,
  230. & MATRIK,IMATRI,MELEMP)
  231. SEGDES MELVA1
  232. SEGDES MCHAM1
  233. SEGDES IPT1
  234. NUTOEL = NUTOEL + NBEL
  235. ENDDO
  236. SEGDES MCHEL1
  237. CALL ECMO(PKIZX,'MATELM','MATRIK',MATRIK)
  238. C
  239. C- Ménage
  240. C
  241. SEGSUP IPADF,IPADC
  242. SEGDES MATRIK,IMATRI
  243. SEGDES MPOVA1,MPOVA2,MPOVA3
  244. SEGDES MELEMC,MELEMF,MELEFE
  245. IF (NBSOUS.EQ.1) SEGDES MELEMA
  246. C
  247. RETURN
  248. END
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  

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