Télécharger chame2.eso

Retour à la liste

Numérotation des lignes :

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

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