C CHALEU SOURCE CB215821 24/04/12 21:15:13 11897 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 PPARAM -INC CCOPTIO -INC SMCOORD -INC SMMODEL -INC SMCHAML CHARACTER*4 MOTELE(1) CHARACTER*(LOCOMP) MOCOMP DATA MOTELE / 'ELEM' / segact mcoord C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR C ========================================== C 1.1 - Lecture FACULTATIVE du mot 'ELEM' C ===== ICLE = 0 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) CALL ACTOBJ('MMODEL ',IPMODL,1) 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.D0 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) CALL ACTOBJ('MAILLAGE',IPGEOM,1) ELSE CALL LIROBJ('MCHAML ',IPCHEL,1,iret) CALL ACTOBJ('MCHAML ',IPCHEL,1) ENDIF ELSE CALL ACTOBJ('CHPOINT ',IPCHPO,1) ENDIF IF (IERR.NE.0) RETURN C ===== C 1.4 - Lecture FACULTATIVE du champ de caracteristiques (IPCARA) C ===== IPCARA = 0 IPCAR1 = 0 CALL MESLIR(-145) CALL LIROBJ('MCHAML ',IPCARA,0,iret) IF (iret .EQ. 1) CALL ACTOBJ('MCHAML ',IPCARA,1) 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(iret .EQ. 1)THEN PRINT *,'Syntaxe non presente dans la notice !' CALL ERREUR(5) ENDIF IF (IERR.NE.0) RETURN C 2 - VERIFICATION DU MODELE A TRAITER C ====================================== IPMOD1 = 0 C IPMOD1 : Modele a traiter C IFORMU : indice correspondant a la formulation C ITYPEF : indicateur du type d'elements (massif, coque ou barre) CALL CHALVM(IPMODL,IPMOD1,IFORMU,ITYPEF) IF (IERR.NE.0) GOTO 9900 C 3 - ANALYSE DU TERME SOURCE C ============================= C Reduction du MCHAML de sources si fourni IF (IPCHEL.NE.0) THEN IPCHMZ = IPCHEL CALL REDUAF(IPCHMZ,IPMOD1,IPCHEL,0,iok,kerre) IF (iok.NE.1) CALL ERREUR(kerre) IF (IERR.NE.0) GOTO 9900 C Si IPCHEL, verif. si caracteristiques sont dans MCHAML source IF (IPCARA.EQ.0.AND.(ITYPEF.EQ.2.OR.ITYPEF.EQ.3)) THEN CALL ECRCHA('GEOM') CALL ECROBJ('MMODEL ',IPMOD1) CALL EXTRAI IF (IERR.NE.0) GOTO 9900 CALL LIROBJ('LISTMOTS',MLMOT1,1,IRET) IF (IERR.NE.0) GOTO 9900 CALL EXCOC2(IPCHEL,MLMOT1,IPCAR1,MLMOT1,1) IF (IERR.NE.0) GOTO 9900 IPCARA = IPCAR1 ENDIF ENDIF C Mise sous forme de MCHAML des donnees d'entrees et C Determination du support du MCHAML de sources CALL CHALVS(IPMOD1,IFORMU,ITYPEF, IPCHPO,S1,IPGEOM,IPCHEL, & IPCHSO,ISUPSO) IF (IERR.NE.0) GOTO 9900 C 4 - ANALYSE DU CHAMP DE CARACTERISTIQUES C ========================================== C Verification de l'existence des caracteristiques C dans le cas d'elements COQUEs et BARREs. C Si IPCHEL, verif. si caracteristiques sont dans MCHAML source IF (IPCARA.EQ.0) THEN IF (ITYPEF.EQ.2) THEN CALL ERREUR(514) ELSE IF (ITYPEF.EQ.3) THEN CALL ERREUR(518) ENDIF IF (IERR.NE.0) GOTO 9900 ELSE C En elements MASSIFs, aucune caracteristique n'est necessaire. IF (ITYPEF.EQ.1) IPCARA = 0 ENDIF IF (IPCARA.NE.0) THEN IPCHMZ = IPCARA CALL REDUAF(IPCHMZ,IPMOD1,IPCARA,0,iok,kerre) IF (iok.NE.1) CALL ERREUR(kerre) IF (IERR.NE.0) GOTO 9900 C mchelm = IPCARA SEGACT,mchelm IF (mchelm.titche.NE.'CARACTERISTIQUES') THEN MOTERR(1:16) = 'CARACTERISTIQUES' CALL ERREUR(291) C SEGDES,mchelm GOTO 9900 ENDIF ENDIF C 5 - CALCUL DES FLUX NODAUX EQUIVALENTS C ======================================== CALL CHAL1(IPMOD1,IFORMU,ITYPEF, IPCHSO,ISUPSO, IPCARA, IPCHAL) IF (IERR.NE.0 .OR. IPCHAL.EQ.0) GOTO 9900 C 6 - 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. MCHEL1=IPCHAL SEGSUP,MCHEL1 IF (iret.NE.1 .OR. IERR.NE.0) RETURN CALL ACTOBJ('CHPOINT ',IPCHAP,1) CALL ECROBJ('CHPOINT ',IPCHAP) ELSE CALL ACTOBJ('MCHAML ',IPCHAL,1) CALL ECROBJ('MCHAML ',IPCHAL) ENDIF C 7 - FIN C ========= 9900 CONTINUE IF (IPMOD1.NE.0 .AND. IPMOD1 .NE. IPMODL) THEN MMODE1 = IPMOD1 SEGSUP,MMODE1 ENDIF IF (IPCAR1.NE.0 .AND. IPCAR1 .NE. IPCHEL) THEN MCHEL1 = IPCAR1 SEGSUP,MCHEL1 ENDIF END