Télécharger thcapa1.eso

Retour à la liste

Numérotation des lignes :

  1. C THCAPA1 SOURCE PV 17/09/29 21:16:07 9578
  2.  
  3. C=======================================================================
  4. C= T H C A P A 1 =
  5. C= ------------- =
  6. C= (CAPA1 dans le cas de la thermique) =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul de la matrice de CAPACITE en couplage THERMOHYDRIQUE =
  10. C= (type RIGIDITE) =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. C= IPMODE (E) Segment IMODEL pour un modele elementaire (ACTIF) =
  15. C= IPCHEL (E) Segment MCHELM de CARACTERISTIQUES (?) =
  16. C= ISUPCA (E) Support du champ de CARACTERISTIQUES =
  17. C= IPRIGI (E/S) Segment MRIGID : CAPACITE (ACTIF) =
  18. C= =
  19. C= Zakaria HABIBI le 30 juin 2008. =
  20. C=======================================================================
  21.  
  22. SUBROUTINE THCAPA1 (IPMODE,IPCHEL,ISUPCA, IPRIGI)
  23.  
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30.  
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMMODEL
  34. -INC SMRIGID
  35.  
  36. INTEGER OOOVAL
  37.  
  38. SEGMENT NOTYPE
  39. CHARACTER*16 TYPE(NBTYPE)
  40. ENDSEGMENT
  41.  
  42. SEGMENT MPTVAL
  43. INTEGER IPOS(NS),NSOF(NS), IVAL(NCOSOU)
  44. CHARACTER*16 TYVAL(NCOSOU)
  45. ENDSEGMENT
  46.  
  47. CHARACTER*8 CMATE
  48. CHARACTER*(LCONMO) CONM
  49.  
  50. PARAMETER ( NINF=3 )
  51. DIMENSION INFOS(NINF)
  52.  
  53. C= LEFMAS Liste des numeros d'elements finis MASSIFs supportant la =
  54. C la formulation thermohydrique =
  55. C= NEFMAS Longueur de cette liste =
  56. PARAMETER ( NEFMAS = 14 )
  57. DIMENSION LEFMAS(NEFMAS)
  58.  
  59. C ==========
  60. C Elements TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 TET4 TE10
  61. C MASSIFs PYR5 PY13 T1D2 T1D3
  62. C ==========
  63. DATA LEFMAS / 4, 6, 8, 10, 14, 15, 16, 17, 23, 24,
  64. & 25, 26, 191, 192 /
  65.  
  66. IPINTE = 0
  67. IPINT1 = 0
  68. MOMATE = 0
  69. MOTYPE = 0
  70.  
  71. C- Matrice de capacite
  72. MRIGID = IPRIGI
  73. c* SEGACT,MRIGID
  74. NRIGE0 = IRIGEL(/2)
  75.  
  76. C- Recuperation du sous-modele et de la zone elementaire associee
  77. IMODEL = IPMODE
  78. c* SEGACT,IMODEL
  79.  
  80. NEF = NEFMOD
  81. C Test sur l'element fini
  82. IMAS = 0
  83. CALL PLACE2(LEFMAS,NEFMAS,IMAS,NEF)
  84. C ERREUR : Element fini non implemente actuellement
  85. IF (NEF.EQ.22 .OR. IMAS.EQ.0) THEN
  86. CALL ERREUR(19)
  87. GOTO 9991
  88. ENDIF
  89. C
  90. C- Recuperation d'informations sur le maillage elementaire
  91. IPT1 = IMAMOD
  92. SEGACT,IPT1
  93. NBNOE1 = IPT1.NUM(/1)
  94. NBELE1 = IPT1.NUM(/2)
  95. *
  96. C- Quelques informations sur le modele
  97. CONM = CONMOD
  98. CMATE = CMATEE
  99. MATE = IMATEE
  100.  
  101. IRET = 1
  102. CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET)
  103. IF (IRET.EQ.0) GOTO 9990
  104.  
  105. C- Recuperation d'informations sur l'element fini
  106. CALL TSHAPE(NEF,'GAUSS',IPINTE)
  107. IF (IERR.NE.0) GOTO 9990
  108. MINTE = IPINTE
  109. SEGACT,MINTE
  110.  
  111. IF (MATE.EQ.2 .OR. MATE.EQ.3) THEN
  112. NLG = NUMGEO(NEF)
  113. CALL RESHPT(1,NBNOE1,NLG,NEF,0,IPINT1,IOK)
  114. IF (IOK.EQ.0) GOTO 9990
  115. MINTE1 = IPINT1
  116. SEGACT,MINTE1
  117. ENDIF
  118.  
  119. C- Recuperation des caracteristiques materielles
  120. nomid = LNOMID(6)
  121. SEGACT,nomid
  122. NMATO = lesobl(/2)
  123. NMATF = lesfac(/2)
  124. NMATT = NMATO + NMATF
  125. MOMATE = nomid
  126.  
  127. nbtype = 1
  128. SEGINI,notype
  129. TYPE(1) = 'REAL*8'
  130. MOTYPE = notype
  131.  
  132. C- Definition du descripteur IDESCR
  133. IDESCR = 0
  134. CALL THCOND2(NBNOE1,IDESCR)
  135. descr = IDESCR
  136. SEGACT,descr
  137. NLIGRD = lisdua(/2)
  138. NLIGRP = lisinc(/2)
  139. SEGDES,descr
  140. LRE = NLIGRD
  141.  
  142. C- Partionnement si necessaire de la matrice thermohydrique
  143. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  144. LTRK = oooval(1,4)
  145. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  146. * Ajout a la taille en mots de la matrice des infos du segment
  147. LSEG = LRE*LRE*NBELE1 + 16
  148. NBLPRT = (LSEG-1)/LTRK + 1
  149. NBLMAX = (NBELE1-1)/NBLPRT + 1
  150. NBLPRT = (NBELE1-1)/NBLMAX + 1
  151. * write(ioimp,*) ' thcond1 : nblprt nblmax = ',nblprt,nblmax,nbele1
  152.  
  153. C Ajout de la matrice de CAPACITE THERMOHYDRIQUE a la matrice globale
  154. C ===================================================================
  155. NRIGEL = NRIGE0 + NBLPRT
  156. SEGADJ,MRIGID
  157.  
  158. descr = IDESCR
  159. meleme = IPT1
  160. nbnn = NBNOE1
  161. nbelem = NBELE1
  162. nbsous = 0
  163. nbref = 0
  164.  
  165. C Boucle sur les PARTITIONS elementaires de la matrice
  166. C=======================================================
  167. DO irige = 1, NBLPRT
  168.  
  169. IF (NBLPRT.GT.1) THEN
  170. C Partitionnement du maillage support de la matrice elementaire
  171. SEGACT,IPT1
  172. ielem = (irige-1)*NBLMAX
  173. nbelem = MIN(NBLMAX,NBELE1-ielem)
  174. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  175. SEGINI,meleme
  176. itypel = IPT1.itypel
  177. DO ielt = 1, nbelem
  178. jelt = ielt + ielem
  179. DO inoe = 1, nbnn
  180. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  181. ENDDO
  182. icolor(ielt) = IPT1.ICOLOR(jelt)
  183. ENDDO
  184. C Recopie du descripteur
  185. des1 = IDESCR
  186. SEGINI,descr=des1
  187. SEGDES,descr
  188. ENDIF
  189. ipmail = meleme
  190. ipdesc = descr
  191.  
  192. C Initialisation de la matrice de rigidite elementaire (xmatri)
  193. NELRIG = nbelem
  194. SEGINI,xmatri
  195. ipmatr = xmatri
  196.  
  197. IVAMAT = 0
  198. CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT)
  199. IF (IERR.NE.0) GOTO 9995
  200. IF (ISUPCA.EQ.1) THEN
  201. CALL VALCHE(IVAMAT,NMATT,IPINTE,0,MOMATE,NEF)
  202. IF (IERR.NE.0) THEN
  203. ISUPCA = 0
  204. GOTO 9995
  205. ENDIF
  206. ENDIF
  207.  
  208. C- Elements MASSIFs a integration NUMERIQUE
  209. IF (IMAS.NE.0) THEN
  210. CALL THNUMAC2(NEF,ipmail,IPINTE,IPINT1,IVAMAT,NMATT,
  211. & ipmatr,LRE)
  212. C- Element fini non implemente
  213. ELSE
  214. CALL ERREUR(19)
  215. ENDIF
  216.  
  217. C- Un peu de menage
  218. 9995 CONTINUE
  219. IF (ISUPCA.EQ.1 .OR. NBLPRT.GT.1) THEN
  220. CALL DTMVAL(IVAMAT,3)
  221. ELSE
  222. CALL DTMVAL(IVAMAT,1)
  223. ENDIF
  224. IF (IERR.NE.0) GOTO 9990
  225.  
  226. xmatri = ipmatr
  227. IF (NBLPRT.GT.1) THEN
  228. meleme = ipmail
  229. SEGDES,meleme
  230. ENDIF
  231.  
  232. C- Remplissage de la matrice de CAPACITE
  233. jrige = NRIGE0 + irige
  234. COERIG(jrige) = 1.
  235. IRIGEL(1,jrige) = ipmail
  236. IRIGEL(2,jrige) = 0
  237. IRIGEL(3,jrige) = ipdesc
  238. IRIGEL(4,jrige) = ipmatr
  239. IRIGEL(5,jrige) = NIFOUR
  240. IRIGEL(6,jrige) = 0
  241. IRIGEL(7,jrige) = 2
  242. IRIGEL(8,jrige) = 0
  243. xmatri.symre=2
  244. SEGDES,xmatri
  245.  
  246. ENDDO
  247.  
  248. IPRIGI = MRIGID
  249.  
  250. C FIN DU TRAITEMENT : DESACTIVATION/DESTRUCTION DE SEGMENTS
  251. C =========================================================
  252. 9990 CONTINUE
  253. SEGDES,IPT1
  254. IF (IPINTE.GT.0) THEN
  255. MINTE = IPINTE
  256. SEGDES,MINTE
  257. ENDIF
  258. IF (IPINT1.GT.0) THEN
  259. MINTE = IPINT1
  260. SEGDES,MINTE
  261. ENDIF
  262. IF (MOMATE.NE.0) THEN
  263. nomid = MOMATE
  264. SEGDES,nomid
  265. ENDIF
  266. IF (MOTYPE.NE.0) THEN
  267. notype = MOTYPE
  268. SEGSUP,notype
  269. ENDIF
  270. 9991 CONTINUE
  271. c* SEGDES,IMODEL
  272. c* SEGDES,MRIGID
  273.  
  274. RETURN
  275. END
  276.  
  277.  
  278.  
  279.  
  280.  

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