Télécharger capa1.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPA1 SOURCE CB215821 17/01/16 21:15:06 9279
  2.  
  3. C=======================================================================
  4. C= C A P A 1 =
  5. C= --------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul de la matrice de CAPACITE CALORIFIQUE (type RIGIDITE) =
  10. C= =
  11. C= Parametres : (E)=Entree (S)=Sortie =
  12. C= ------------ =
  13. C= IPMODE (E) Segment IMODEL pour un modele elementaire (ACTIF) =
  14. C= IPCHEL (E) Segment MCHELM de CARACTERISTIQUES (?) =
  15. C= ISUPC (E) Support du champ de CARACTERISTIQUES =
  16. C= ITABCP (E) TABLE pour le changement de PHASE =
  17. C= IPRIGI (E/S) Segment MRIGID : CAPACITE (ACTIF) =
  18. C= =
  19. C= Creation par Denis ROBERT le 15 fevrier 1988. =
  20. C= Modifications par DEGAY le 10 mai 1994 et ulterieurement. =
  21. C=======================================================================
  22.  
  23. SUBROUTINE CAPA1 (IPMODE,IPCHEL,ISUPC,ITABCP, IPRIGI)
  24.  
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8 (A-H,O-Z)
  27.  
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC CCREEL
  31.  
  32. -INC SMELEME
  33. -INC SMINTE
  34. -INC SMMODEL
  35. POINTEUR NOMID1.NOMID,NOMID2.NOMID
  36. -INC SMRIGID
  37.  
  38. INTEGER OOOVAL
  39.  
  40. SEGMENT NOTYPE
  41. CHARACTER*16 TYPE(NBTYPE)
  42. ENDSEGMENT
  43.  
  44. SEGMENT MPTVAL
  45. INTEGER IPOS(NS),NSOF(NS), IVAL(NCOSOU)
  46. CHARACTER*16 TYVAL(NCOSOU)
  47. ENDSEGMENT
  48.  
  49. CHARACTER*8 CMATE
  50. CHARACTER*16 MOFOR
  51. CHARACTER*(LCONMO) CONM
  52.  
  53. PARAMETER ( NINF=3 )
  54. DIMENSION INFOS(NINF)
  55.  
  56. C= LEFMAS Liste des numeros d'elements finis MASSIFs implementes
  57. C= NEFMAS Longueur de cette liste =
  58. C= LEFCOQ Liste des numeros d'elements finis COQUEs implementes
  59. C= NEFCOQ Longueur de cette liste =
  60. PARAMETER (NEFMAS=14, NEFCOQ=5,neftuy=2)
  61. DIMENSION LEFMAS(NEFMAS), LEFCOQ(NEFCOQ),leftuy(neftuy)
  62.  
  63. C Elements TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 TET4
  64. C MASSIFs TE10 PYR5 PY13 T1D2 T1D3
  65. DATA LEFMAS / 4, 6, 8, 10, 14, 15, 16, 17, 23,
  66. & 24, 25, 26, 191, 192 /
  67. C COQUEs COQ2 COQ3 COQ6 COQ4 COQ8
  68. DATA LEFCOQ / 44, 27, 56, 49, 41 /
  69. C Tuyau(pour advection)
  70. C TUY2 TUY3
  71. DATA leftuy/ 269 , 270/
  72.  
  73. IPINTE = 0
  74. IPINT2 = 0
  75. MOMATE = 0
  76. MOTYPE = 0
  77. IPCPHA = 0
  78. MOCPHA = 0
  79.  
  80. C- Matrice de capacite
  81. MRIGID = IPRIGI
  82. c* SEGACT,MRIGID
  83. NRIGE0 = IRIGEL(/2)
  84.  
  85. C- Recuperation du sous-modele et de la zone elementaire associee
  86. IMODEL = IPMODE
  87. C* SEGACT,IMODEL
  88.  
  89. NEF = NEFMOD
  90. IF (NEF.EQ.22) RETURN
  91.  
  92. IMAS = 0
  93. CALL PLACE2(LEFMAS,NEFMAS,IMAS,NEF)
  94. ICOQ = 0
  95. CALL PLACE2(LEFCOQ,NEFCOQ,ICOQ,NEF)
  96. ituy=0
  97. CALL PLACE2(LEFTUY,NEFTUY,ituy,NEF)
  98. C- Recuperation d'informations sur le maillage elementaire
  99. IPT1 = IMAMOD
  100. SEGACT,IPT1
  101. NBNOE1 = IPT1.NUM(/1)
  102. NBELE1 = IPT1.NUM(/2)
  103.  
  104. C- Quelques informations sur le modele
  105. CONM = CONMOD
  106. CMATE = CMATEE
  107. MATE = IMATEE
  108.  
  109. IRET = 1
  110. CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET)
  111. IF (IRET.EQ.0) GOTO 9990
  112.  
  113. C- Recuperation d'informations sur l'element fini
  114. CALL TSHAPE(NEF,'GAUSS',IPINTE)
  115. IF (IERR.NE.0) GOTO 9990
  116. MINTE = IPINTE
  117. SEGACT,MINTE
  118. IF (ICOQ.NE.0) THEN
  119. IF (NEF.EQ.56 .OR. NEF.EQ.41 .OR. NEF.EQ.49) THEN
  120. CALL TSHAPE(NEF,'NOEUD',IPINT2)
  121. MINTE2 = IPINT2
  122. SEGACT,MINTE2
  123. ENDIF
  124. ENDIF
  125.  
  126. C- Recuperation des caracteristiques materielles (obligatoires)
  127. nbrfac = 0
  128. nbrobl = 0
  129. MOFOR = FORMOD(1)
  130. IF (MOFOR .EQ. 'THERMIQUE') THEN
  131. INFOR = 1
  132. IF (NEF.EQ.46 .OR. ICOQ.NE.0 .or. ituy.ne.0) THEN
  133. nbrobl = 3
  134. ELSE
  135. nbrobl = 2
  136. ENDIF
  137. SEGINI,nomid
  138. lesobl(1) = 'RHO '
  139. lesobl(2) = 'C '
  140.  
  141. ELSEIF(MOFOR .EQ. 'DIFFUSION') THEN
  142. INFOR = 2
  143. IF (NEF.EQ.46 .OR. ICOQ.NE.0 .or. ituy.ne.0) THEN
  144. nbrobl = 2
  145. ELSE
  146. nbrobl = 1
  147. ENDIF
  148. SEGINI,nomid
  149. lesobl(1) = 'CDIF'
  150. ELSE
  151. CALL ERREUR(21)
  152. RETURN
  153. ENDIF
  154.  
  155. IF (NEF.EQ.46.or.ituy.ne.0) THEN
  156. lesobl(nbrobl) = 'SECT'
  157. ELSE IF (ICOQ.NE.0) THEN
  158. lesobl(nbrobl) = 'EPAI'
  159. ENDIF
  160.  
  161. NMATT = nbrobl + nbrfac
  162. MOMATE = nomid
  163. c
  164. nbtype = 1
  165. SEGINI,notype
  166. type(1) = 'REAL*8'
  167. MOTYPE = notype
  168.  
  169. C- Recuperation de donnees dans le cas d'un CHANGEMENT DE PHASE
  170. C Dans le cas d'un changement de phase, on calcule une capacite
  171. C calorifique equivalente liee a la chaleur latente (MCHAML IPCPHA).
  172. C Le support de ce champ est celui des points de GAUSS (IPINTE).
  173. IF (ITABCP.NE.0) THEN
  174. CALL CAPA7(ITABCP,IPT1,ICOQ,IPINTE, IPCPHA)
  175. IF (IERR.NE.0) GOTO 9990
  176. nbrobl = 1
  177. nbrfac = 0
  178. SEGINI,nomid
  179. lesobl(1) = 'C '
  180. MOCPHA = nomid
  181. NPHAT = nbrobl + nbrfac
  182. ENDIF
  183.  
  184. C- Definition du descripteur IDESCR pour le modele elementaire
  185. IDESCR = 0
  186. NOMPRI = LNOMID(1)
  187. NOMDUA = LNOMID(2)
  188. CALL TCOND2(ICOQ,NBNOE1,IDESCR,NOMPRI,NOMDUA)
  189. DESCR = IDESCR
  190. SEGACT,DESCR
  191. NLIGRD = LISDUA(/2)
  192. NLIGRP = LISINC(/2)
  193. SEGDES,DESCR
  194. LRE = NLIGRD
  195.  
  196. C- Partionnement si necessaire de la matrice de capacite
  197. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  198. LTRK = oooval(1,4)
  199. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  200. * Ajout a la taille en mots de la matrice des infos du segment
  201. LSEG = LRE*LRE*NBELE1 + 16
  202. NBLPRT = (LSEG-1)/LTRK + 1
  203. NBLMAX = (NBELE1-1)/NBLPRT + 1
  204. NBLPRT = (NBELE1-1)/NBLMAX + 1
  205. * write(ioimp,*) ' capa1 : nblprt nblmax = ',nblprt,nblmax,nbele1
  206.  
  207. C Ajout de la matrice de CAPACITE a la matrice globale
  208. C ====================================================
  209. NRIGEL = NRIGE0 + NBLPRT
  210. SEGADJ,MRIGID
  211.  
  212. descr = IDESCR
  213. meleme = IPT1
  214. nbnn = NBNOE1
  215. nbelem = NBELE1
  216. nbsous = 0
  217. nbref = 0
  218.  
  219. C Boucle sur les PARTITIONS elementaires de la matrice
  220. C ====================================================
  221. DO irige = 1, NBLPRT
  222.  
  223. IVAMAT = 0
  224. IVAPHA = 0
  225.  
  226. IF (NBLPRT.GT.1) THEN
  227. C- Partitionnement du maillage support de la matrice elementaire
  228. SEGACT,IPT1
  229. ielem = (irige-1)*NBLMAX
  230. nbelem = MIN(NBLMAX,NBELE1-ielem)
  231. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  232. SEGINI,meleme
  233. itypel = IPT1.itypel
  234. DO ielt = 1, nbelem
  235. jelt = ielt + ielem
  236. DO inoe = 1, nbnn
  237. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  238. ENDDO
  239. icolor(ielt) = IPT1.ICOLOR(jelt)
  240. ENDDO
  241. C- Recopie du descripteur
  242. des1 = IDESCR
  243. SEGINI,descr=des1
  244. SEGDES,descr
  245. ENDIF
  246. ipmail = meleme
  247. ipdesc = descr
  248.  
  249. C- Initialisation de la matrice de rigidite elementaire (xmatri)
  250. NELRIG = nbelem
  251. SEGINI,xmatri
  252. ipmatr = xmatri
  253.  
  254. C- Recuperation des valeurs de caracteristiques sur la partition
  255. CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT)
  256. IF (IERR.NE.0) GOTO 9991
  257. IF (ISUPC.EQ.1) THEN
  258. CALL VALCHE(IVAMAT,NMATT,IPINTE,0,MOMATE,NEF)
  259. IF (IERR.NE.0) THEN
  260. ISUPC = 0
  261. GOTO 9991
  262. ENDIF
  263. ENDIF
  264.  
  265. C- Idem pour capacite equivalente en cas de changement de phase
  266. IF (ITABCP.NE.0) THEN
  267. CALL KOMCHA(IPCPHA,ipmail,CONM,MOCPHA,MOTYPE,1,INFOS,3,IVAPHA)
  268. IF (IERR.NE.0) GOTO 9991
  269. ENDIF
  270.  
  271. C- Calcul de la matrice elementaire pour la paritition elementaire et
  272. C Remplissage de la matrice globale (IPRIGI)
  273. C---> Elements MASSIFs a integration NUMERIQUE
  274. IF (IMAS.NE.0) THEN
  275. CALL CAPANU(NEF,ipmail,IPINTE,IVAMAT,NMATT,IVAPHA,NPHAT,
  276. & ipmatr,LRE,INFOR)
  277. C---> Elements de COQUEs
  278. ELSE IF (ICOQ.NE.0) THEN
  279. C-----> Element COQ2 (axisymetrique)
  280. IF (NEF.EQ.44) THEN
  281. CALL CAPAC1(NEF,ipmail,IPINTE,IVAMAT,NMATT,IVAPHA,NPHAT,
  282. & ipmatr,LRE,INFOR)
  283. C-----> Element COQ3
  284. ELSE IF (NEF.EQ.27) THEN
  285. CALL CAPAC3(NEF,ipmail,IPINTE,IVAMAT,NMATT,IVAPHA,NPHAT,
  286. & ipmatr,LRE,INFOR)
  287. C-----> Elements COQ4, COQ6 et COQ8
  288. C* ELSE IF (NEF.EQ.56 .OR. NEF.EQ.41 .OR. NEF.EQ.49) THEN
  289. ELSE
  290. CALL CAPAC2(NEF,ipmail,IPINTE,IPINT2,IVAMAT,NMATT,
  291. & IVAPHA,NPHAT, ipmatr,LRE,INFOR)
  292. ENDIF
  293. C---> Element BARRE (integration NUMERIQUE)
  294. ELSE IF (NEF.EQ.46.or.nef.eq.269.or.nef.eq.270) THEN
  295. CALL CAPABA(NEF,ipmail,IPINTE,IVAMAT,NMATT,IVAPHA,NPHAT,
  296. & ipmatr,LRE,INFOR)
  297. C---> Elements seg3, RAC2 et RAC3 : non implementes
  298. ELSE IF (NEF.EQ.3 .OR. NEF.EQ.12 .OR. NEF.EQ.13) THEN
  299. CALL ERREUR(251)
  300. C---> Option indisponible : ERREUR
  301. ELSE
  302. CALL ERREUR(19)
  303. ENDIF
  304.  
  305. C- Un peu de menage dans les segments
  306. 9991 CONTINUE
  307. IF (ISUPC.EQ.1 .OR. NBLPRT.NE.1) THEN
  308. CALL DTMVAL(IVAMAT,3)
  309. ELSE
  310. CALL DTMVAL(IVAMAT,1)
  311. ENDIF
  312. IF (ITABCP.NE.0) THEN
  313. IF (NBLPRT.NE.1) THEN
  314. CALL DTMVAL(IVAPHA,3)
  315. ELSE
  316. CALL DTMVAL(IVAPHA,1)
  317. ENDIF
  318. ENDIF
  319. C- Sortie prematuree en cas d'erreur
  320. IF (IERR.NE.0) GOTO 9990
  321.  
  322. xmatri = ipmatr
  323. SEGDES,xmatri
  324. IF (NBLPRT.NE.1) THEN
  325. meleme = ipmail
  326. SEGDES,meleme
  327. ENDIF
  328.  
  329. C- Stockage de la matrice de CAPACITE du modele
  330. jrige = NRIGE0 + irige
  331. COERIG(jrige) = 1.
  332. IRIGEL(1,jrige) = ipmail
  333. IRIGEL(2,jrige) = 0
  334. IRIGEL(3,jrige) = ipdesc
  335. IRIGEL(4,jrige) = ipmatr
  336. IRIGEL(5,jrige) = NIFOUR
  337. IRIGEL(6,jrige) = 0
  338. IRIGEL(7,jrige) = 0
  339. IRIGEL(8,jrige) = 0
  340.  
  341. ENDDO
  342.  
  343. IPRIGI = MRIGID
  344.  
  345. C MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  346. C ==============================================
  347. 9990 CONTINUE
  348. SEGDES,IPT1
  349. IF (IPINTE.NE.0) THEN
  350. MINTE = IPINTE
  351. SEGDES,MINTE
  352. ENDIF
  353. IF (IPINT2.NE.0) THEN
  354. MINTE = IPINT2
  355. SEGDES,MINTE
  356. ENDIF
  357. IF (MOMATE.NE.0) THEN
  358. nomid = MOMATE
  359. SEGSUP,nomid
  360. ENDIF
  361. IF (MOTYPE.NE.0) THEN
  362. notype = MOTYPE
  363. SEGSUP,notype
  364. ENDIF
  365. IF (MOCPHA.NE.0) THEN
  366. nomid = MOCPHA
  367. SEGSUP,nomid
  368. ENDIF
  369. IF (IPCPHA.NE.0) THEN
  370. CALL DTCHAM(IPCPHA)
  371. ENDIF
  372.  
  373. RETURN
  374. END
  375.  
  376.  
  377.  

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