C FRON1 SOURCE FANDEUR 22/03/01 21:15:04 11301 SUBROUTINE FRON1 C C FONCTION: TRAITEMENT DE LA COMBUSTION DANS CASTEM2000 C C CHPT2 = COMBU CHPT1 CHPV DT T ; C CHPT2 : instant de debut de combustion calcule pour t + dt C CHPT1 : instant de debut de combustion calcule pour t C CHPV : vitesse d'avance et durée de combustion C T : instant t C DT : pas de temps C C A de Gayffier c 12/12/94 C C FORTRAN + ESOPE IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) LOGICAL FLAG1 -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMCOORD -INC SMELEME PARAMETER(GRAND=1.D50) C C recuperation des objets C * print *,'Segments actifs',oooval(2,3) * print *,'Total segments',oooval(2,1) CALL LIROBJ('CHPOINT ',ICHPO1,1,IRETOU) CALL ACTOBJ('CHPOINT ',ICHPO1,1) IF (IERR .NE. 0) RETURN CALL LIROBJ('CHPOINT',ICHPO2,1,IRETOU) CALL ACTOBJ('CHPOINT ',ICHPO2,1) IF (IERR .NE. 0) RETURN CALL LIRREE(TEMPS1,1,IRETOU) IF (IERR .NE. 0) RETURN CALL LIRREE(DTEMPS,1,IRETOU) IF (IERR .NE. 0) RETURN SEGACT,MCOORD C C on assemble les deux champs par point lus C 40 CONTINUE FLAG1 = .FALSE. CALL ADCHPO(ICHPO1,ICHPO2,ICHPO,1.D0,1.D0) IF (IERR .NE. 0) RETURN MCHPO1 = ICHPO1 MCHPO2 = ICHPO2 C C on cree l'ensemble des points tels que CHP1(P) < t+dt C et ceux tels que CHP1(P) < min(t,t+dt-tcombustion) C MCHPOI = ICHPO NPTOT = 0 DO 50 K=1,IPCHP(/1) MSOUPO = IPCHP(K) MELEME = IGEOC NPTOT = NPTOT + NUM(/2) 50 CONTINUE C TEMPS2 = DTEMPS + TEMPS1 C C on cree trois maillages qui contiennent les points C des trois ensemble C NBNN = 1 NBELEM = NPTOT NBSOUS = 0 NBREF = 0 SEGINI IPT1,IPT2,IPT3 C C on cree trois MPOVAL pour stocker les valeurs en chaque point C N=NPTOT NC=2 SEGINI MPOVA1,MPOVA2,MPOVA3 C 60 CONTINUE IND1 = 0 IND2 = 0 IND3 = 0 C C boucle sur les msoupo C DO 150 K=1,IPCHP(/1) MSOUPO = IPCHP(K) MELEME = IGEOC MPOVAL = IPOVAL C on numerote les composantes 'VIT' TCMB' 'TPS' IF ( NOCOMP(/2) .NE. 3 ) THEN CALL ERREUR(665) RETURN ENDIF DO 70 I=1,NOCOMP(/2) IF (NOCOMP(I) .EQ. 'VIT' ) THEN IVIT = I ELSE IF (NOCOMP(I) .EQ. 'TCMB') THEN ITCMB = I ELSE IF (NOCOMP(I) .EQ. 'TPS') THEN ITEMPS =I ELSE CALL ERREUR(665) SEGSUP IPT1,IPT2,IPT3,MPOVA1,MPOVA2,MPOVA3 RETURN ENDIF 70 CONTINUE C C on remplit mpova1,2,3 et ipt1,2,3 C C DO 100 I=1,VPOCHA(/1) BINF = MIN(TEMPS1,TEMPS2-VPOCHA(I,ITCMB)) C IF (VPOCHA(I,1) .LE. TEMPS2 .AND. & VPOCHA(I,1) .GE. BINF ) THEN c le point est en combustion IND1 = IND1 + 1 IPT1.NUM(1,IND1)=NUM(1,I) MPOVA1.VPOCHA(IND1,1)=VPOCHA(I,ITEMPS) MPOVA1.VPOCHA(IND1,2)=VPOCHA(I,IVIT) C ELSE IF (VPOCHA(I,1) .GT. TEMPS2 ) THEN c le point n'a pas brule IND2 = IND2 + 1 IPT2.NUM(1,IND2)=NUM(1,I) MPOVA2.VPOCHA(IND2,1)=GRAND MPOVA2.VPOCHA(IND2,2)=VPOCHA(I,IVIT) C ELSE c le point a deja brulé IND3 = IND3 + 1 IPT3.NUM(1,IND3)=NUM(1,I) MPOVA3.VPOCHA(IND3,1)=VPOCHA(I,ITEMPS) ENDIF 100 CONTINUE 150 CONTINUE C C ici on controle que ind1 n'est pas nul C IF (IND1 .EQ. 0) THEN C dans ce cas on agrandit la fenetre TEMPS1 = TEMPS1 - DTEMPS GOTO 60 ENDIF C IF ((IND1+IND2+IND3) .NE. NPTOT) THEN SEGSUP IPT1,IPT2,IPT3,MPOVA1,MPOVA2,MPOVA3 CALL ERREUR(5) RETURN ENDIF C C boucle sur les points de ipt2 C DO 300 I=1,IND2 IM = IPT2.NUM(1,I) XM = XCOOR((IM-1)*(IDIM+1) +1) YM = XCOOR((IM-1)*(IDIM+1) +2) ZM = XCOOR((IM-1)*(IDIM+1) +3) * (IDIM - 2) DO 200 J=1,IND1 IP = IPT1.NUM(1,J) XP = XCOOR((IP-1)*(IDIM+1) +1) YP = XCOOR((IP-1)*(IDIM+1) +2) ZP = XCOOR((IP-1)*(IDIM+1) +3) * (IDIM - 2) DPM = SQRT( (XM-XP)*(XM-XP)+(YM-YP)*(YM-YP) + & (ZM-ZP)*(ZM-ZP)) VPM = (MPOVA1.VPOCHA(J,2) + MPOVA2.VPOCHA(I,2))/2.D0 TM2 = MPOVA1.VPOCHA(J,1)+ DPM / VPM MPOVA2.VPOCHA(I,1) = MIN(MPOVA2.VPOCHA(I,1),TM2) 200 CONTINUE IF (MPOVA2.VPOCHA(I,1) .LT. TEMPS2) FLAG1 = .TRUE. C le resultat n'est pas consistent C ca veut dire qu'il va falloir recommencer 300 CONTINUE C C on remplit le resultat dans le chpo resultat C C creation NAT=1 NSOUPO=1 SEGINI ,MCHPO1 MCHPO1.JATTRI(1)=1 MCHPO1.MOCHDE='Temps d allumage du point cree par FRON' MCHPO1.MTYPOI=mchpoi.MTYPOI MCHPO1.IFOPOI=mchpoi.IFOPOI c* MCHPO1.IFOPOI=IFOUR ICHPO1 = MCHPO1 C NC = 1 SEGINI ,MSOUP1 MCHPO1.IPCHP(1)=MSOUP1 MSOUP1.NOCOMP(1)='TPS' C NC = 1 N = IND1 + IND2 + IND3 SEGINI MPOVA4 MSOUP1.IPOVAL = MPOVA4 C NBNN = 1 NBELEM = IND1 + IND2 + IND3 NBSOUS = 0 NBREF = 0 SEGINI ,IPT4 IPT4.ITYPEL = 1 MSOUP1.IGEOC = IPT4 C C remplissage C DO 600 I=1,IND3 IPT4.NUM(1,I)=IPT3.NUM(1,I) MPOVA4.VPOCHA(I,1)= MPOVA3.VPOCHA(I,1) 600 CONTINUE C DO 400 I=1,IND1 IPT4.NUM(1,I+IND3)=IPT1.NUM(1,I) MPOVA4.VPOCHA(I+IND3,1)= MPOVA1.VPOCHA(I,1) 400 CONTINUE C DO 500 I=1,IND2 IPT4.NUM(1,I+IND1+IND3)=IPT2.NUM(1,I) MPOVA4.VPOCHA(I+IND1+IND3,1)= MPOVA2.VPOCHA(I,1) 500 CONTINUE C C gestion des segments C DO 700 I=1,IPCHP(/1) MSOUPO = IPCHP(I) MPOVAL = IPOVAL SEGSUP ,MSOUPO,MPOVAL 700 CONTINUE C SEGSUP MCHPOI SEGSUP IPT1,IPT2,IPT3 SEGSUP MPOVA1,MPOVA2,MPOVA3 C C IF ( FLAG1 ) THEN C le chpo trouvé n'est pas consistent GOTO 40 ENDIF C ICHPO1 = MCHPO1 CALL ECROBJ('CHPOINT',ICHPO1) SEGDES,MCOORD * print *,'Segments actifs',oooval(2,3) * print *,'Total segments',oooval(2,1) c RETURN END