C CHABAT SOURCE CHAT 11/03/16 21:16:43 6902 C======================================================================= C= C H A B A T = C= ----------- = C= = C= Fonction : = C= ---------- = C= Calcul des flux equivalents a des sources volumiques dans le cas = C des elements BARRE (en THERMIQUE). = C= = C= Parametres : (E)=Entree (S)=Sortie = C= ------------ = C= IPMODL (E) Pointeur sur le segment MMODEL de la structure = C= IPCHSO (E) Pointeur sur le MCHAML aux noeuds de sources = C= IPCHEB (E) Pointeur sur le segment MCHAML de CARACTERISTIQUES = C= utiles pour les elements BARREs = C= NOMDUA (E) Nom de la composante du champ de flux equivalents = C= IPCHAL (S) Pointeur sur le champ des flux equivalents = C======================================================================= SUBROUTINE CHABAT (IPMODL,IPCHSO,IPCHEB,NOMDUA, IPCHAL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC CCREEL -INC SMCOORD -INC SMCHAML -INC SMELEME -INC SMINTE -INC SMMODEL SEGMENT INFO INTEGER INFELL(JG) ENDSEGMENT SEGMENT MMAT1 REAL*8 XEL(3,NBPTEL),AEL(NBPTEL,NBPTEL) ENDSEGMENT CHARACTER*(*) NOMDUA IPCHAL = 0 C 1 - QUELQUES VERIFICATIONS SUR LES DONNEES C ============================================ MMODEL = IPMODL SEGACT,MMODEL NSOU = KMODEL(/1) C ===== C 1.1 - Verification de sources sur tout le modele C ===== MCHEL1 = IPCHSO SEGACT,MCHEL1 IF (MCHEL1.IMACHE(/1).NE.NSOU) THEN CALL ERREUR(21) GOTO 120 ENDIF C ===== C 1.2 - Verification de caracteristiques sur tout le modele C ===== C* Test effectue auparavant (cf. chal1.eso) C* IF (IPCHEB .EQ. 0) THEN C* CALL ERREUR(21) C* GOTO 120 C* ENDIF MCHEL2 = IPCHEB SEGACT,MCHEL2 IF (MCHEL2.IMACHE(/1).NE.NSOU) THEN CALL ERREUR(21) GOTO 110 ENDIF C 2 - CREATION DU MCHAML GLOBAL (RESULTAT) C ========================================== L1=18 N1=NSOU N3=6 SEGINI,MCHELM C* IFOCHE=IFOMOD IFOCHE=IFOUR TITCHE='SOURCES.VOLUMIQUES' C 3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU) C ======================================================== ITHER = 0 ITHHY = 0 DO ISOU = 1, NSOU C ===== C 3.1 - Activation du modele elementaire ISOU C ===== IMODEL = KMODEL(ISOU) SEGACT,IMODEL C* Ici, NEF = 46 (EF BARRE !) NEF = NEFMOD C* On suppose que l'on a une FORMULATION unique (cf. chaleu.eso) IF (ISOU.EQ.1) THEN NFOR = FORMOD(/2) CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE') IF (ITHER.EQ.0) & CALL PLACE(FORMOD,NFOR,ITHHY,'THERMOHYDRIQUE') ENDIF C ===== C 3.2 - Recuperation d'informations sur l'element fini du modele ISOU C ===== IF (ITHER.NE.0 .OR. ITHHY.NE.0) THEN CALL TSHAPE(NEF,'GAUSS',IPINTE) ELSE IF (INFMOD(/1).LT.5) THEN CALL ELQUOI(NEF,0,5,IPINF,IMODEL) IF (IERR.NE.0) GOTO 100 INFO = IPINF IPINTE = INFELL(11) SEGSUP,INFO ELSE IPINTE = INFMOD(5) ENDIF ENDIF C ===== C 3.2 - Recherche dans le MCHAML des sources (IPCHSO) du maillage C (IMAMOD) associe au modele elementaire ISOU, puis recuperation C du MCHAML elementaire de sources associe (MELVA1) C ===== DO i = 1, NSOU IF (MCHEL1.IMACHE(i).EQ.IMAMOD) GOTO 10 ENDDO CALL ERREUR(21) SEGSUP,MCHELM GOTO 100 10 CONTINUE MCHAM1 = MCHEL1.ICHAML(i) SEGACT,MCHAM1 MELVA1 = MCHAM1.IELVAL(1) SEGDES,MCHAM1 C ===== C 3.3 - Recherche dans le MCHMAL des caracteristiques (IPCHEB) du C maillage (IMAMOD) associe au modele elementaire ISOU, puis C recuperation du MCHAML elementaire associe (MELVA2) C ===== DO i = 1, NSOU IF (MCHEL2.IMACHE(i).EQ.IMAMOD) GOTO 20 ENDDO CALL ERREUR(21) SEGSUP,MCHELM GOTO 100 20 CONTINUE MCHAM2 = MCHEL2.ICHAML(i) SEGACT,MCHAM2 NCOELE = MCHAM2.NOMCHE(/2) CALL PLACE(MCHAM2.NOMCHE,NCOELE,IPOSI,'SECT') IF (IPOSI.EQ.0) THEN SEGDES,MCHAM2 MOTERR(1:4) = 'SECT' MOTERR(5:8) = 'CARA' CALL ERREUR(77) SEGSUP,MCHELM GOTO 100 ENDIF MELVA2 = MCHAM2.IELVAL(IPOSI) SEGDES,MCHAM2 C ===== C 3.4 - Initialisation du MCHAML des flux de chaleur nodaux equivalents C (MCHAML) associe au modele elementaire ISOU (maillage IMAMOD) C Remplissage des donnees associees a MCHAML dans MCHELM (global) C ===== N2 = 1 SEGINI,MCHAML NOMCHE(1) = NOMDUA TYPCHE(1) = 'REAL*8' IMACHE(ISOU) = IMAMOD ICHAML(ISOU) = MCHAML INFCHE(ISOU,3) = NIFOUR INFCHE(ISOU,6) = 1 C ===== C 3.6 - Calcul des flux nodaux equivalents (segment MELVAL) C ===== C 3.6.1 - Recuperation d'informations sur le maillage elementaire MELEME = IMAMOD SEGACT,MELEME NBPTEL = NUM(/1) NbElt = NUM(/2) C 3.6.2 - Recuperation d'informations sur l'element fini du maillage MINTE = IPINTE SEGACT,MINTE NBPGAU = POIGAU(/1) C* NBNO = SHPTOT(/2) C 3.6.3 - Activation du MCHAML contenant les valeurs des sources SEGACT,MELVA1 NBPTE1 = MELVA1.VELCHE(/1) NEL1 = MELVA1.VELCHE(/2) C 3.6.4 - Element fini BARRe : recuperation de la section SEGACT,MELVA2 IF (IFOMOD.NE.0 .AND. IFOMOD.NE.1) THEN iBarre = 1 iVA1 = MELVA2.VELCHE(/1) iMin1 = MIN(1,iVA1) iMin2 = MIN(2,iVA1) iVA2 = MELVA2.VELCHE(/2) ELSE iBarre = 0 SMoy = 1. ENDIF C 3.6.5 - Initialisation du segment de travail MMAT1 SEGINI,MMAT1 C 3.6.6 - Initialisation du segment resultat MELVAL des valeurs C des flux nodaux pour chaque element du maillage (IMAMOD) N1PTEL = NBPTEL N1EL = NbElt N2PTEL = 0 N2EL = 0 SEGINI,MELVAL C 3.6.7 - Boucle sur les elements du maillage elementaire IMAMOD DO iElt = 1, NbElt CALL ZERO(AEL,NBPTEL,NBPTEL) CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,iElt,XEL) IF (iBarre.EQ.1) THEN i = MIN(iElt,iVA2) SMoy = (MELVA2.VELCHE(iMin1,i)+MELVA2.VELCHE(iMin2,i))*0.5 ENDIF IF (IDIM.EQ.3) THEN DO iGau = 1, NBPGAU DLX = XZERO DLY = XZERO DLZ = XZERO DO i = 1,NBPTEL r_z = SHPTOT(2,i,iGau) DLX = DLX + r_z * XEL(1,i) DLY = DLY + r_z * XEL(2,i) DLZ = DLZ + r_z * XEL(3,i) ENDDO Volu = SMoy*SQRT(DLX*DLX+DLY*DLY+DLZ*DLZ)*POIGAU(iGau) DO i = 1, NBPTEL r_z = SHPTOT(1,i,iGau)*Volu DO j = 1, NBPTEL AEL(i,j) = AEL(i,j) + SHPTOT(1,j,iGau) * r_z ENDDO ENDDO ENDDO ELSE IF (IDIM.EQ.2) THEN DO iGau = 1, NBPGAU DLX = XZERO DLY = XZERO DO i = 1, NBPTEL r_z = SHPTOT(2,i,iGau) DLX = DLX + r_z * XEL(1,i) DLY = DLY + r_z * XEL(2,i) ENDDO Volu = SMoy*SQRT(DLX*DLX+DLY*DLY)*POIGAU(iGau) DO i = 1, NBPTEL r_z = SHPTOT(1,i,iGau)*Volu DO j = 1,NBPTEL AEL(i,j) = AEL(i,j) + SHPTOT(1,j,iGau) * r_z ENDDO ENDDO ENDDO ENDIF IEMIN = MIN(NEL1,iElt) DO i = 1, NBPTEL r_z = XZERO DO j = 1, NBPTEL k = MIN(NBPTE1,j) r_z = r_z + MELVA1.VELCHE(k,IEMIN) * AEL(j,i) ENDDO VELCHE(i,iElt) = r_z ENDDO ENDDO C 3.6.8 - Fin du traitement SEGSUP,MMAT1 SEGDES,MELEME,MINTE SEGDES,MELVAL,MELVA1,MELVA2 IF (IERR.NE.0) THEN SEGSUP,MCHELM GOTO 100 ENDIF IELVAL(1)=MELVAL SEGDES,MCHAML ENDDO C 4 - MENAGE : DESACTIVATION DE SEGMENTS C ======================================== IPCHAL = MCHELM SEGDES,MCHELM 100 DO i = 1,NSOU IMODEL = KMODEL(i) SEGDES,IMODEL ENDDO 110 SEGDES,MCHEL2 120 SEGDES,MMODEL,MCHEL1 RETURN END