Télécharger chame2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAME2 SOURCE AM 16/04/18 21:15:04 8911
  2. SUBROUTINE CHAME2(IPOGEO,IPCHPO,IPCHEL,IPCHAM,IPMINT,IPORE,MELE)
  3. ************************************************************************
  4. *
  5. * c h a m e 2
  6. * -----------
  7. *
  8. * fonction:
  9. * ---------
  10. * transformation d'un champ par point en champ par element
  11. * transfert des composantes du chpoint vers le chamelem,
  12. * relativement a un maillage elementaire du modele
  13. *
  14. * modules utilises:
  15. * -----------------
  16. *
  17. IMPLICIT INTEGER(I-N)
  18. -INC CCOPTIO
  19. -INC SMELEME
  20. -INC SMCHAML
  21. -INC SMCHPOI
  22. -INC SMCOORD
  23. *
  24. * parametres: (e)=entree (s)=sortie (+ = contenu dans un commun)
  25. * -----------
  26. *
  27. * ipogeo (e) pointeur sur un maillage elementaire
  28. * ipchpo (e) pointeur sur le champ par point (suppose actif)(retour actif)
  29. * +idim (e) voir ccoptio
  30. * ipchel (e) pointeur sur le champ par element (suppose actif)
  31. * ipcham (s) pointeur sur un segment "mchaml"
  32. * = 0 si echec
  33. * ipmint (e) = 0 si la mchaml doit etre laisse aux noeuds
  34. * = sinon pointeur sur un segment s'integration
  35. * correspondant au support desire
  36. * ipore (e) = 0 sauf pour milieu poreux (nbre de noeuds)
  37. *
  38. *
  39. * variables:
  40. * ----------
  41. *
  42. * mtri = segment de travail
  43. * npaket = donne en regard du numero d'un noeud,le numero de la
  44. * zone du chpoint a laquelle il appartient
  45. * nposit = donne en regard du numero d'un noeud,le numero du poi1
  46. * dans la zone referencee ci-dessus
  47. *
  48. SEGMENT,MTRI
  49. INTEGER NPAKET(NX),NPOSIT(NX)
  50. ENDSEGMENT
  51. *
  52. * icntch = segment de travail (CoNTenu du CHpoint)
  53. * noeuds(i)=1 si le noeud i appartient au support du champ, sinon 0
  54. *
  55. SEGMENT,ICNTCH
  56. INTEGER NOEUDS(NX)
  57. ENDSEGMENT
  58. *
  59. CHARACTER*8 LENAME
  60. *
  61. * auteur, date de creation:
  62. * -------------------------
  63. *
  64. * denis robert,le 22 juin 1988.
  65. *
  66. * langage:
  67. * --------
  68. *
  69. * esope + fortran77
  70. *
  71. * Remarque : Le pointeur IPMINT doit etre ACTIF en ENTREE de CHAME2
  72. * ---------- et son etat ne doit pas etre modifie (meme en SORTIE).
  73. *
  74. ************************************************************************
  75. IPCHAM=0
  76. *
  77. C* MCHELM=IPCHEL
  78. MCHPOI=IPCHPO
  79. NSOUPO=IPCHP(/1)
  80. NX=XCOOR(/1)/(IDIM+1)
  81. SEGINI,MTRI
  82. segini,ICNTCH
  83. *
  84. N2=10
  85. n2r=0
  86. SEGINI,MCHAML
  87. *
  88. IPT1=IPOGEO
  89. SEGACT,IPT1
  90. NBN1=IPT1.NUM(/1)
  91. NBELE1=IPT1.NUM(/2)
  92. *
  93. * boucle 1 sur les zones du chpoint
  94. *
  95. do 50 ISOUPO=1,NSOUPO
  96. MSOUPO=IPCHP(ISOUPO)
  97. MELEME=IGEOC
  98. SEGACT,MELEME
  99. NBELEM=NUM(/2)
  100.  
  101. DO 60 IPOI=1,NBELEM
  102. IPONU=NUM(1,IPOI)
  103. NOEUDS(IPONU)=1
  104. 60 CONTINUE
  105. 50 continue
  106. *
  107. * boucle 2 sur les zones du chpoint
  108. *
  109. DO 100 ISOUPO=1,NSOUPO
  110. MSOUPO=IPCHP(ISOUPO)
  111. * segact,msoupo
  112. MPOVAL=IPOVAL
  113. SEGACT,MPOVAL
  114. MELEME=IGEOC
  115. * SEGACT,MELEME
  116. NBELEM=NUM(/2)
  117. DO 107 IO=1,NX
  118. NPAKET(IO)=0
  119. NPOSIT(IO)=0
  120. 107 CONTINUE
  121. *
  122. * boucle sur les poi1 contenus dans le msoupo considere
  123. *
  124. DO 110 IPOI=1,NBELEM
  125. IPONU=NUM(1,IPOI)
  126. NPAKET(IPONU)=ISOUPO
  127. NPOSIT(IPONU)=IPOI
  128. 110 CONTINUE
  129. * end do
  130.  
  131. NCOMP=NOCOMP(/2)
  132. IMO=0
  133. *
  134. * boucle sur les composantes du msoupo considere
  135. *
  136. DO 120 ICOMP=1,NCOMP
  137. IF (N2R.GT.0) THEN
  138. CALL PLACE(NOMCHE,N2R,IMO,NOCOMP(ICOMP))
  139. IF (IMO.EQ.0) THEN
  140. n2r=n2r+1
  141. IF (N2R.GT.N2) then
  142. N2=n2+100
  143. SEGADJ,MCHAML
  144. endif
  145. NOMCHE(N2r)=NOCOMP(ICOMP)
  146. TYPCHE(N2r)='REAL*8'
  147. * else
  148. *+* if (noharm(icomp).ne.nuhche(imo)) then
  149. *
  150. * c'est un nouvel harmonique
  151. *
  152. * n2=nomche(/2)+1
  153. * segadj,mchaml
  154. * nomche(n2)=nocomp(icomp)
  155. * typche(n2)='real*8'
  156. * endif
  157. ENDIF
  158. ELSE
  159. N2R=N2R+1
  160. IF (N2R.GT.N2) then
  161. N2=n2+100
  162. SEGADJ,MCHAML
  163. endif
  164. NOMCHE(N2R)=NOCOMP(ICOMP)
  165. TYPCHE(N2R)='REAL*8'
  166. ENDIF
  167. *
  168. IF (IMO.EQ.0) THEN
  169. N1PTEL=NBN1
  170. N1EL=NBELE1
  171. N2PTEL=0
  172. N2EL=0
  173. SEGINI,MELVAL
  174. IELVAL(N2R)=MELVAL
  175. ELSE
  176. MELVAL=IELVAL(IMO)
  177. SEGACT,MELVAL*MOD
  178. ENDIF
  179. *
  180. DO 210 INOE=1,NBN1
  181. DO 220 IEL=1,NBELE1
  182. IPONU=IPT1.NUM(INOE,IEL)
  183. ISOUP=NPAKET(IPONU)
  184. IF (ISOUP.NE.0) THEN
  185. *
  186. * le point considere est reference dans ce maillage
  187. *
  188. NPOPO=NPOSIT(IPONU)
  189. IF (NPOPO.NE.0) THEN
  190. VELCHE(INOE,IEL)=VPOCHA(NPOPO,ICOMP)
  191. ENDIF
  192. * else
  193. * if(noeuds(IPONU).eq.0) then
  194. * interr(1)=IPONU
  195. * call erreur(771)
  196. * endif
  197. ENDIF
  198. 220 CONTINUE
  199. * end do
  200. 210 CONTINUE
  201. * end do
  202. 120 CONTINUE
  203. * end do
  204. SEGDES,MELEME,MPOVAL
  205. 100 CONTINUE
  206. * end do
  207. *
  208. N2=n2R
  209. SEGADJ,MCHAML
  210. *
  211. * changement de support si besoin est
  212. * Le segment IPMINT est suppose ACTIF (E/S)
  213. *
  214. IF (IPMINT.NE.0) THEN
  215. DO 400 ICOMP=1,N2
  216. IPMELV=IELVAL(ICOMP)
  217. LENAME=NOMCHE(ICOMP)
  218. CALL CHAME3(IPMELV,IPMINT,IPRES,IPORE,LENAME,MELE)
  219. IELVAL(ICOMP)=IPRES
  220. *
  221. MELVAL=IPRES
  222. SEGDES MELVAL
  223. *
  224. MELVAL=IPMELV
  225. SEGSUP MELVAL
  226. 400 CONTINUE
  227. ELSE
  228. DO 401 ICOMP=1,N2
  229. MELVAL=IELVAL(ICOMP)
  230. SEGDES MELVAL
  231. 401 CONTINUE
  232. ENDIF
  233. *
  234. IPCHAM=MCHAML
  235. SEGDES,MCHAML
  236. SEGSUP,MTRI
  237. segsup,ICNTCH
  238. *
  239. RETURN
  240. END
  241.  
  242.  
  243.  
  244.  
  245.  

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