C FLUX SOURCE CB215821 24/04/12 21:16:00 11897 C======================================================================= C= F L U X = C= ------- = C= = C= OPERATEUR CAST3M "FLUX" : = C= ------------------------- = C= FF1 = 'FLUX' MODL1 | VFLU MAI1 ( 'DIRE' POI1 ) | ( 'PEAU' ) ; = C= | CH1 | = C= | CH2 LMOTS | = C= = C= Cet operateur sert a calculer les flux nodaux equivalents a une = C= condition de flux de chaleur impose (CHPOINT au second membre). = C= = C= ARGUMENTS : = C= ----------- = C= MODL1 (MMODEL) Modele (global) associe a la structure = C= VFLU (FLOTTANT) Valeur algebrique du flux (constante) = C= MAI1 (MAILLAGE) Partie de la structure ou on impose le flux de = C= chaleur de valeur VFLU. = C= CH1 (CHPOINT ou MCHAML) Valeurs algebriques des flux = C= 'DIRE' (MOT) Indique que le flux est incline par rapport a = C= a la normale a la (sur)face = C= POI1 (POINT) Direction du flux dans le repere global = C= CH2 (CHPOINT ou MCHAML) Champ a plusieurs composantes = C= LMOTS (LISTMOTS) Liste des composantes de CH2, la premiere est = C= associee a la direction X, la deuxieme a Y et = C= la troisieme a Z (en 3D) = C= PEAU (MOT) Indique la peau etudie dans le cas des COQUES = C= = C= RESULTAT : = C= ---------- = C= FF1 (CHPOINT) Flux nodaux equivalents a la condition de flux = C= de nature DISCRETE = C= = C= CREATION / MODIF : = C= ------------------ = C= Creation : Denis ROBERT, le 25 janvier 1988. = C= Modif : BP, 30/07/2013 : ajout de la possibilité que CH1 et CH2 = C= soient des MCHAML = C= = C======================================================================= SUBROUTINE FLUX IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMLMOTS -INC SMMODEL PARAMETER (NP=2) CHARACTER*4 PEAU CHARACTER*4 MOPEAU(NP),MOFLU(1) CHARACTER*(LOCOMP) MOCOMP DATA MOPEAU / 'INFE','SUPE' / DATA MOFLU / 'DIRE' / C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR C ========================================== C 1.1 - Lecture OBLIGATOIRE du modele (IPMODL) C ===== MOTERR(1:8)=' MODELE ' CALL MESLIR(-137) CALL LIROBJ('MMODEL ',IPMODL,1,iOK) CALL ACTOBJ('MMODEL ',IPMODL,1) IF (IERR.NE.0) RETURN C ===== C 1.2 - Lecture OBLIGATOIRE des flux de chaleur donnes par : C 1) un CHPOINT (IPCHPO) avec ou sans LISTMOTS (MLMOTX) C ou 2) un MCHAML (-IPCHPO) avec ou sans LISTMOTS (MLMOTX) C ou 3) un maillage (IPGEOM) et un flottant (VALFLU) C ===== IPCHPO=0 MLMOTX=0 VALFLU=0. CALL MESLIR(-164) CALL LIROBJ('CHPOINT ',IPCHPO,0,iOK) IF(iOK.EQ.1) CALL ACTOBJ('CHPOINT ',IPCHPO,1) IF (IERR.NE.0) RETURN cbp : on ajoute la possibilité de lire un mchaml IF (iOK.EQ.0) THEN CALL LIROBJ('MCHAML ',IPIN,0,iOK) IF (IERR.NE.0) RETURN IPCHPO=0 IF (iOK .EQ. 1) THEN CALL ACTOBJ('MCHAML ',IPIN,1) CALL REDUAF(IPIN,IPMODL,IPCHPO,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN IPCHPO = -1*IPCHPO ENDIF ENDIF IF (iOK.EQ.1) THEN CALL LIROBJ('LISTMOTS',MLMOTX,0,iOK) IF (IERR.NE.0) RETURN IF (MLMOTX.NE.0) THEN MLMOTS=MLMOTX SEGACT,MLMOTS NCOMP = MOTS(/2) IF (NCOMP.NE.IDIM) THEN CALL ERREUR(21) RETURN ENDIF ENDIF IPCHP2 = IPCHPO ELSE CALL MESLIR(-163) CALL LIRREE(VALFLU,1,iOK) IF (IERR.NE.0) RETURN MOTERR(1:8)='MAILLAGE' CALL MESLIR(-137) CALL LIROBJ('MAILLAGE',IPGEOM,1,iOK) CALL ACTOBJ('MAILLAGE',IPGEOM,1) IF (IERR.NE.0) RETURN CALL MANUC2(VALFLU,IPGEOM,1,IPCHP2) IF (IERR.NE.0) RETURN ENDIF C ===== C 1.3 - Lecture FACULTATIVE du MOT 'DIRE' et du vecteur associe C ===== NUMPOI=-1 CALL LIRMOT(MOFLU,1,iOK,0) IF (iOK.NE.0) THEN CALL MESLIR(-162) CALL LIROBJ('POINT',NUMPOI,1,iOK) IF (IERR.NE.0) GOTO 10 ENDIF C ===== C 1.4 - Lecture FACULTATIVE du MOT associe a la PEAU (cas des COQUES) C ===== PEAU=' ' CALL MESLIR (-260) CALL LIRMOT(MOPEAU,NP,LP,0) IF (IERR.NE.0) GOTO 10 IF (LP.NE.0) PEAU=MOPEAU(LP) C 2 - EXTRACTION DE LA FORMULATION A TRAITER DU MODELE C ====================================================== C 2.1 - Verification de la formulation (unique) du modele C ===== ITHER = 0 ITHHY = 0 IELEC = 0 IDIFF = 0 MMODEL = IPMODL NSOUS = KMODEL(/1) DO ISOUS = 1, NSOUS IMODEL = KMODEL(ISOUS) NFOR = FORMOD(/2) IF (NFOR.EQ.1) THEN IF (FORMOD(1).EQ.'THERMIQUE') THEN ITHER = 1 ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN ITHHY = 1 ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN IELEC = 1 ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN IDIFF = 1 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 ENDDO IF (IERR.NE.0) GOTO 10 IF ((ITHER+ITHHY+IELEC+IDIFF).NE.1) THEN *AV Affiner l'erreur ! write(ioimp,*) 'Une seule formulation dans le modele !' CALL ERREUR(21) GOTO 10 ENDIF C ===== C 2.2 - Recuperation du modele de la formulation retenue C ===== IF (ITHER .EQ. 1) CALL ECRCHA('THERMIQUE') IF (ITHHY .EQ. 1) CALL ECRCHA('THERMOHYDRIQUE') IF (IELEC .EQ. 1) CALL ECRCHA('ELECTROSTATIQUE') IF (IDIFF .EQ. 1) CALL ECRCHA('DIFFUSION') CALL ECRCHA('FORM') CALL ECROBJ('MMODEL',IPMODL) CALL EXTRAI CALL LIROBJ('MMODEL',IPMODL,1,IRet) IF (IERR.NE.0) GOTO 10 C ===== C 2.3 - Adequation nom de composante source & modele C ===== MOCOMP = ' ' IF (ITHER .EQ. 1) THEN IF (MOCOMP.EQ.' ') MOCOMP = 'Q ' IF (MOCOMP.NE.'Q ') CALL ERREUR(665) C* A finir pour la thermohydrique ELSE IF (ITHHY .EQ. 1) THEN MOCOMP = 'Q ' 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 10 C 3 - CALCUL DES FLUX NODAUX EQUIVALENTS C ======================================== IPFLUX=0 CALL FLUX2(IPMODL,IPCHP2,NUMPOI,MOCOMP,PEAU,MLMOTX,IPFLUX) IF (IERR.NE.0) GOTO 10 C 4 - ECRITURE DU CHPOINT RESULTAT C ================================== C= Attribution d'une nature DISCRETE au CHPOINT resultat IF (IPFLUX.NE.0) THEN MCHPOI=IPFLUX NAT=MAX(1,JATTRI(/1)) NSOUPO=IPCHP(/1) SEGADJ,MCHPOI JATTRI(1)=2 IPFLUX=MCHPOI CALL ACTOBJ('CHPOINT ',IPFLUX,1) CALL ECROBJ('CHPOINT ',IPFLUX) ENDIF C 5 - MENAGE : Destruction eventuelle de CHPOINT intermediaire c si syntaxe avec maillage en argument d'entree C ============== 10 CONTINUE IF (IPCHPO.EQ.0) CALL DTCHPO(IPCHP2) END