Télécharger capaed.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPAED SOURCE CB215821 17/01/16 21:15:11 9279
  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.  
  87. C- Recuperation d'informations sur le maillage elementaire
  88. IPT1 = IMAMOD
  89. SEGACT,IPT1
  90. NBNOE1 = IPT1.NUM(/1)
  91. NBELE1 = IPT1.NUM(/2)
  92.  
  93. C- Quelques informations sur le modele
  94. CONM = CONMOD
  95. CMATE = CMATEE
  96. MATE = IMATEE
  97.  
  98. IRET = 1
  99. CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET)
  100. IF (IRET.EQ.0) GOTO 9990
  101.  
  102. C- Recuperation d'informations sur l'element fini
  103. IF (INFMOD(/1).LT.2+INTTYP) THEN
  104. CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  105. IF (IERR.NE.0) GOTO 9990
  106. INFO = IPINF
  107. MFR = INFELL(13)
  108. LRE = INFELL( 9)
  109. MINTE = INFELL(11)
  110. c* NBPGAU = INFELL( 6)
  111. c* NDDL = INFELL(15)
  112. SEGSUP,INFO
  113. ELSE
  114. MFR = INFELE(13)
  115. LRE = INFELE( 9)
  116. MINTE = INFMOD(2+INTTYP)
  117. c* NBPGAU = INFELE( 6)
  118. c* NDDL = INFELE(15)
  119. ENDIF
  120. c* IF (MFR.NE.71 .AND. MFR.NE.73) THEN
  121. c* CALL ERREUR(21)
  122. c* GOTO 9990
  123. c* ENDIF
  124. IPINTE = MINTE
  125. IF (IPINTE.NE.0) SEGACT,MINTE
  126. IPPORE = 0
  127.  
  128. C- Recuperation des caracteristiques materielles (obligatoires)
  129. ISUPC1 = ISUPC
  130. nbrobl = 1
  131. nbrfac = 0
  132. SEGINI,nomid
  133. IF (MFR.EQ.71) THEN
  134. C* IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  135. lesobl(1) = 'CJEL '
  136. ELSE IF (MFR.EQ.73) THEN
  137. C* ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  138. lesobl(1) = 'CDIF '
  139. ENDIF
  140. MOMATE = nomid
  141. NMATT = nbrobl + nbrfac
  142. c
  143. nbtype = 1
  144. SEGINI,notype
  145. type(1) = 'REAL*8'
  146. MOTYPE = notype
  147.  
  148. C- Definition du descripteur IDESCR pour le modele elementaire
  149. C-- Recherche des noms d'inconnues primales et duales
  150. IF (LNOMID(1).NE.0) THEN
  151. MODEPL = LNOMID(1)
  152. nomid = MODEPL
  153. SEGACT,nomid
  154. NDEPL = lesobl(/2)
  155. C* ndum = lesfac(/2)
  156. ELSE
  157. lsupdp = .TRUE.
  158. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,ndum)
  159. nomid = MODEPL
  160. SEGACT,nomid
  161. ENDIF
  162. IF (LNOMID(2).NE.0) THEN
  163. MOFORC = LNOMID(2)
  164. nomid = MOFORC
  165. SEGACT,nomid
  166. NFORC = lesobl(/2)
  167. C* ndum =lesfac(/2)
  168. ELSE
  169. lsupfo = .TRUE.
  170. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,ndum)
  171. nomid = MOFORC
  172. SEGACT,nomid
  173. ENDIF
  174. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  175. CALL ERREUR(5)
  176. GOTO 9990
  177. ENDIF
  178. C-- Initialisation du segment DESCRIPTEUR
  179. NLIGRP = LRE
  180. NLIGRD = LRE
  181. IF (NBNOE1*NDEPL .GT. NLIGRD) THEN
  182. CALL ERREUR(717)
  183. GOTO 9990
  184. ENDIF
  185. SEGINI,DESCR
  186. C-- Remplissage du segment DESCRIPTEUR
  187. IDDL = 1
  188. DO inoe = 1, NBNOE1
  189. DO il = 1, NDEPL
  190. nomid = MODEPL
  191. LISINC(IDDL) = lesobl(il)
  192. NOELEP(IDDL) = inoe
  193. nomid = MOFORC
  194. LISDUA(IDDL) = lesobl(il)
  195. NOELED(IDDL) = inoe
  196. IDDL = IDDL+1
  197. ENDDO
  198. ENDDO
  199. SEGDES,DESCR
  200. IDESCR = DESCR
  201.  
  202. C- Partionnement si necessaire de la matrice de capacite
  203. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  204. LTRK = oooval(1,4)
  205. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  206. * Ajout a la taille en mots de la matrice des infos du segment
  207. LSEG = LRE*LRE*NBELE1 + 16
  208. NBLPRT = (LSEG-1)/LTRK + 1
  209. NBLMAX = (NBELE1-1)/NBLPRT + 1
  210. NBLPRT = (NBELE1-1)/NBLMAX + 1
  211. * write(ioimp,*) ' capaed : nblprt nblmax = ',nblprt,nblmax,nbele1
  212.  
  213. C Ajout de la matrice de CAPACITE THERMOHYDRIQUE a la matrice globale
  214. C ===================================================================
  215. NRIGEL = NRIGE0 + NBLPRT
  216. SEGADJ,MRIGID
  217.  
  218. descr = IDESCR
  219. meleme = IPT1
  220. nbnn = NBNOE1
  221. nbelem = NBELE1
  222. nbsous = 0
  223. nbref = 0
  224.  
  225. C Boucle sur les PARTITIONS elementaires de la matrice
  226. C ====================================================
  227. DO irige = 1, NBLPRT
  228.  
  229. IF (NBLPRT.GT.1) THEN
  230. C- Partitionnement du maillage support de la matrice elementaire
  231. SEGACT,IPT1
  232. ielem = (irige-1)*NBLMAX
  233. nbelem = MIN(NBLMAX,NBELE1-ielem)
  234. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  235. SEGINI,meleme
  236. itypel = IPT1.itypel
  237. DO ielt = 1, nbelem
  238. jelt = ielt + ielem
  239. DO inoe = 1, nbnn
  240. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  241. ENDDO
  242. icolor(ielt) = IPT1.ICOLOR(jelt)
  243. ENDDO
  244. C- Recopie du descripteur
  245. des1 = IDESCR
  246. SEGINI,descr=des1
  247. SEGDES,descr
  248. ENDIF
  249. ipmail = meleme
  250. ipdesc = descr
  251.  
  252. C- Initialisation de la matrice de rigidite elementaire (xmatri)
  253. NELRIG = nbelem
  254. SEGINI,xmatri
  255. ipmatr = xmatri
  256.  
  257. C- Recuperation du champ des proprietes materielles sur la partition
  258. IVAMAT = 0
  259. CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT)
  260. IF (IERR.NE.0) GOTO 9995
  261. IF (ISUPC1.EQ.1) THEN
  262. CALL VALCHE(IVAMAT,NMATT,IPINTE,IPPORE,MOMATE,MELE)
  263. IF (IERR.NE.0) THEN
  264. ISUPC1 = 0
  265. GOTO 9995
  266. ENDIF
  267. ENDIF
  268.  
  269. * Calcul de la CAPACITE ELEMENTAIRE
  270. IF (MFR .EQ. 71 .OR. MFR .EQ. 73) THEN
  271. CALL CAPDIF(MELE,ipmail,ipinte,IVAMAT,NMATT, ipmatr)
  272. ELSE
  273. CALL ERREUR(21)
  274. ENDIF
  275.  
  276. C- Un peu de menage dans les segments
  277. 9995 CONTINUE
  278. IF (ISUPC1.EQ.1 .OR. NBLPRT.GT.1) THEN
  279. CALL DTMVAL(IVAMAT,3)
  280. ELSE
  281. CALL DTMVAL(IVAMAT,1)
  282. ENDIF
  283. C- Sortie prematuree en cas d'erreur
  284. IF (IERR.NE.0) GOTO 9990
  285.  
  286. xmatri = ipmatr
  287. SEGDES,xmatri
  288. IF (NBLPRT.GT.1) THEN
  289. meleme = ipmail
  290. SEGDES,meleme
  291. ENDIF
  292.  
  293. C- Stockage de la matrice de capacite
  294. jrige = NRIGE0 + irige
  295. COERIG(jrige) = 1.
  296. IRIGEL(1,jrige) = ipmail
  297. IRIGEL(2,jrige) = 0
  298. IRIGEL(3,jrige) = ipdesc
  299. IRIGEL(4,jrige) = ipmatr
  300. IRIGEL(5,jrige) = NIFOUR
  301. IRIGEL(6,jrige) = 0
  302. IRIGEL(7,jrige) = 0
  303. IRIGEL(8,jrige) = 0
  304.  
  305. ENDDO
  306.  
  307. IPRIGI = MRIGID
  308.  
  309. C FIN DU TRAITEMENT : desactivation/destruction de segments
  310. C =========================================================
  311. 9990 CONTINUE
  312. SEGDES,IPT1
  313. IF (IPINTE.NE.0) THEN
  314. MINTE = IPINTE
  315. SEGDES,MINTE
  316. ENDIF
  317. IF (MOMATE.NE.0) THEN
  318. nomid = MOMATE
  319. SEGSUP,nomid
  320. ENDIF
  321. IF (MOTYPE.NE.0) THEN
  322. notype = MOTYPE
  323. SEGSUP,notype
  324. ENDIF
  325. IF (MODEPL.NE.0) THEN
  326. nomid = MODEPL
  327. SEGDES,nomid
  328. IF (lsupdp) SEGSUP,nomid
  329. ENDIF
  330. IF (MOFORC.NE.0) THEN
  331. nomid = MOFORC
  332. SEGDES,nomid
  333. IF (lsupfo) SEGSUP,nomid
  334. ENDIF
  335. 9991 CONTINUE
  336. c* SEGDES,IMODEL
  337. c* SEGDES,MRIGID
  338.  
  339. RETURN
  340. END
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  

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