C THCAPA1 SOURCE PV090527 26/04/30 21:16:40 12529 C======================================================================= C= T H C A P A 1 = C= ------------- = C= (CAPA1 dans le cas de la thermique) = C= Fonction : = C= ---------- = C= Calcul de la matrice de CAPACITE en couplage THERMOHYDRIQUE = C= (type RIGIDITE) = C= = C= Parametres : (E)=Entree (S)=Sortie = C= ------------ = C= IPMODE (E) Segment IMODEL pour un modele elementaire (ACTIF) = C= IPCHEL (E) Segment MCHELM de CARACTERISTIQUES (?) = C= ISUPCA (E) Support du champ de CARACTERISTIQUES = C= IPRIGI (E/S) Segment MRIGID : CAPACITE (ACTIF) = C= = C= Zakaria HABIBI le 30 juin 2008. = C======================================================================= SUBROUTINE THCAPA1 (IPMODE,IPCHEL,ISUPCA, IPRIGI) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMINTE -INC SMMODEL -INC SMRIGID INTEGER OOOVAL SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT CHARACTER*8 CMATE CHARACTER*(LCONMO) CONM PARAMETER ( NINF=3 ) DIMENSION INFOS(NINF) C= LEFMAS Liste des numeros d'elements finis MASSIFs supportant la = C la formulation thermohydrique = C= NEFMAS Longueur de cette liste = PARAMETER ( NEFMAS = 14 ) DIMENSION LEFMAS(NEFMAS) C ========== C Elements TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 TET4 TE10 C MASSIFs PYR5 PY13 T1D2 T1D3 C ========== DATA LEFMAS / 4, 6, 8, 10, 14, 15, 16, 17, 23, 24, & 25, 26, 191, 192 / IPINTE = 0 IPINT1 = 0 MOMATE = 0 MOTYPE = 0 C- Matrice de capacite MRIGID = IPRIGI c* SEGACT,MRIGID NRIGE0 = IRIGEL(/2) C- Recuperation du sous-modele et de la zone elementaire associee IMODEL = IPMODE c* SEGACT,IMODEL NEF = NEFMOD C Test sur l'element fini IMAS = 0 CALL PLACE2(LEFMAS,NEFMAS,IMAS,NEF) C ERREUR : Element fini non implemente actuellement IF (NEF.EQ.22 .OR. IMAS.EQ.0) THEN CALL ERREUR(19) GOTO 9991 ENDIF C C- Recuperation d'informations sur le maillage elementaire IPT1 = IMAMOD SEGACT,IPT1 NBNOE1 = IPT1.NUM(/1) NBELE1 = IPT1.NUM(/2) * C- Quelques informations sur le modele CONM = CONMOD CMATE = CMATEE MATE = IMATEE IRET = 1 CALL IDENT(IPT1,CONM,IPCHEL,0, INFOS,IRET) IF (IRET.EQ.0) GOTO 9990 C- Recuperation d'informations sur l'element fini CALL TSHAPE(NEF,'GAUSS',IPINTE) IF (IERR.NE.0) GOTO 9990 MINTE = IPINTE SEGACT,MINTE IF (MATE.EQ.2 .OR. MATE.EQ.3) THEN NLG = NUMGEO(NEF) CALL RESHPT(1,NBNOE1,NLG,NEF,0,IPINT1,IOK) IF (IOK.EQ.0) GOTO 9990 MINTE1 = IPINT1 SEGACT,MINTE1 ENDIF C- Recuperation des caracteristiques materielles nomid = LNOMID(6) SEGACT,nomid NMATO = lesobl(/2) NMATF = lesfac(/2) NMATT = NMATO + NMATF MOMATE = nomid nbtype = 1 SEGINI,notype TYPE(1) = 'REAL*8' MOTYPE = notype C- Definition du descripteur IDESCR IDESCR = 0 CALL THCOND2(NBNOE1,IDESCR) descr = IDESCR SEGACT,descr NLIGRD = lisdua(/2) NLIGRP = lisinc(/2) SEGDES,descr LRE = NLIGRD C- Partionnement si necessaire de la matrice thermohydrique C- determinant ainsi le nombre d'objets elementaires de MRIGID LTRK = oooval(1,4) IF (LTRK.EQ.0) LTRK = oooval(1,1) LTRK=MAX(LTRK,2**24) * Ajout a la taille en mots de la matrice des infos du segment LSEG = LRE*LRE*NBELE1 + 16 NBLPRT = (LSEG-1)/LTRK + 1 NBLMAX = (NBELE1-1)/NBLPRT + 1 NBLPRT = (NBELE1-1)/NBLMAX + 1 * write(ioimp,*) ' thcond1 : nblprt nblmax = ',nblprt,nblmax,nbele1 C Ajout de la matrice de CAPACITE THERMOHYDRIQUE a la matrice globale C =================================================================== NRIGEL = NRIGE0 + NBLPRT SEGADJ,MRIGID descr = IDESCR meleme = IPT1 nbnn = NBNOE1 nbelem = NBELE1 nbsous = 0 nbref = 0 C Boucle sur les PARTITIONS elementaires de la matrice C======================================================= DO irige = 1, NBLPRT IF (NBLPRT.GT.1) THEN C Partitionnement du maillage support de la matrice elementaire SEGACT,IPT1 ielem = (irige-1)*NBLMAX nbelem = MIN(NBLMAX,NBELE1-ielem) * write(ioimp,*) ' creation segment ',nbnn,nbelem SEGINI,meleme itypel = IPT1.itypel DO ielt = 1, nbelem jelt = ielt + ielem DO inoe = 1, nbnn num(inoe,ielt) = IPT1.NUM(inoe,jelt) ENDDO icolor(ielt) = IPT1.ICOLOR(jelt) ENDDO C Recopie du descripteur des1 = IDESCR SEGINI,descr=des1 SEGDES,descr ENDIF ipmail = meleme ipdesc = descr C Initialisation de la matrice de rigidite elementaire (xmatri) NELRIG = nbelem rigrel=0 SEGINI,xmatri ipmatr = xmatri IVAMAT = 0 CALL KOMCHA(IPCHEL,ipmail,CONM,MOMATE,MOTYPE,1,INFOS,3,IVAMAT) IF (IERR.NE.0) GOTO 9995 IF (ISUPCA.EQ.1) THEN CALL VALCHE(IVAMAT,NMATT,IPINTE,0,MOMATE,NEF) IF (IERR.NE.0) THEN ISUPCA = 0 GOTO 9995 ENDIF ENDIF C- Elements MASSIFs a integration NUMERIQUE IF (IMAS.NE.0) THEN CALL THNUMAC2(NEF,ipmail,IPINTE,IPINT1,IVAMAT,NMATT, & ipmatr,LRE) C- Element fini non implemente ELSE CALL ERREUR(19) ENDIF C- Un peu de menage 9995 CONTINUE IF (ISUPCA.EQ.1 .OR. NBLPRT.GT.1) THEN CALL DTMVAL(IVAMAT,3) ELSE CALL DTMVAL(IVAMAT,1) ENDIF IF (IERR.NE.0) GOTO 9990 xmatri = ipmatr IF (NBLPRT.GT.1) THEN meleme = ipmail SEGDES,meleme ENDIF C- Remplissage de la matrice de CAPACITE jrige = NRIGE0 + irige COERIG(jrige) = 1. IRIGEL(1,jrige) = ipmail IRIGEL(2,jrige) = 0 IRIGEL(3,jrige) = ipdesc IRIGEL(4,jrige) = ipmatr IRIGEL(5,jrige) = NIFOUR IRIGEL(6,jrige) = 0 IRIGEL(7,jrige) = 2 IRIGEL(8,jrige) = 0 xmatri.symre=2 SEGDES,xmatri ENDDO IPRIGI = MRIGID C FIN DU TRAITEMENT : DESACTIVATION/DESTRUCTION DE SEGMENTS C ========================================================= 9990 CONTINUE SEGDES,IPT1 IF (IPINTE.GT.0) THEN MINTE = IPINTE SEGDES,MINTE ENDIF IF (IPINT1.GT.0) THEN MINTE = IPINT1 SEGDES,MINTE ENDIF IF (MOMATE.NE.0) THEN nomid = MOMATE SEGDES,nomid ENDIF IF (MOTYPE.NE.0) THEN notype = MOTYPE SEGSUP,notype ENDIF 9991 CONTINUE c* SEGDES,IMODEL c* SEGDES,MRIGID RETURN END