Esope source files

   1 : C FRON1     SOURCE    CHAT      05/01/13    00:09:10     5004           
   2 :       SUBROUTINE  FRON1
   3 : C
   4 : C  FONCTION: TRAITEMENT DE LA COMBUSTION DANS CASTEM2000
   5 : C 
   6 : C        CHPT2 = COMBU CHPT1 CHPV DT T ;
   7 : C        CHPT2 : instant de debut de combustion calcule pour t + dt
   8 : C        CHPT1 : instant de debut de combustion calcule pour t
   9 : C        CHPV  : vitesse d'avance et durée de combustion
  10 : C        T     : instant t 
  11 : C        DT    : pas de temps
  12 : C
  13 : C
  14 : C A de Gayffier
  15 : c  12/12/94
  16 : C
  17 : C FORTRAN + ESOPE
  18 :       IMPLICIT INTEGER(I-N)
  19 :       IMPLICIT REAL*8 (A-H,O-Z)
  20 :       LOGICAL FLAG1
  21 : *      INTEGER OOOVAL
  22 : -INC SMCHPOI
  23 : -INC CCOPTIO
  24 : -INC SMCOORD
  25 : -INC SMELEME
  26 :       PARAMETER(GRAND=1.D50)
  27 : C
  28 : C  recuperation des objets
  29 : C
  30 : *       print *,'Segments actifs',oooval(2,3)
  31 : *       print *,'Total segments',oooval(2,1)
  31 :       CALL LIROBJ('CHPOINT',ICHPO1,1,IRETOU)
  32 :       IF (IERR .NE. 0) RETURN
  32 :       CALL LIROBJ('CHPOINT',ICHPO2,1,IRETOU)
  33 :       IF (IERR .NE. 0) RETURN
  33 :       CALL LIRREE(TEMPS1,1,IRETOU)
  34 :       IF (IERR .NE. 0) RETURN
  34 :       CALL LIRREE(DTEMPS,1,IRETOU)
  35 :       IF (IERR .NE. 0) RETURN
  36 : C
  37 : C  on assemble les deux champs par point lus
  38 : C
  39 :  40   FLAG1 = .FALSE.
  39 :       CALL ADCHPO(ICHPO1,ICHPO2,ICHPO,1.D0,1.D0)
  40 :       MCHPO1 = ICHPO1
  41 :       MCHPO2 = ICHPO2
  42 :       SEGDES MCHPO2,MCHPO1
  43 :       IF (IERR .NE. 0) RETURN
  44 : C
  45 : C  on cree l'ensemble des points tels que CHP1(P) < t+dt
  46 : C  et ceux tels que     CHP1(P) < min(t,t+dt-tcombustion)
  47 : C  
  48 :       MCHPOI = ICHPO      
  49 :       SEGACT MCHPOI*MOD
  50 :       NPTOT = 0
  51 :       DO 50 K=1,IPCHP(/1)
  52 :         MSOUPO = IPCHP(K)
  53 :         SEGACT MSOUPO 
  54 :         MELEME = IGEOC
  55 :         MPOVAL = IPOVAL
  56 :         SEGACT MELEME*MOD,MPOVAL
  57 :         NPTOT = NPTOT + NUM(/2)
  58 :   50  CONTINUE
  59 : C
  60 :       TEMPS2 = DTEMPS + TEMPS1      
  61 : C
  62 : C     on cree trois maillages qui contiennent les points
  63 : C     des trois ensemble
  64 : C
  65 :       NBNN = 1
  66 :       NBELEM = NPTOT
  67 :       NBSOUS = 0
  68 :       NBREF = 0
  69 :       SEGINI IPT1,IPT2,IPT3
  70 : C
  71 : C  on cree trois MPOVAL pour stocker les valeurs en chaque point 
  72 : C
  73 :       N=NPTOT
  74 :       NC=2
  75 :       SEGINI MPOVA1,MPOVA2,MPOVA3
  76 : C
  77 :  60   CONTINUE 
  78 :       IND1 = 0
  79 :       IND2 = 0
  80 :       IND3 = 0
  81 : C
  82 : C  boucle sur les msoupo
  83 : C
  84 :       DO 150 K=1,IPCHP(/1)
  85 : C
  86 :         MSOUPO = IPCHP(K)
  87 :         MELEME = IGEOC
  88 :         MPOVAL = IPOVAL  
  89 : C      on numerote les composantes 'VIT' TCMB' 'TPS'
  90 :         IF ( NOCOMP(/2) .NE. 3 ) THEN
  90 :             CALL ERREUR(665)
  91 :             RETURN
  92 :         ENDIF
  93 :         DO 70 I=1,NOCOMP(/2)
  94 :           IF (NOCOMP(I) .EQ. 'VIT' ) THEN
  95 :              IVIT = I
  96 :           ELSE IF (NOCOMP(I) .EQ. 'TCMB') THEN
  97 :              ITCMB = I
  98 :           ELSE IF (NOCOMP(I) .EQ. 'TPS') THEN 
  99 :              ITEMPS =I
 100 :           ELSE 
 100 :              CALL ERREUR(665)
 101 :              SEGSUP IPT1,IPT2,IPT3,MPOVA1,MPOVA2,MPOVA3
 102 :              SEGDES MSOUPO,MELEME,MPOVAL,MCHPOI
 103 :              RETURN
 104 :           ENDIF
 105 :  70     CONTINUE
 106 : C
 107 : C    on remplit mpova1,2,3 et ipt1,2,3 
 108 : C
 109 : C
 110 :       DO 100 I=1,VPOCHA(/1)
 111 :           BINF = MIN(TEMPS1,TEMPS2-VPOCHA(I,ITCMB))
 112 : C
 113 :           IF (VPOCHA(I,1) .LE. TEMPS2 .AND.
 114 :      &        VPOCHA(I,1) .GE. BINF  ) THEN
 115 : c         le point est en combustion
 116 :            IND1 = IND1 + 1
 117 :            IPT1.NUM(1,IND1)=NUM(1,I)
 118 :            MPOVA1.VPOCHA(IND1,1)=VPOCHA(I,ITEMPS)
 119 :            MPOVA1.VPOCHA(IND1,2)=VPOCHA(I,IVIT)
 120 : C
 121 :           ELSE IF (VPOCHA(I,1) .GT. TEMPS2 ) THEN 
 122 : c          le point n'a pas brule 
 123 :            IND2 = IND2 + 1
 124 :            IPT2.NUM(1,IND2)=NUM(1,I)    
 125 :            MPOVA2.VPOCHA(IND2,1)=GRAND
 126 :            MPOVA2.VPOCHA(IND2,2)=VPOCHA(I,IVIT)
 127 : C
 128 :           ELSE
 129 : c           le point a deja brulé 
 130 :             IND3 = IND3 + 1
 131 :             IPT3.NUM(1,IND3)=NUM(1,I)    
 132 :             MPOVA3.VPOCHA(IND3,1)=VPOCHA(I,ITEMPS)
 133 :           ENDIF      
 134 :  100    CONTINUE   
 135 :  150  CONTINUE
 136 : C
 137 : C    ici on controle que ind1  n'est pas nul
 138 : C
 139 :       IF (IND1 .EQ. 0) THEN
 140 : C       dans ce cas on agrandi la fenetre 
 141 :            TEMPS1 = TEMPS1 - DTEMPS
 142 :            GOTO 60
 143 :       ENDIF
 144 : C
 145 :       IF ((IND1+IND2+IND3) .NE. NPTOT) THEN
 146 :            SEGSUP IPT1,IPT2,IPT3,MPOVA1,MPOVA2,MPOVA3
 147 :            SEGDES MSOUPO,MELEME,MPOVAL,MCHPOI
 147 :            CALL ERREUR(5)
 148 :            RETURN
 149 :       ENDIF
 150 : C
 151 : C   boucle sur les points de ipt2
 152 : C
 153 :       DO 300 I=1,IND2
 154 :          IM = IPT2.NUM(1,I)
 155 :          XM = XCOOR((IM-1)*(IDIM+1) +1)
 156 :          YM = XCOOR((IM-1)*(IDIM+1) +2)
 157 :          ZM = XCOOR((IM-1)*(IDIM+1) +3) * (IDIM - 2)
 158 : 
 159 :          DO 200 J=1,IND1
 160 :            IP = IPT1.NUM(1,J)
 161 :            XP = XCOOR((IP-1)*(IDIM+1) +1)
 162 :            YP = XCOOR((IP-1)*(IDIM+1) +2)
 163 :            ZP = XCOOR((IP-1)*(IDIM+1) +3) * (IDIM - 2)
 164 :            DPM = SQRT( (XM-XP)*(XM-XP)+(YM-YP)*(YM-YP) +
 165 :      &                (ZM-ZP)*(ZM-ZP))
 166 :            VPM = (MPOVA1.VPOCHA(J,2) + MPOVA2.VPOCHA(I,2))/2.D0
 167 :            TM2 = MPOVA1.VPOCHA(J,1)+ DPM / VPM
 168 :            MPOVA2.VPOCHA(I,1) = MIN(MPOVA2.VPOCHA(I,1),TM2)
 169 :  200     CONTINUE
 170 :            IF (MPOVA2.VPOCHA(I,1) .LT. TEMPS2) FLAG1 = .TRUE.
 171 : C          le resultat n'est pas consistent 
 172 : C          ca veut dire qu'il va falloir recommencer
 173 :  300  CONTINUE
 174 : C
 175 : C on rempli le resultat dans le chpo resultat
 176 : C
 177 : C  creation
 178 :            NAT=1
 179 :            NSOUPO=1
 180 :            SEGINI ,MCHPO1
 181 :            MCHPO1.JATTRI(1)=1
 182 :            MCHPO1.MOCHDE='Temps d allumage du point cree par FRON'
 183 :            IFOPOI = (IDIM-2)*3 + 1
 184 :            ICHPO1 = MCHPO1
 185 : C
 186 :            NC = 1
 187 :            SEGINI ,MSOUP1
 188 :            MCHPO1.IPCHP(1)=MSOUP1
 189 :            MSOUP1.NOCOMP(1)='TPS'
 190 : C
 191 :            NC = 1
 192 :            N = IND1 + IND2 + IND3
 193 :            SEGINI MPOVA4
 194 :            MSOUP1.IPOVAL = MPOVA4
 195 : C
 196 :            NBNN = 1
 197 :            NBELEM = IND1 + IND2 + IND3
 198 :            NBSOUS = 0
 199 :            NBREF = 0 
 200 :            SEGINI ,IPT4
 201 :            ITYPEL = 1
 202 :            MSOUP1.IGEOC = IPT4
 203 : C
 204 : C    remplissage
 205 : C
 206 :            DO 600 I=1,IND3
 207 :               IPT4.NUM(1,I)=IPT3.NUM(1,I)
 208 :               MPOVA4.VPOCHA(I,1)= MPOVA3.VPOCHA(I,1)
 209 :   600      CONTINUE
 210 : C
 211 :            DO 400 I=1,IND1
 212 :               IPT4.NUM(1,I+IND3)=IPT1.NUM(1,I)
 213 :               MPOVA4.VPOCHA(I+IND3,1)= MPOVA1.VPOCHA(I,1)
 214 :   400      CONTINUE
 215 : C
 216 :            DO 500 I=1,IND2
 217 :               IPT4.NUM(1,I+IND1+IND3)=IPT2.NUM(1,I)
 218 :               MPOVA4.VPOCHA(I+IND1+IND3,1)= MPOVA2.VPOCHA(I,1)
 219 :   500      CONTINUE
 220 : C
 221 : C    gestion des segments
 222 : C
 223 :       DO 700 I=1,IPCHP(/1) 
 224 :           MSOUPO = IPCHP(I)
 225 :           MPOVAL = IPOVAL
 226 :           MELEME = IGEOC
 227 :           SEGDES MELEME
 228 :           SEGSUP ,MSOUPO,MPOVAL
 229 :  700  CONTINUE
 230 : C
 231 :       SEGSUP MCHPOI
 232 :       SEGDES MCHPO1,MSOUP1,MPOVA4,IPT4
 233 :       SEGSUP IPT1,IPT2,IPT3
 234 :       SEGSUP MPOVA1,MPOVA2,MPOVA3
 235 : C
 236 : C 
 237 :       IF ( FLAG1 ) THEN
 238 : C      le chpo trouvé n'est pas consistent
 239 :          GOTO 40
 240 :       ENDIF
 241 : C
 242 :       ICHPO1 = MCHPO1
 242 :       CALL ECROBJ('CHPOINT',ICHPO1)
 243 : *      print *,'Segments actifs',oooval(2,3)
 244 : *      print *,'Total segments',oooval(2,1)
 245 :       RETURN
 246 :       END
 247 : 
 248 :  
 249 :