Télécharger pre411.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE411 SOURCE PV 09/03/12 21:31:08 6325
  2. SUBROUTINE PRE411(ICEN,IFACE,IFACEL,MLMCOM,IROC,IROF,
  3. & LOGAN,MESERR)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : PRE411
  9. C
  10. C DESCRIPTION : Voir PRE41
  11. C
  12. C Cas 2D/3D
  13. C 1er ordre en espace, 1re ordre en temps
  14. C
  15. C Creations des objets MCHAML IROF
  16. C
  17. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  18. C
  19. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  20. C
  21. C************************************************************************
  22. C
  23. C
  24. C APPELES (Outils) : KRIPAD, LICHT
  25. C
  26. C APPELES (Calcul) : AUCUN
  27. C
  28. C
  29. C************************************************************************
  30. C
  31. C ENTREES
  32. C
  33. C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
  34. C
  35. C ICEN : MELEME de 'POI1' SPG des CENTRES
  36. C
  37. C IFACE : MELEME de 'POI1' SPG des FACES
  38. C
  39. C IFACEL : MELEME de 'SEG3' avec
  40. C CENTRE d'Elt "gauche"
  41. C CENTRE de Face
  42. C CENTRE d'Elt "droite"
  43. C
  44. C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
  45. C
  46. C 2) Pointeurs des CHPOINTs
  47. C
  48. C IROC : CHPOINT "CENTRE" contenant les scalaires
  49. C
  50. C SORTIES
  51. C
  52. C
  53. C IROF : MCHAML defini sur le MELEME de pointeur IFACEL,
  54. C contenant les scalaires
  55. C
  56. C LOGAN : anomalie detectee (changement de la convention dans
  57. C la table domaine)
  58. C
  59. C MESERR : pour les messages d'erreur
  60. C
  61. C************************************************************************
  62. C
  63. C HISTORIQUE (Anomalies et modifications éventuelles)
  64. C
  65. C HISTORIQUE : Créée le 28.12.01.
  66. C
  67. C************************************************************************
  68. C
  69. C
  70. C**** Variables de COOPTIO
  71. C
  72. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  73. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  74. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  75. C & ,IECHO, IIMPI, IOSPI
  76. C & ,IDIM
  77. CC & ,MCOORD
  78. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  79. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  80. C & ,NORINC,NORVAL,NORIND,NORVAD
  81. C & ,NUCROU, IPSAUV
  82. C
  83. C**** Les variables
  84. C
  85. IMPLICIT INTEGER(I-N)
  86. INTEGER ICEN, IFACE, IFACEL, IROC
  87. & , IROF
  88. & , IGEOM, NFAC
  89. & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
  90. & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1, I1
  91. REAL*8 ROG, ROD
  92. CHARACTER*(40) MESERR
  93. CHARACTER*(8) TYPE
  94. LOGICAL LOGAN
  95. C
  96. C**** Les Includes
  97. C
  98. -INC SMCOORD
  99. -INC CCOPTIO
  100. -INC SMCHPOI
  101. POINTEUR MPROC.MPOVAL
  102. -INC SMCHAML
  103. -INC SMLENTI
  104. -INC SMELEME
  105. -INC SMLMOTS
  106. POINTEUR MLMCOM.MLMOTS
  107. C
  108. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  109. C
  110. C MESERR = ' '
  111. C MOTERR(1:40) = MESERR(1:40)
  112. C
  113. C
  114. C**** KRIPAD pour la correspondance global/local de centre
  115. C
  116. CALL KRIPAD(ICEN,MLENT1)
  117. C
  118. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  119. C
  120. C Si i est le numero global d'un noeud de ICEN,
  121. C MLENT1.LECT(i) contient sa position, i.e.
  122. C
  123. C I = numero global du noeud centre
  124. C MLENT1.LECT(i) = numero local du noeud centre
  125. C
  126. C MLENT1 déjà activé, i.e.
  127. C
  128. C SEGACT MLENT1
  129. C
  130. C**** Activation de CHPOINTs
  131. C
  132. CALL LICHT(IROC, MPROC, TYPE, IGEOM)
  133. C SEGACT MPROC
  134. C
  135. C**** Le MELEME FACEL
  136. C
  137. IPT1 = IFACEL
  138. IPT2 = IFACE
  139. SEGACT IPT1
  140. SEGACT IPT2
  141. NFAC = IPT1.NUM(/2)
  142. C
  143. SEGACT MLMCOM
  144. C
  145. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  146. C
  147. C**** Densité
  148. C
  149. N1 = 1
  150. N3 = 6
  151. L1 = 15
  152. SEGINI MCHEL2
  153. IROF = MCHEL2
  154. MCHEL2.IMACHE(1) = IFACEL
  155. MCHEL2.TITCHE = ' '
  156. MCHEL2.CONCHE(1) = ' '
  157. C
  158. C**** Valeurs independente du repére, i.e.
  159. C
  160. MCHEL2.INFCHE(1,1) = 0
  161. MCHEL2.INFCHE(1,3) = NIFOUR
  162. MCHEL2.INFCHE(1,4) = 0
  163. MCHEL2.INFCHE(1,5) = 0
  164. MCHEL2.INFCHE(1,6) = 0
  165. MCHEL2.IFOCHE = IFOUR
  166. N2 = MLMCOM.MOTS(/2)
  167. SEGINI MCHAM1
  168. MCHEL2.ICHAML(1) = MCHAM1
  169. SEGDES MCHEL2
  170. N1EL = NFAC
  171. N1PTEL = 3
  172. N2EL = 0
  173. N2PTEL = 0
  174. DO I1=1,N2,1
  175. MCHAM1.NOMCHE(I1) = MLMCOM.MOTS(I1)
  176. MCHAM1.TYPCHE(I1) = 'REAL*8 '
  177. SEGINI MELVA1
  178. MCHAM1.IELVAL(I1) = MELVA1
  179. ENDDO
  180. C
  181. C**** Boucle sur le faces
  182. C
  183. DO NLCF = 1, NFAC
  184. C
  185. C******* NLCF = numero local du centre de face
  186. C NGCF = numero global du centre de face
  187. C NGCEG = numero global du centre ELT "gauche"
  188. C NLCEG = numero local du centre ELT "gauche"
  189. C NGCED = numero global du centre ELT "droite"
  190. C NLCED = numero local du centre ELT "droite"
  191. C
  192. NGCEG = IPT1.NUM(1,NLCF)
  193. NGCF = IPT1.NUM(2,NLCF)
  194. NGCED = IPT1.NUM(3,NLCF)
  195. NLCEG = MLENT1.LECT(NGCEG)
  196. NLCED = MLENT1.LECT(NGCED)
  197. C
  198. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  199. C
  200. NGCF1 = IPT2.NUM(1,NLCF)
  201. IF(NGCF1 .NE. NGCF) THEN
  202. LOGAN = .TRUE.
  203. MESERR(1:40) = 'PRET, subroutine pre411.eso '
  204. GOTO 9999
  205. ENDIF
  206. DO I1 = 1, N2, 1
  207. IF(NGCEG .EQ. NGCED)THEN
  208. ROG = MPROC.VPOCHA(NLCEG , I1)
  209. C
  210. C********** Son etat droite
  211. C
  212. ROD = ROG
  213. ELSE
  214. C
  215. C************* Etat gauche
  216. C
  217. ROG = MPROC.VPOCHA(NLCEG, I1)
  218. C
  219. C********** Etat droit
  220. C
  221. ROD = MPROC.VPOCHA(NLCED, I1)
  222. ENDIF
  223. MELVA1=MCHAM1.IELVAL(I1)
  224. MELVA1.VELCHE(1,NLCF) = ROG
  225. MELVA1.VELCHE(3,NLCF) = ROD
  226. ENDDO
  227. ENDDO
  228. C
  229. C**** Desactivation des SEGMENTs
  230. C
  231. SEGDES IPT1
  232. SEGDES IPT2
  233. DO I1 = 1, N2, 1
  234. MELVA1=MCHAM1.IELVAL(I1)
  235. SEGDES MELVA1
  236. ENDDO
  237. SEGDES MCHAM1
  238. C
  239. SEGDES MPROC
  240. C
  241. SEGSUP MLENT1
  242. SEGDES MLMCOM
  243. C
  244. 9999 CONTINUE
  245. C
  246. RETURN
  247. END
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  

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