Télécharger chame2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAME2 SOURCE CB215821 19/08/20 21:15:38 10287
  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. MCHPOI=IPCHPO
  78. NSOUPO=IPCHP(/1)
  79. *
  80. N2=10
  81. n2r=0
  82.  
  83. call oooprl(1)
  84. SEGACT,MCOORD
  85. NX=XCOOR(/1)/(IDIM+1)
  86. SEGINI,MTRI,ICNTCH,MCHAML
  87. call oooprl(0)
  88. *
  89. IPT1=IPOGEO
  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. NBELEM=NUM(/2)
  99.  
  100. DO 60 IPOI=1,NBELEM
  101. IPONU=NUM(1,IPOI)
  102. NOEUDS(IPONU)=1
  103. 60 CONTINUE
  104. 50 continue
  105. *
  106. * boucle 2 sur les zones du chpoint
  107. *
  108. DO 100 ISOUPO=1,NSOUPO
  109. MSOUPO=IPCHP(ISOUPO)
  110. MPOVAL=IPOVAL
  111. MELEME=IGEOC
  112. NBELEM=NUM(/2)
  113. DO 107 IO=1,NX
  114. NPAKET(IO)=0
  115. NPOSIT(IO)=0
  116. 107 CONTINUE
  117. *
  118. * boucle sur les poi1 contenus dans le msoupo considere
  119. *
  120. DO 110 IPOI=1,NBELEM
  121. IPONU=NUM(1,IPOI)
  122. NPAKET(IPONU)=ISOUPO
  123. NPOSIT(IPONU)=IPOI
  124. 110 CONTINUE
  125. * end do
  126.  
  127. NCOMP=NOCOMP(/2)
  128. IMO=0
  129. *
  130. * boucle sur les composantes du msoupo considere
  131. *
  132. DO 120 ICOMP=1,NCOMP
  133. IF (N2R.GT.0) THEN
  134. CALL PLACE(NOMCHE,N2R,IMO,NOCOMP(ICOMP))
  135. IF (IMO.EQ.0) THEN
  136. n2r=n2r+1
  137. IF (N2R.GT.N2) then
  138. N2=n2+100
  139. SEGADJ,MCHAML
  140. endif
  141. NOMCHE(N2r)=NOCOMP(ICOMP)
  142. TYPCHE(N2r)='REAL*8'
  143. * else
  144. *+* if (noharm(icomp).ne.nuhche(imo)) then
  145. *
  146. * c'est un nouvel harmonique
  147. *
  148. * n2=nomche(/2)+1
  149. * segadj,mchaml
  150. * nomche(n2)=nocomp(icomp)
  151. * typche(n2)='real*8'
  152. * endif
  153. ENDIF
  154. ELSE
  155. N2R=N2R+1
  156. IF (N2R.GT.N2) then
  157. N2=n2+100
  158. SEGADJ,MCHAML
  159. endif
  160. NOMCHE(N2R)=NOCOMP(ICOMP)
  161. TYPCHE(N2R)='REAL*8'
  162. ENDIF
  163. *
  164. IF (IMO.EQ.0) THEN
  165. N1PTEL=NBN1
  166. N1EL=NBELE1
  167. N2PTEL=0
  168. N2EL=0
  169. SEGINI,MELVAL
  170. IELVAL(N2R)=MELVAL
  171. ELSE
  172. MELVAL=IELVAL(IMO)
  173. ENDIF
  174. *
  175. DO 220 IEL=1,NBELE1
  176. DO 210 INOE=1,NBN1
  177. IPONU=IPT1.NUM(INOE,IEL)
  178. ISOUP=NPAKET(IPONU)
  179. IF (ISOUP.NE.0) THEN
  180. * le point considere est reference dans ce maillage
  181. NPOPO=NPOSIT(IPONU)
  182. IF (NPOPO.NE.0) THEN
  183. VELCHE(INOE,IEL)=VPOCHA(NPOPO,ICOMP)
  184. ENDIF
  185. * else
  186. * if(noeuds(IPONU).eq.0) then
  187. * interr(1)=IPONU
  188. * call erreur(771)
  189. * endif
  190. ENDIF
  191. 210 CONTINUE
  192. * end do
  193. 220 CONTINUE
  194. * end do
  195. 120 CONTINUE
  196. * end do
  197. 100 CONTINUE
  198. * end do
  199. *
  200. N2=n2R
  201. SEGADJ,MCHAML
  202. *
  203. * changement de support si besoin est
  204. * Le segment IPMINT est suppose ACTIF (E/S)
  205. *
  206. IF (IPMINT.NE.0) THEN
  207. DO 400 ICOMP=1,N2
  208. IPMELV=IELVAL(ICOMP)
  209. LENAME=NOMCHE(ICOMP)
  210. CALL CHAME3(IPMELV,IPMINT,IPRES,IPORE,LENAME,MELE)
  211. IELVAL(ICOMP)=IPRES
  212. *
  213. * MELVAL=IPRES
  214. *
  215. MELVAL=IPMELV
  216. SEGSUP,MELVAL
  217. 400 CONTINUE
  218. ENDIF
  219. *
  220. IPCHAM=MCHAML
  221. SEGSUP,MTRI,ICNTCH
  222.  
  223. END
  224.  
  225.  
  226.  
  227.  

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