Télécharger laplvf.eso

Retour à la liste

Numérotation des lignes :

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

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