Numérotation des lignes :

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 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.) RETURNC  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      endifCC      RECHERCHE DU TYPE DES FACETTESC      ------------------------------       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       ENDIFC  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

© Cast3M 2003 - Tous droits réservés.
Mentions légales