Sources Esope | Cast3M

combl3
C COMBL3    SOURCE    JC220346  16/11/29    21:15:07     9221           
C---------------------------------------------------------------------|
C                                                                     |
       SUBROUTINE COMBL3(II,IF1,IF2,IF3,IGAGNE)
C                                                                     |
C      CETTE SUBROUTINE TENTE DE REMPLIR LE COIN EN RAJOUTANT UN      |
C      POINT AU MILIEU                                                |
C                                                                     |
C---------------------------------------------------------------------|
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC TDEMAIT
      DIMENSION IIF4(3),IIF3(3)
*       WRITE(6,5000)
 5000   FORMAT(' COMBL3 ( supprime ) ')
C  VERIFICATION DES ANGLES ( 0 130)
      ANG=TETA(IF1,IF2,II,ISUCC(IF1,II))
      IF (ANG.LT.-5.) RETURN
      ANG=TETA(IF2,IF3,II,ISUCC(IF2,II))
      IF (ANG.LT.-5.) RETURN
      ANG=TETA(IF3,IF1,II,ISUCC(IF3,II))
      IF (ANG.LT.-5.) RETURN
C  verification que les facettes sont bien comme on croit
      if (noisin(ii,isucc(if1,ii),if1).ne.if2) then
        IF (IVERB.EQ.1) write (6,*) ' souci dans combl3 '
        return
      endif
      if (noisin(ii,isucc(if2,ii),if2).ne.if3) then
        IF (IVERB.EQ.1) write (6,*) ' souci dans combl3 '
        return
      endif
      if (noisin(ii,isucc(if3,ii),if3).ne.if1) then
        IF (IVERB.EQ.1) write (6,*) ' souci dans combl3 '
        return
      endif
C
C      RECHERCHE DU TYPE DES FACETTES
C      ------------------------------
       DO 10 I=1,3
           IIF4(I)=0
           IIF3(I)=0
  10    CONTINUE
       I4=0
       I3=0
       IF (NFC(4,IF1).NE.0) THEN
        I4=I4+1
        IIF4(I4)=IF1
       ELSE
        I3=I3+1
        IIF3(I3)=IF1
       ENDIF
       IF (NFC(4,IF2).NE.0) THEN
        I4=I4+1
        IIF4(I4)=IF2
       ELSE
        I3=I3+1
        IIF3(I3)=IF2
       ENDIF
       IF (NFC(4,IF3).NE.0) THEN
        I4=I4+1
        IIF4(I4)=IF3
       ELSE
        I3=I3+1
        IIF3(I3)=IF3
       ENDIF
C  LE PREMIER CAS EST TRAITE AILLEURS ==> TETRAEDRE
*      WRITE (6,*) ' COMBLE  I4 ',I4
       IF (I4.LE.0) RETURN
*      IF (I4.EQ.1)
*    #  WRITE (6,*) ' APPEL COM433 AVEC ',IIF4(1),IIF3(1),IIF3(2)
       IF (I4.EQ.1) CALL COM433(II,IIF4(1),IIF3(1),IIF3(2),IGAGNE)
*      IF (I4.EQ.2)
*    #  WRITE (6,*) ' APPEL COM443 AVEC ',IIF4(1),IIF4(2),IIF3(1)
       IF (I4.EQ.2) CALL COM443(II,IIF4(1),IIF4(2),IIF3(1),IGAGNE)
*      IF (I4.EQ.3)
*    #  WRITE (6,*) ' APPEL COM444 AVEC ',IIF4(1),IIF4(2),IIF4(3)
        IF (I4.EQ.3) CALL COM444(II,IIF4(1),IIF4(2),IIF4(3),IGAGNE)
      RETURN
      END