C CONVMA SOURCE OF166741 25/02/21 21:15:41 12166 C======================================================================= C= C O N V M A = C= ----------- = C= = C= Fonction : = C= ---------- = C= Calcul des flux nodaux equivalents a une condition de convection = C= forcee. Sousprogramme appele par CONVEC (convec.eso). = C= = C= Parametres : (E)=Entree (S)=Sortie = C= ------------ = C= IPMODE (E) Pointeur sur le segment MMODEL = C= IPCHCA (E) Pointeur sur le segment MCHELM de CARACTERISTIQUES = C= IPCHPO (E) Pointeur sur le CHPOINT contenant la temperature = C= exterieure le long de la surface de convection = C= IPCONV (S) Pointeur sur le champ des flux equivalents = C= = C= Variables locales : = C= ------------------- = C= IPGEOM Pointeur sur un MAILLAGE elementaire du CHPOINT = C= IPOGEO Pointeur sur un MAILLAGE commun au CHPOINT et au MASSIF = C= = C= Denis ROBERT, le 28 avril 1988. = C= = C= CORRECTIONS = C= CB215821 24/02/2016 : Correction d'une erreur dans les COQx = C= Mauvaise utilisation de MATMOD = C= Ajout d'une erreur 1050 = C======================================================================= SUBROUTINE CONVMA (IPMODE,IPCHCA,IPCHPO,IPCONV) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC SMCOORD -INC SMCHAML -INC SMCHPOI -INC SMMODEL -INC SMELEME -INC TMPTVAL SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT PARAMETER (NINF=3) INTEGER INFOS(NINF) CHARACTER*(NCONCH) CONM CHARACTER*(LOCOMP) MOCOMP,NOMATT,NOMCQ CHARACTER*10 PEAU LOGICAL ltelq C === C 0 - QUELQUES INITIALISATIONS ET SEGMENTS UTILES C === IPCONV=0 NBROBL = 1 NBRFAC = 0 SEGINI,nomid nomid.LESOBL(1) = 'H ' MOMATR = nomid NBTYPE=1 SEGINI,notype notype.TYPE(1) = 'REAL*8' MOTYR8 = notype C CHAMP/ELT ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES N2=1 SEGINI,MCHAM2 MCHAM2.NOMCHE(1) = ' ' MCHAM2.TYPCHE(1) = 'REAL*8' MCHAM2.IELVAL(1) = -99 IPCHAM2 = MCHAM2 L1=7 N1=1 N3=6 SEGINI,MCHEL2 MCHEL2.TITCHE ='CHALEUR' MCHEL2.IFOCHE = IFOUR C* MCHEL2.IFOCHE = IFOMOD MCHEL2.CONCHE(1) = ' ' MCHEL2.IMACHE(1) = -99 MCHEL2.ICHAML(1) = IPCHAM2 MCHEL2.INFCHE(1,3) = NIFOUR MCHEL2.INFCHE(1,4) = 0 MCHEL2.INFCHE(1,6) = 1 IPCHEL2 = MCHEL2 C 1 - QUELQUES TRANSFORMATIONS SUR LES DONNEES C ============================================== C 1.1 - Creation d'un objet MAILLAGE contenant une seule fois tous les C points du CHPOINT IPCHPO (CHPOINT ACTIF EN E/S) C (fusion des maillages supports de tous les MSOUPO) C ===== MCHPOI=IPCHPO c* SEGACT,MCHPOI MSOUPO=IPCHP(1) c* SEGACT,MSOUPO IPGEOM=IGEOC c* SEGDES,MSOUPO ltelq=.false. DO i=2,IPCHP(/1) MSOUPO=IPCHP(i) c* SEGACT,MSOUPO IGEO1=IGEOC c* SEGDES,MSOUPO CALL FUSE(IPGEOM,IGEO1,IRET,ltelq) if (ierr.ne.0) goto 100 IPGEOM=IRET ENDDO c* SEGDES,MCHPOI c* meleme=IPGEOM c* segact,meleme C ===== C 1.2 - Recuperation du MMODEL (ACTIF EN E/S) C ===== MMODEL = IPMODE c* SEGACT,MMODEL NSOUS = mmodel.KMODEL(/1) C ===== C 1.3 - Determination du support du champ de caracteristiques H C ===== CALL QUESUP(IPMODE,IPCHCA,0,0,iok,ISUPCA) IF (IERR.NE.0 .OR. iok.EQ.9999) THEN write(ioimp,*) 'CONVEC : ISUPCA incorrect' CALL ERREUR(21) goto 100 ENDIF C ======================================================== C 2 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou) C ======================================================== DO iSou= 1, NSOUS iOK = 0 ICHELS = 0 IPTEMP = 0 IVAMAT = 0 IPCHEQ = 0 C ===== C 2.1 - Analyse du sous-modele (iSou) C ===== IMODEL = KMODEL(iSou) c* SEGACT,IMODEL IPMAIL = imodel.IMAMOD CONM = imodel.CONMOD C RECUPERATION DES CARACTERISTIQUES D'INTEGRATION NEF = imodel.NEFMOD NLG = NUMGEO(NEF) CALL TSHAPE(NLG,'GAUSS',IPINTE) if (ierr.NE.0) then call erreur(251) goto 100 endif PEAU = ' ' C Formulation COQx (COQ2,COQ3,COQ4,COQ6,COQ8) IF (NEF.EQ.44 .OR. NEF.EQ.27 .OR. NEF.EQ.56 .OR. & NEF.EQ.49 .OR. NEF.EQ.41) THEN if (imodel.matmod(/2) .lt. 3) then moterr(1:4) = NOMTP(NEF) call erreur(1050) goto 100 endif PEAU = imodel.MATMOD(3) IF (PEAU .EQ. 'INFERIEURE') THEN nomatt = 'TINF' nomcq = 'QINF' ELSEIF (PEAU .EQ. 'SUPERIEURE') THEN nomatt = 'TSUP' nomcq = 'QSUP' ELSE moterr(1:8) = 'MOT ' moterr(9:16) = PEAU(1:8) call erreur(11) goto 100 ENDIF C Formulation STANDARD (pas COQx) ELSE nomatt = 'T ' nomcq = 'Q ' ENDIF C ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT C DE TEMPERATURE EXTERIEURE ET DU MAILLAGE ELEMENTAIRE IPMAIL CALL CHAME1(IPMAIL,0,IPCHPO,' ',ICHELS,ISUPCA) if (ierr.ne.0) GOTO 10 MCHEL1 = ICHELS c* SEGACT,MCHEL1 MCHAM1 = MCHEL1.ICHAML(1) c* SEGACT,MCHAM1 C Recherche de la bonne composante (meme s'il n'y en a qu'une) ivfr = 0 DO i = 1, mcham1.ielval(/1) IF (mcham1.NOMCHE(i)(1:4).EQ.nomatt) ivfr=i ENDDO IF (ivfr.EQ.0) THEN MOTERR(1:4) = nomatt MOTERR(5:30) = 'de TEMPERATURE exterieure' CALL ERREUR(77) GOTO 10 ENDIF IPTEMP = mcham1.IELVAL(ivfr) C RECUPERATION DU COEFFICIENT D'ECHANGE C ON GENERE UN CHAMELEM ELEMENTAIRE DE CARACTERISTIQUES ET C DU MAILLAGE ELEMENTAIRE IPMAIL CALL IDENT(IPMAIL,CONM,IPCHCA,0,INFOS,IOK) CALL KOMCHA(IPCHCA,IPMAIL,CONM,MOMATR,MOTYR8,1,INFOS,3,IVAMAT) if (ierr .ne. 0) goto 10 MPTVAL = IVAMAT if (mptval.ival(/1) .lt. 1) then call erreur(472) goto 10 endif IPCOEF = mptval.IVAL(1) C CALCUL DES FLUX NODAUX EQUIVALENTS IF (NLG.EQ.1) THEN CALL INTCN0(IPTEMP,IPCOEF,IPMAIL,IPINTE,IPCHEQ) ELSE IF (NLG.EQ.2.OR.NLG.EQ.3) THEN CALL INTCN1(IPTEMP,IPCOEF,IPMAIL,IPINTE,IPCHEQ) ELSE IF (NLG.EQ.4.OR.NLG.EQ.6.OR.NLG.EQ.8.OR. & NLG.EQ.10) THEN CALL INTCN2(IPTEMP,IPCOEF,IPMAIL,IPINTE,IPCHEQ) ENDIF IF (ierr.ne.0) goto 10 C CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES MCHEL2 = IPCHEL2 c* segact,mchel2*mod MCHEL2.IMACHE(1) = IPMAIL MCHEL2.CONCHE(1) = CONM C* MCHEL2.INFCHE(1,4) = IPINTE C* MCHEL2.INFCHE(1,6) = 6 MCHAM2 = IPCHAM2 c* segact,mcham2*mod MCHAM2.NOMCHE(1) = nomcq MCHAM2.IELVAL(1) = IPCHEQ C ON TRANSFORME LE CHAMELEM EN CHPOINT CALL CHAMPO(IPCHEL2,0,IPCHP1,idum) if (ierr.ne.0) goto 10 C ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS IF (iSou.GT.1) THEN CALL ADCHPO(IPCHP1,IPCONV,IPCRET,1.D0,1.D0) CALL DTCHPO(IPCHP1) CALL DTCHPO(IPCONV) IF (IPCRET.EQ.0) GOTO 10 IPCONV=IPCRET ELSE IPCONV=IPCHP1 ENDIF c* ? interet CALL ACTOBJ('CHPOINT ',IPCONV,1) iOK=1 10 continue c* iptemp peut provenir d'un preconditionnement : donc a ne pas detruire c* if (iptemp.ne.0) then c* melval = iptemp c* segsup,melval c* endif c* ichels peut provenir d'un preconditionnement : donc a ne pas detruire c* if (ichels.ne.0) then c* mchel1 = ichels c* segsup,mchel1 c* endif if (ipcheq.ne.0) then melval = ipcheq segsup,melval endif if (ivamat.ne.0) then mptval = ivamat segsup,mptval endif IF (iOK.EQ.0) GOTO 100 ENDDO C ============================= C 2 - FIN DE LA BOUCLE (iSou) C ============================= C Menage final 100 CONTINUE nomid = MOMATR SEGSUP,nomid notype = MOTYR8 SEGSUP,notype mchaml = IPCHAM2 mchelm = IPCHEL2 SEGSUP,mchaml,mchelm c return END