+c MEFISTO : library to compute 2D triangulation from segmented boundaries
+c
+c Copyright (C) 2003 Laboratoire J.-L. Lions UPMC Paris
+c
+c This library is free software; you can redistribute it and/or
+c modify it under the terms of the GNU Lesser General Public
+c License as published by the Free Software Foundation; either
+c version 2.1 of the License.
+c
+c This library is distributed in the hope that it will be useful,
+c but WITHOUT ANY WARRANTY; without even the implied warranty of
+c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+c Lesser General Public License for more details.
+c
+c You should have received a copy of the GNU Lesser General Public
+c License along with this library; if not, write to the Free Software
+c Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+c
+c See http://www.ann.jussieu.fr/~perronne or email Perronnet@ann.jussieu.fr
+c
+c
+c File : trte.f
+c Module : SMESH
+c Author: Alain PERRONNET
+
subroutine qutr2d( p1, p2, p3, qualite )
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c but : calculer la qualite d'un triangle de r**2
if( narete .le. 0 ) then
c erreur: le point appartient a aucune arete
write(imprim,*) 'sommet ',ns,' dans aucune arete'
- pause
ierr = 11
return
endif
c
else if( nbar .le. 2 ) then
write(imprim,*) 'erreur trchtd: cf<3 aretes'
- pause
namin = 0
namin0 = 0
return
c anomalie. chainage des triangles des aretes defectueux
c a corriger
write(imprim,*) 'pause dans tridcf'
- pause
ierr = 5
return
endif
10 continue
c impossible d'arriver ici sans bogue!
write(imprim,*) 'pause dans te2t2t 1'
- pause
c
c l'arete de sommets 2 et 3
15 if( n1 .lt. 3 ) then
20 continue
c impossible d'arriver ici sans bogue!
write(imprim,*) 'pause dans te2t2t 2'
- pause
c
c l'arete de sommets 1 et 4
25 if( n1 .lt. 3 ) then
c
c erreur: le point np n'est pas dans l'un des nbtr triangles
write(imprim,10010) np
- pause
ierr = 3
return
c
% ' st2=',nosoar(2,noar),' ligne=',nosoar(3,noar),
% ' tr1=',nosoar(4,noar),' tr2=',nosoar(5,noar)
write(imprim,*) 'chainages=',(nosoar(i,noar),i=6,mosoar)
- pause
c l'arete n'est pas detruite
return
c
write(imprim,*)'tefoar:arete ',ns1,' - ',ns2,' a imposer'
write(imprim,*)'tefoar:anomalie sommet ',ns1,
% 'non dans le triangle de sommets ',(nosotr(i),i=1,3)
- pause
ierr = 11
return
endif
c point utilisateur ou frontalier non supprimable
ierr = 11
write(imprim,*) 'pause dans tefoar 1', d, d3, d4, d12
- pause
return
endif
c
ccc tratri = .false.
ierr = 11
write(imprim,*) 'pause dans tefoar 2'
- pause
return
endif
c
c
write(imprim,*) 'tefoar: algorithme defaillant'
ierr = 11
- pause
return
endif
50 continue
write(imprim,*) 'les lignes fermees doivent etre disjointes'
write(imprim,*) 'verifiez si elles ne se coupent pas'
ierr = 13
- pause
return
c
c cas sans probleme : intersection differente de celle initiale