C CHAL1 SOURCE CHAT 11/03/16 21:16:47 6902 C======================================================================= C= C H A L 1 = C= --------- = C= = C= Fonction : = C= ---------- = C= Calcul des flux equivalents a des sources volumiques = C= = C= Parametres : (E)=Entree (S)=Sortie = C= ------------ = C= IPMODE (E) Pointeur sur le segment MMODEL de la structure = C= IPCHPO (E) Pointeur sur le CHPOINT de sources (puits) aux = C= noeuds de la structure (champ variable) = C= S1 (E) Valeur de la source (FLOTTANT = champ constant) = C= IPGEOM (E) Pointeur sur le MAILLAGE sur lequel s'applique S1 = C= IPCHEL (E) Pointeur sur le segment MCHAML de sources donnees = C= en chaque element de la structure (champ variable) = C= IPCARA (E) Pointeur sur le segment MCHALM de CARACTERISTIQUES = C= dans le cas des COQues et des BARRes = C= MOCOMP (E) Nom de la composante du champ de flux equivalents = C= IPCHAL (S) Pointeur sur le champ des flux nodaux equivalents = C= = C= Variables locales : = C= ------------------- = C= IMASSI Tableau contenant les numeros dans NOMTP des elements = C= thermiques de type MASSIF (dont l'element BARR) = C= LMASSI Longueur du tableau IMASSI = C= ICOQUE Tableau contenant les numeros dans NOMTP des elements = C= thermiques de type COQUE = C= LCOQUE Longueur du tableau ICOQUE = C= = C= Remarque : Le MODELE doit contenir exclusivement un seul type = C= ---------- d'elements, soit MASSIFs, soit COQUEs, soit BARREs. = C= = C= Denis ROBERT, le 26 fevrier 1988. = C======================================================================= SUBROUTINE CHAL1 (IPMODE,IPCHPO,S1,IPGEOM,IPCHEL,IPCARA,MOCOMP, & IPCHAL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC SMMODEL -INC SMCHPOI CHARACTER*(*) MOCOMP PARAMETER (LMASSI=16,LCOQUE=5) INTEGER IMASSI(LMASSI),ICOQUE(LCOQUE) CHARACTER*4 LICOM(3) C ---------- C Elements TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 TET4 TE10 C MASSIFs PYR5 PY13 T1D2 T1D3 M1D2 M1D3 C ---------- DATA IMASSI / 4, 6, 8, 10, 14, 15, 16, 17, 23, 24, & 25, 26, 191, 192, 193, 194 / C ------------- C Elts COQUEs COQ2 COQ3 COQ8 COQ4 COQ6 C ------------- DATA ICOQUE / 44, 27, 41, 49, 56 / C ------------- DATA LICOM / 'SINF','SMOY','SSUP' / IPCHAL=0 C 1 - VERIFICATIONS SUR LE MODELE C ================================= C 1.1 - ERREUR si l'objet MODELE ne contient pas uniquement un seul C type d'elements soit MASSIF, soit COQUE, soit BARRE. C ===== jMASSi=0 jCOQue=0 jBARRe=0 MMODEL=IPMODE SEGACT,MMODEL NSOU=KMODEL(/1) DO i=1,NSOU IMODEL=KMODEL(i) SEGACT,IMODEL IF (NEFMOD.EQ.46) THEN jBARRe=jBARRe+1 ELSE CALL PLACE2(IMASSI,LMASSI,IOK,NEFMOD) IF (IOK.NE.0) THEN jMASSi=jMASSi+1 ELSE CALL PLACE2(ICOQUE,LCOQUE,IOK,NEFMOD) IF (IOK.NE.0) jCOQue=jCOQue+1 ENDIF ENDIF SEGDES,IMODEL ENDDO SEGDES,MMODEL IF (jMASSi.NE.NSOU.AND.jCOQue.NE.NSOU.AND.jBARRe.NE.NSOU) THEN CALL ERREUR(409) RETURN ENDIF C ===== C 1.2 - Verification de l'existence des caracteristiques dans le cas C d'elements COQUEs et BARREs. C ===== IF (jBARRe.EQ.NSOU.AND.IPCARA.EQ.0) THEN CALL ERREUR(518) RETURN ENDIF IF (jCOQue.EQ.NSOU.AND.IPCARA.EQ.0) THEN CALL ERREUR(514) RETURN ENDIF C En elements MASSIFs, aucune caracteristique n'est necessaire. IF (jMASSi.EQ.NSOU) IPCARA=0 C 2 - SOURCES VOLUMIQUES : CHAMP PAR ELEMENT AUX NOEUDS C ======================================================= IPCHSO=IPCHEL C 2.1 - Sources sous forme d'un MCHAML C Reduction au modele + Transport aux noeuds si necessaire IF (IPCHEL.NE.0) THEN IPCH_Z=IPCHSO ** A VOIR : Dans certains cas, REDUAF pose souci (pb. de constituant) ** CALL REDUAF(IPCHSO,IPMODE,IPCH_Z,1,IOK,KERRE) ** IF (IOK.NE.1) CALL ERREUR(KERRE) ** IF (IERR.NE.0) RETURN CALL CHASUP(IPMODE,IPCH_Z,IPCHSO,IOK,1) IF (IERR.NE.0 .OR. IOK.NE.0) THEN CALL ERREUR(21) RETURN ENDIF ELSE C 2.2 - Sources constantes (FLOTTANT) sur un MAILLAGE C Sources mises sous forme d'un CHPOINT IF (IPGEOM.NE.0) THEN IF (jCOQue.EQ.NSOU) THEN DO i=1,3 CALL ECRREE(S1) CALL ECRCHA(LICOM(i)) ENDDO CALL ECRENT(3) C* ELSE IF (jMASSi.EQ.NSOU.OR.jBARRe.EQ.NSOU) THEN ELSE CALL ECRREE(S1) CALL ECRCHA('SCAL') CALL ECRENT(1) ENDIF CALL ECROBJ('MAILLAGE',IPGEOM) CALL MANUCH IF (IERR.NE.0) RETURN CALL LIROBJ('CHPOINT',IPCH_Z,1,IOK) IF (IERR.NE.0) RETURN C 2.3 - Sources sous forme d'un CHPOINT C* ELSE IF (IPCHPO.NE.0) THEN ELSE IPCH_Z=IPCHPO ENDIF C Changement en MCHAML aux noeuds du modele CALL CHAME1(0,IPMODE,IPCH_Z,'VOLUMIQUE',IPCHSO,1) ENDIF C 3 - CHANGEMENT DU SUPPORT DU MCHAML DE CARACTERISTIQUES S'IL EXISTE C ===================================================================== C= Transport des points de Gauss aux noeuds si necessaire IPCARB=IPCARA IF (IPCARA.NE.0) THEN CALL REDUAF(IPCARA,IPMODE,ICHP_Z,0,IOK,KERRE) IF (IOK.NE.1) CALL ERREUR(KERRE) IF (IERR.NE.0) RETURN CALL CHASUP(IPMODE,ICHP_Z,IPCARB,IOK,1) IF (IERR.NE.0 .OR. IOK.NE.0) THEN CALL ERREUR(21) RETURN ENDIF ENDIF C 3 - CALCUL DES FLUX EQUIVALENTS AUX SOURCES VOLUMIQUES C ======================================================== C 3.1 - Cas des elements MASSIFS (1D,2D,3D) C ===== IF (jMASSi.EQ.NSOU) THEN CALL CHAMAS(IPMODE,IPCHSO,IPCARB,MOCOMP, IPCHAL) C ===== C 3.2 - Cas des elements de COQUE C ===== ELSE IF (jCOQue.EQ.NSOU) THEN CALL CHACOQ(IPMODE,IPCHSO,IPCARB,IPCHAL) C ===== C 3.3 - Cas des elements BARREs C ===== C* ELSE IF (jBARRe.EQ.NSOU) THEN ELSE CALL CHABAT(IPMODE,IPCHSO,IPCARB,MOCOMP, IPCHAL) ENDIF RETURN END