Sources Esope | Cast3M

fron1
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) &lt; t+dt
C  et ceux tels que     CHP1(P) &lt; 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