Esope source files

   1 : C IFACE3    SOURCE    PV        07/10/05    21:15:53     5890           
   2 : C---------------------------------------------------------------------|         
   3 : C                                                                     |         
   4 :        FUNCTION IFACE3(IP,JP,KP)                                                
   5 : C                                                                     |         
   6 : C      CETTE SUBROUTINE RECHERCHE LA FACETTE IFC QUI CONTIENT         |         
   7 : C      LES TROIS POINTS IP, JP ET KP. CETTE FACETTE PEUT ETRE         |         
   8 : C      CARREE OU TRIANGULAIRE.                                        |         
   9 : C      - IRET=1 SI IFC EXISTE                                         |         
  10 : C      - IRET=0 SI IFC N'EXISTE PAS                                   |         
  11 : C      - IRET=-1 SI IFC a existe et n'existe plus                     |
  12 : C                                                                     |         
  13 : C---------------------------------------------------------------------|         
  14 : C                                                                               
  15 :       IMPLICIT INTEGER(I-N)
  16 :       IMPLICIT REAL*8(A-H,O-Z)
  17 : -INC TDEMAIT                                                                    
  18 : -INC CCOPTIO                                                                    
  19 : C                                                                               
  20 :        DO 100 I=1,40
  21 :           IF=NPF(I,IP)                                                          
  22 :               IF (IF.EQ.0) GOTO 130                                             
  23 :               DO 110 J=1,40
  24 :                      IF (NPF(J,JP).EQ.0) GOTO 100                               
  25 :                      IF (IF.NE.NPF(J,JP)) GOTO 110                              
  26 :                      DO 120 K=1,40
  27 :                             IF (NPF(K,KP).EQ.0) GOTO 100                        
  28 :                             IF (IF.NE.NPF(K,KP)) GOTO 120                       
  29 :                             GOTO 130                                            
  30 : 120                  CONTINUE                                                   
  31 :                 GOTO 100                                                        
  32 : 110           CONTINUE                                                          
  33 : 100    CONTINUE                                                                 
  34 :         IF=0                                                                    
  35 : 130    CONTINUE                                                                 
  36 : *       if (if.eq.0) then
  37 : *        do 200 jf=1,nfcmax
  38 : *         do 201 j=1,4
  39 : *          lp=nfc(j,jf)
  40 : *          if (lp.eq.0) goto 201
  41 : *          if (ip.ne.lp.and.jp.ne.lp.and.jp.ne.kp) goto 200
  42 : *201       continue
  43 : *          write (6,*) ' tentative de reutilisation d''une facette '
  44 : *          stop
  45 : *200      continue
  46 : *        endif
  47 :        IFACE3=IF                                                                
  48 : C      FIN DE LA SUBROUTINE FACE3                                               
  49 :        END                                                                      
  50 :  
  51 :