Esope source files

   1 : C COMBL3    SOURCE    PV        07/10/05    21:15:17     5890           
   2 : C---------------------------------------------------------------------|         
   3 : C                                                                     |         
   4 :        SUBROUTINE COMBL3(II,IF1,IF2,IF3,IGAGNE)                                 
   5 : C                                                                     |         
   6 : C      CETTE SUBROUTINE TENTE DE REMPLIR LE COIN EN RAJOUTANT UN      |         
   7 : C      POINT AU MILIEU                                                |         
   8 : C                                                                     |         
   9 : C---------------------------------------------------------------------|         
  10 : C                                                                               
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8(A-H,O-Z)
  13 : -INC CCOPTIO                                                                    
  14 : -INC TDEMAIT                                                                    
  15 :       DIMENSION IIF4(3),IIF3(3)                                                 
  16 : *       WRITE(6,5000)
  17 :  5000   FORMAT(' COMBL3 ( supprime ) ')
  18 : C  VERIFICATION DES ANGLES ( 0› 130›)                                           
  19 :       ANG=TETA(IF1,IF2,II,ISUCC(IF1,II))                                        
  20 :       IF (ANG.LT.-5.) RETURN                                                    
  21 :       ANG=TETA(IF2,IF3,II,ISUCC(IF2,II))                                        
  22 :       IF (ANG.LT.-5.) RETURN                                                    
  23 :       ANG=TETA(IF3,IF1,II,ISUCC(IF3,II))                                        
  24 :       IF (ANG.LT.-5.) RETURN                                                    
  25 : C  verification que les facettes sont bien comme on croit
  26 :       if (noisin(ii,isucc(if1,ii),if1).ne.if2) then
  27 :         write (6,*) ' souci dans combl3 '
  28 :         return
  29 :       endif
  30 :       if (noisin(ii,isucc(if2,ii),if2).ne.if3) then
  31 :         write (6,*) ' souci dans combl3 '
  32 :         return
  33 :       endif
  34 :       if (noisin(ii,isucc(if3,ii),if3).ne.if1) then
  35 :         write (6,*) ' souci dans combl3 '
  36 :         return
  37 :       endif
  38 : C                                                                               
  39 : C      RECHERCHE DU TYPE DES FACETTES                                           
  40 : C      ------------------------------                                           
  41 :        DO 10 I=1,3                                                              
  42 :            IIF4(I)=0                                                            
  43 :            IIF3(I)=0                                                            
  44 :   10    CONTINUE                                                                
  45 :        I4=0                                                                     
  46 :        I3=0                                                                     
  47 :        IF (NFC(4,IF1).NE.0) THEN                                                
  48 :         I4=I4+1                                                                 
  49 :         IIF4(I4)=IF1                                                            
  50 :        ELSE                                                                     
  51 :         I3=I3+1                                                                 
  52 :         IIF3(I3)=IF1                                                            
  53 :        ENDIF                                                                    
  54 :        IF (NFC(4,IF2).NE.0) THEN                                                
  55 :         I4=I4+1                                                                 
  56 :         IIF4(I4)=IF2                                                            
  57 :        ELSE                                                                     
  58 :         I3=I3+1                                                                 
  59 :         IIF3(I3)=IF2                                                            
  60 :        ENDIF                                                                    
  61 :        IF (NFC(4,IF3).NE.0) THEN                                                
  62 :         I4=I4+1                                                                 
  63 :         IIF4(I4)=IF3                                                            
  64 :        ELSE                                                                     
  65 :         I3=I3+1                                                                 
  66 :         IIF3(I3)=IF3                                                            
  67 :        ENDIF                                                                    
  68 : C  LE PREMIER CAS EST TRAITE AILLEURS ==> TETRAEDRE                             
  69 : *      WRITE (6,*) ' COMBLE  I4 ',I4
  70 :        IF (I4.LE.0) RETURN                                                      
  71 : *      IF (I4.EQ.1)
  72 : *    #  WRITE (6,*) ' APPEL COM433 AVEC ',IIF4(1),IIF3(1),IIF3(2)
  72 :        IF (I4.EQ.1) CALL COM433(II,IIF4(1),IIF3(1),IIF3(2),IGAGNE)              
  73 : *      IF (I4.EQ.2)
  74 : *    #  WRITE (6,*) ' APPEL COM443 AVEC ',IIF4(1),IIF4(2),IIF3(1)
  74 :        IF (I4.EQ.2) CALL COM443(II,IIF4(1),IIF4(2),IIF3(1),IGAGNE)
  75 : *      IF (I4.EQ.3)
  76 : *    #  WRITE (6,*) ' APPEL COM444 AVEC ',IIF4(1),IIF4(2),IIF4(3)
  76 :         IF (I4.EQ.3) CALL COM444(II,IIF4(1),IIF4(2),IIF4(3),IGAGNE)
  77 :       RETURN                                                                    
  78 :       END                                                                       
  79 :  
  80 :