Télécharger capaed.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPAED SOURCE GG250959 17/09/20 21:15:08 9554
  2.  
  3. C=======================================================================
  4. C= OPERATEUR CAPACITE - MODELE 'DIFFUSION' OU 'ELECTROSTATIQUE' =
  5. C=======================================================================
  6. C= C A P A E D =
  7. C= ----------- =
  8. C= =
  9. C= Fonction : =
  10. C= ---------- =
  11. C= Calcul de la matrice de "CAPACITE" (type RIGIDITE) =
  12. C= =
  13. C= Parametres : (E)=Entree (S)=Sortie =
  14. C= ------------ =
  15. C= IPMODE (E) Segment IMODEL pour un modele elementaire (ACTIF) =
  16. C= IPCHEL (E) Segment MCHELM de CARACTERISTIQUES (?) =
  17. C= ISUPC (E) Support du champ de CARACTERISTIQUES =
  18. C= IPRIGI (E/S) Segment MRIGID : "CAPACITE" (ACTIF) =
  19. C=======================================================================
  20.  
  21. SUBROUTINE CAPAED (IPMODE,IPCHEL,ISUPC, IPRIGI)
  22.  
  23.  
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC CCGEOME
  30. -INC CCREEL
  31.  
  32. -INC SMCHAML
  33. -INC SMCOORD
  34. -INC SMELEME
  35. -INC SMINTE
  36. -INC SMMODEL
  37. -INC SMRIGID
  38.  
  39. INTEGER OOOVAL
  40.  
  41. SEGMENT NOTYPE
  42. CHARACTER*16 TYPE(NBTYPE)
  43. ENDSEGMENT
  44.  
  45. SEGMENT MPTVAL
  46. INTEGER IPOS(NS) ,NSOF(NS)
  47. INTEGER IVAL(NCOSOU)
  48. CHARACTER*16 TYVAL(NCOSOU)
  49. ENDSEGMENT
  50.  
  51. SEGMENT INFO
  52. INTEGER INFELL(JG)
  53. ENDSEGMENT
  54.  
  55. CHARACTER*8 CMATE
  56. CHARACTER*(LCONMO) CONM
  57.  
  58. C= INTTYP definit le support des points d'integration pour CAPAED
  59. C= Cette valeur doit etre coherente avec celle utilisee dans CAPA.
  60. PARAMETER ( INTTYP = 4 )
  61.  
  62. PARAMETER ( NINF=3 )
  63. INTEGER INFOS(NINF)
  64.  
  65. LOGICAL lsupfo,lsupdp
  66.  
  67. IPINTE = 0
  68. MOMATE = 0
  69. MOTYPE = 0
  70. MODEPL = 0
  71. MOFORC = 0
  72. lsupdp = .FALSE.
  73. lsupfo = .FALSE.
  74.  
  75. C- Matrice de capacite
  76. MRIGID = IPRIGI
  77. c* SEGACT,MRIGID
  78. NRIGE0 = IRIGEL(/2)
  79.  
  80. C- Recuperation du sous-modele et de la zone elementaire associee
  81. IMODEL = IPMODE
  82. C* SEGACT,IMODEL
  83.  
  84. MELE = NEFMOD
  85. IF (MELE.EQ.22) GOTO 9991
  86. IF (MELE.EQ.259) GOTO 9991
  87.  
  88. C- Recuperation d'informations sur le maillage elementaire
  89. IPT1 = IMAMOD
  90. SEGACT,IPT1
  91. NBNOE1 = IPT1.NUM(/1)
  92. NBELE1 = IPT1.NUM(/2)
  93.  
  94. C- Quelques informations sur le modele
  95. CONM = CONMOD
  96. CMATE = CMATEE
  97. MATE = IMATEE
  98.  
  99. IRET = 1
  100. CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET)
  101. IF (IRET.EQ.0) GOTO 9990
  102.  
  103. C- Recuperation d'informations sur l'element fini
  104. IF (INFMOD(/1).LT.2+INTTYP) THEN
  105. CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  106. IF (IERR.NE.0) GOTO 9990
  107. INFO = IPINF
  108. MFR = INFELL(13)
  109. LRE = INFELL( 9)
  110. MINTE = INFELL(11)
  111. c* NBPGAU = INFELL( 6)
  112. c* NDDL = INFELL(15)
  113. SEGSUP,INFO
  114. ELSE
  115. MFR = INFELE(13)
  116. LRE = INFELE( 9)
  117. MINTE = INFMOD(2+INTTYP)
  118. c* NBPGAU = INFELE( 6)
  119. c* NDDL = INFELE(15)
  120. ENDIF
  121. c* IF (MFR.NE.71 .AND. MFR.NE.73) THEN
  122. c* CALL ERREUR(21)
  123. c* GOTO 9990
  124. c* ENDIF
  125. IPINTE = MINTE
  126. IF (IPINTE.NE.0) SEGACT,MINTE
  127. IPPORE = 0
  128.  
  129. C- Recuperation des caracteristiques materielles (obligatoires)
  130. ISUPC1 = ISUPC
  131. nbrobl = 1
  132. nbrfac = 0
  133. SEGINI,nomid
  134. IF (MFR.EQ.71) THEN
  135. C* IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  136. lesobl(1) = 'CJEL '
  137. ELSE IF (MFR.EQ.73) THEN
  138. C* ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  139. lesobl(1) = 'CDIF '
  140. ENDIF
  141. MOMATE = nomid
  142. NMATT = nbrobl + nbrfac
  143. c
  144. nbtype = 1
  145. SEGINI,notype
  146. type(1) = 'REAL*8'
  147. MOTYPE = notype
  148.  
  149. C- Definition du descripteur IDESCR pour le modele elementaire
  150. C-- Recherche des noms d'inconnues primales et duales
  151. IF (LNOMID(1).NE.0) THEN
  152. MODEPL = LNOMID(1)
  153. nomid = MODEPL
  154. SEGACT,nomid
  155. NDEPL = lesobl(/2)
  156. C* ndum = lesfac(/2)
  157. ELSE
  158. lsupdp = .TRUE.
  159. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,ndum)
  160. nomid = MODEPL
  161. SEGACT,nomid
  162. ENDIF
  163. IF (LNOMID(2).NE.0) THEN
  164. MOFORC = LNOMID(2)
  165. nomid = MOFORC
  166. SEGACT,nomid
  167. NFORC = lesobl(/2)
  168. C* ndum =lesfac(/2)
  169. ELSE
  170. lsupfo = .TRUE.
  171. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,ndum)
  172. nomid = MOFORC
  173. SEGACT,nomid
  174. ENDIF
  175. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  176. CALL ERREUR(5)
  177. GOTO 9990
  178. ENDIF
  179. C-- Initialisation du segment DESCRIPTEUR
  180. NLIGRP = LRE
  181. NLIGRD = LRE
  182. IF (NBNOE1*NDEPL .GT. NLIGRD) THEN
  183. CALL ERREUR(717)
  184. GOTO 9990
  185. ENDIF
  186. SEGINI,DESCR
  187. C-- Remplissage du segment DESCRIPTEUR
  188. IDDL = 1
  189. DO inoe = 1, NBNOE1
  190. DO il = 1, NDEPL
  191. nomid = MODEPL
  192. LISINC(IDDL) = lesobl(il)
  193. NOELEP(IDDL) = inoe
  194. nomid = MOFORC
  195. LISDUA(IDDL) = lesobl(il)
  196. NOELED(IDDL) = inoe
  197. IDDL = IDDL+1
  198. ENDDO
  199. ENDDO
  200. SEGDES,DESCR
  201. IDESCR = DESCR
  202.  
  203. C- Partionnement si necessaire de la matrice de capacite
  204. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  205. LTRK = oooval(1,4)
  206. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  207. * Ajout a la taille en mots de la matrice des infos du segment
  208. LSEG = LRE*LRE*NBELE1 + 16
  209. NBLPRT = (LSEG-1)/LTRK + 1
  210. NBLMAX = (NBELE1-1)/NBLPRT + 1
  211. NBLPRT = (NBELE1-1)/NBLMAX + 1
  212. * write(ioimp,*) ' capaed : nblprt nblmax = ',nblprt,nblmax,nbele1
  213.  
  214. C Ajout de la matrice de CAPACITE THERMOHYDRIQUE a la matrice globale
  215. C ===================================================================
  216. NRIGEL = NRIGE0 + NBLPRT
  217. SEGADJ,MRIGID
  218.  
  219. descr = IDESCR
  220. meleme = IPT1
  221. nbnn = NBNOE1
  222. nbelem = NBELE1
  223. nbsous = 0
  224. nbref = 0
  225.  
  226. C Boucle sur les PARTITIONS elementaires de la matrice
  227. C ====================================================
  228. DO irige = 1, NBLPRT
  229.  
  230. IF (NBLPRT.GT.1) THEN
  231. C- Partitionnement du maillage support de la matrice elementaire
  232. SEGACT,IPT1
  233. ielem = (irige-1)*NBLMAX
  234. nbelem = MIN(NBLMAX,NBELE1-ielem)
  235. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  236. SEGINI,meleme
  237. itypel = IPT1.itypel
  238. DO ielt = 1, nbelem
  239. jelt = ielt + ielem
  240. DO inoe = 1, nbnn
  241. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  242. ENDDO
  243. icolor(ielt) = IPT1.ICOLOR(jelt)
  244. ENDDO
  245. C- Recopie du descripteur
  246. des1 = IDESCR
  247. SEGINI,descr=des1
  248. SEGDES,descr
  249. ENDIF
  250. ipmail = meleme
  251. ipdesc = descr
  252.  
  253. C- Initialisation de la matrice de rigidite elementaire (xmatri)
  254. NELRIG = nbelem
  255. SEGINI,xmatri
  256. ipmatr = xmatri
  257.  
  258. C- Recuperation du champ des proprietes materielles sur la partition
  259. IVAMAT = 0
  260. CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT)
  261. IF (IERR.NE.0) GOTO 9995
  262. IF (ISUPC1.EQ.1) THEN
  263. CALL VALCHE(IVAMAT,NMATT,IPINTE,IPPORE,MOMATE,MELE)
  264. IF (IERR.NE.0) THEN
  265. ISUPC1 = 0
  266. GOTO 9995
  267. ENDIF
  268. ENDIF
  269.  
  270. * Calcul de la CAPACITE ELEMENTAIRE
  271. IF (MFR .EQ. 71 .OR. MFR .EQ. 73) THEN
  272. CALL CAPDIF(MELE,ipmail,ipinte,IVAMAT,NMATT, ipmatr)
  273. ELSE
  274. CALL ERREUR(21)
  275. ENDIF
  276.  
  277. C- Un peu de menage dans les segments
  278. 9995 CONTINUE
  279. IF (ISUPC1.EQ.1 .OR. NBLPRT.GT.1) THEN
  280. CALL DTMVAL(IVAMAT,3)
  281. ELSE
  282. CALL DTMVAL(IVAMAT,1)
  283. ENDIF
  284. C- Sortie prematuree en cas d'erreur
  285. IF (IERR.NE.0) GOTO 9990
  286.  
  287. xmatri = ipmatr
  288. SEGDES,xmatri
  289. IF (NBLPRT.GT.1) THEN
  290. meleme = ipmail
  291. SEGDES,meleme
  292. ENDIF
  293.  
  294. C- Stockage de la matrice de capacite
  295. jrige = NRIGE0 + irige
  296. COERIG(jrige) = 1.
  297. IRIGEL(1,jrige) = ipmail
  298. IRIGEL(2,jrige) = 0
  299. IRIGEL(3,jrige) = ipdesc
  300. IRIGEL(4,jrige) = ipmatr
  301. IRIGEL(5,jrige) = NIFOUR
  302. IRIGEL(6,jrige) = 0
  303. IRIGEL(7,jrige) = 0
  304. IRIGEL(8,jrige) = 0
  305.  
  306. ENDDO
  307.  
  308. IPRIGI = MRIGID
  309.  
  310. C FIN DU TRAITEMENT : desactivation/destruction de segments
  311. C =========================================================
  312. 9990 CONTINUE
  313. SEGDES,IPT1
  314. IF (IPINTE.NE.0) THEN
  315. MINTE = IPINTE
  316. SEGDES,MINTE
  317. ENDIF
  318. IF (MOMATE.NE.0) THEN
  319. nomid = MOMATE
  320. SEGSUP,nomid
  321. ENDIF
  322. IF (MOTYPE.NE.0) THEN
  323. notype = MOTYPE
  324. SEGSUP,notype
  325. ENDIF
  326. IF (MODEPL.NE.0) THEN
  327. nomid = MODEPL
  328. SEGDES,nomid
  329. IF (lsupdp) SEGSUP,nomid
  330. ENDIF
  331. IF (MOFORC.NE.0) THEN
  332. nomid = MOFORC
  333. SEGDES,nomid
  334. IF (lsupfo) SEGSUP,nomid
  335. ENDIF
  336. 9991 CONTINUE
  337. c* SEGDES,IMODEL
  338. c* SEGDES,MRIGID
  339.  
  340. RETURN
  341. END
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  

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