C CHALEU SOURCE FANDEUR 13/01/16 21:15:04 7666 C======================================================================= C= C H A L E U = C= ----------- = C= = C= OPERATEUR CAST3M "SOURCE" : = C= --------------------------- = C= FF1 = 'SOURCE' MODL1 | S1 MAIL1 | ( CARA1 ) ( 'ELEM' ) ; = C= | CHP1 | = C= | CHEL1 | = C= = C= Cet operateur sert a calculer les flux nodaux equivalents a une = C= source volumique de chaleur (CHPOINT au second membre) = C= = C= ARGUMENTS : = C= ----------- = C= MODL1 (MMODEL) Modele (global) associe a la structure = C= S1 (FLOTTANT) Valeur algebrique de la source (constante) = C= MAI1 (MAILLAGE) Partie de la structure ou on impose la source = C= de chaleur de valeur S1. = C= CHP1 (CHPOINT) Valeurs algebriques des sources aux NOEUDS = C= CHEL1 (MCHAML) Valeurs algebriques des sources par ELEMENT = C= CARA1 (MCHAML) Caracteristiques geometriques (utilisees dans = C= le cas des elements de type COQUE et BARRe) = C= Sous-type 'CARACTERISTIQUES' = C= = C= RESULTAT : = C= ---------- = C= FF1 (CHPOINT) Flux nodaux equivalents = C= = C= Remarques : = C= ----------- = C= Le CHPOINT resultat FF1 est de nature DISCRETE. = C= Si le MOT 'ELEM' (facultatif) est present, le champ resultat FF1 = C= est alors un MCHAML aux NOEUDS. = C= = C= Denis ROBERT, le 26 fevrier 1988. = C======================================================================= SUBROUTINE CHALEU IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC SMLMOTS -INC SMMODEL CHARACTER*4 MOTELE(1), MOCOMP DATA MOTELE / 'ELEM' / C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR C ========================================== C 1.1 - Lecture FACULTATIVE du mot 'ELEM' C ===== CALL LIRMOT(MOTELE,1,ICle,0) C ===== C 1.2 - Lecture OBLIGATOIRE du modele (IPMODL) C ===== MOTERR(1:8)='MODELE' CALL MESLIR(-137) CALL LIROBJ('MMODEL',IPMODL,1,IRet) IF (IERR.NE.0) RETURN C ===== C 1.3 - Lecture OBLIGATOIRE des sources volumiques donnees par : C 1) un CHPOINT (IPCHPO) C ou 2) d'un maillage (IPGEOM) et d'un flottant (S1) C ou 3) d'un MCHAML (IPCHEL) C ===== IPCHPO=0 S1=0. IPGEOM=0 IPCHEL=0 CALL MESLIR(-138) CALL LIROBJ('CHPOINT',IPCHPO,0,IRet) IF (IRet.EQ.0) THEN CALL MESLIR(-139) CALL LIRREE(S1,0,IRet) IF (IRet.NE.0) THEN MOTERR(1:8)='MAILLAGE' CALL MESLIR(-137) CALL LIROBJ('MAILLAGE',IPGEOM,1,IRet) IF (IERR.NE.0) RETURN ELSE CALL LIROBJ('MCHAML',IPCHEL,1,IRet) IF (IERR.NE.0) RETURN ENDIF ENDIF C ===== C 1.4 - Lecture FACULTATIVE du champ de caracteristiques (IPCARA) C ===== IPCARA=0 CALL MESLIR(-145) CALL LIROBJ('MCHAML',IPCARA,0,IRet) IF (IERR.NE.0) RETURN C ===== C 1.5 - Lecture de la composante de la source (MOCOMP) C ===== MOCOMP=' ' CALL LIRCHA(MOCOMP,0,IRet) IF (IERR.NE.0) RETURN C 2 - EXTRACTION DE LA FORMULATION A TRAITER DU MODELE C ====================================================== C 2.1 - Verification de la formulation (unique) du modele C 2.2 - Recuperation du modele de la formulation retenue C ===== ITHER = 0 ITHHY = 0 IELEC = 0 IDIFF = 0 MMODEL = IPMODL SEGACT,MMODEL SEGINI,MMODE1=MMODEL NSOUS = KMODEL(/1) N1 = 0 DO ISOUS = 1, NSOUS IMODEL = KMODEL(ISOUS) SEGACT,IMODEL NFOR = FORMOD(/2) IF (NFOR.EQ.1) THEN IF (FORMOD(1).EQ.'THERMIQUE') THEN NMAT = MATMOD(/2) CALL PLACE(MATMOD,NMAT,icov,'CONVECTION') CALL PLACE(MATMOD,NMAT,iray,'RAYONNEMENT') IF (icov+iray.EQ.0) THEN ITHER = 1 N1 = N1 + 1 MMODE1.KMODEL(N1) = IMODEL ENDIF ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN ITHHY = 1 N1 = N1 + 1 MMODE1.KMODEL(N1) = IMODEL ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN IELEC = 1 N1 = N1 + 1 MMODE1.KMODEL(N1) = IMODEL ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN IDIFF = 1 N1 = N1 + 1 MMODE1.KMODEL(N1) = IMODEL ELSE MOTERR(1:8) = FORMOD(1) CALL ERREUR(193) ENDIF ELSE IF (NFOR.GT.1) THEN MOTERR(1:8) = FORMOD(1) CALL ERREUR(193) ENDIF SEGDES,IMODEL ENDDO SEGDES,MMODEL IF (IERR.NE.0) GOTO 9900 IF (N1.EQ.0) THEN write(ioimp,*) 'Modele vide ??' CALL ERREUR(21) GOTO 9900 ELSE IF ((ITHER+ITHHY+IELEC+IDIFF).NE.1) THEN *AV Affiner l'erreur ! write(ioimp,*) 'Une seule formulation dans le modele !' CALL ERREUR(21) GOTO 9900 ENDIF IF (N1.NE.NSOUS) THEN SEGADJ,MMODE1 ENDIF IPMODL = MMODE1 C ===== C 2.3 - Adequation nom de composante source & modele C ===== IF (ITHER .EQ. 1) THEN IF (MOCOMP.EQ.' ') MOCOMP = 'Q ' IF (MOCOMP.NE.'Q ') CALL ERREUR(665) ELSE IPCOMP = 0 CALL NOVARD(IPMODL,'FORC') CALL LIROBJ('LISTMOTS',IPCOMP,1,IRet) IF (IERR.NE.0) RETURN MLMOTS = IPCOMP SEGACT,MLMOTS NCOMP = MOTS(/2) * Normalement : NCOMP est non nul ! * Cas particulier de la diffusion en attendant un traitement adequat ? IF (IDIFF.EQ.1 .AND. NCOMP.GT.1) THEN write(ioimp,*) 'Modele de DIFFUSION a une seule quantite SVP' CALL ERREUR(21) ENDIF IF (MOCOMP.EQ.' ') MOCOMP = MOTS(1) CALL PLACE(MOTS,NCOMP,IRet,MOCOMP) IF (IRet.EQ.0) CALL ERREUR(665) SEGSUP,MLMOTS ENDIF IF (IERR.NE.0) GOTO 9900 C 3 - CALCUL DES FLUX NODAUX EQUIVALENTS C ======================================== CALL CHAL1(IPMODL,IPCHPO,S1,IPGEOM,IPCHEL,IPCARA,MOCOMP, IPCHAL) IF (IERR.NE.0 .OR. IPCHAL.EQ.0) GOTO 9900 C 4 - ECRITURE DE L'OBJET RESULTAT (CHPOINT OU MCHAML) C ====================================================== IF (ICle.EQ.0) THEN CALL CHAMPO(IPCHAL,0,IPCHAP,IRet) C= Le resultat est un CHPOINT de nature DISCRETE. CALL DTCHAM(IPCHAL) IF (IRet.NE.1) RETURN CALL ECROBJ('CHPOINT',IPCHAP) ELSE CALL ECROBJ('MCHAML',IPCHAL) ENDIF C 5 - FIN C ========= 9900 CONTINUE SEGSUP,MMODE1 RETURN END