X-Git-Url: http://git.salome-platform.org/gitweb/?a=blobdiff_plain;f=src%2Ftool%2FUtilitaire%2Futtfi2.F;fp=src%2Ftool%2FUtilitaire%2Futtfi2.F;h=c890d6becb9d45885c0422a0916ac18c4ee04ace;hb=b49fd63653d53c87f7b1d6a0a2a46aebf78ad19c;hp=0000000000000000000000000000000000000000;hpb=5df9ad0896e58a24522f58a7412bdd05ec37d8b1;p=modules%2Fhomard.git

diff --git a/src/tool/Utilitaire/uttfi2.F b/src/tool/Utilitaire/uttfi2.F
new file mode 100644
index 00000000..c890d6be
--- /dev/null
+++ b/src/tool/Utilitaire/uttfi2.F
@@ -0,0 +1,131 @@
+      subroutine uttfi2 ( sss, ttt,
+     >                    v1, v2, v3, v4, vn )
+c ______________________________________________________________________
+c
+c                             H O M A R D
+c
+c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
+c
+c Version originale enregistree le 18 juin 1996 sous le numero 96036
+c aupres des huissiers de justice Simart et Lavoir a Clamart
+c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
+c aupres des huissiers de justice
+c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
+c
+c    HOMARD est une marque deposee d'Electricite de France
+c
+c Copyright EDF 1996
+c Copyright EDF 1998
+c Copyright EDF 2002
+c Copyright EDF 2020
+c ______________________________________________________________________
+c
+c    UTilitaire - TFI - option 2
+c    --           ---          -
+c ______________________________________________________________________
+c
+c Creation d'un noeud par methode TFI a l'interieur d'un quadrangle
+c programme en dimension 2
+c
+c         Conventions d'orientation :
+c
+c              4 .--------------------. 3
+c                .                    .
+c                .                    .
+c                .                    .
+c              1 .--------------------. 2
+c
+c ______________________________________________________________________
+c .        .     .        .                                            .
+c .  nom   . e/s . taille .           description                      .
+c .____________________________________________________________________.
+c . sss    . e   . 1      . abscisse curviligne selon 12/43            .
+c . ttt    . e   . 1      . abscisse curviligne selon 14/23            .
+c . v1     . e   .   2    . coordonnees du sommet 1 du quadrangle      .
+c . v2     . e   .   2    . coordonnees du sommet 2 du quadrangle      .
+c . v3     . e   .   2    . coordonnees du sommet 3 du quadrangle      .
+c . v4     . e   .   2    . coordonnees du sommet 4 du quadrangle      .
+c . vn     .  s  .   2    . coordonnees du noeud cree                  .
+c .____________________________________________________________________.
+c
+c====
+c 0. declarations et dimensionnement
+c====
+c
+c 0.1. ==> generalites
+c
+      implicit none
+      save
+c
+cgn      character*6 nompro
+cgn      parameter ( nompro = 'UTTFI2' )
+c
+c 0.2. ==> communs
+c
+c 0.3. ==> arguments
+c
+      double precision v1(2), v2(2), v3(2), v4(2), vn(2)
+      double precision sss, ttt
+c
+c 0.4. ==> variables locales
+c
+      integer iaux
+c
+      double precision v12(2), v43(2), v14(2), v23(2)
+      double precision unmsss, unmttt
+
+c 0.5. ==> initialisations
+c ______________________________________________________________________
+c
+c====
+c 1. abscisses curvilignes
+c====
+c
+      unmsss = 1.d0 - sss
+      unmttt = 1.d0 - ttt
+cgn      print 1789 ,'........ sss = ',sss
+cgn      print 1789 ,'........ ttt = ',ttt
+cgn      print 1789 ,'........ v1 = ',v1
+cgn      print 1789 ,'........ v2 = ',v2
+cgn      print 1789 ,'........ v3 = ',v3
+cgn      print 1789 ,'........ v4 = ',v4
+c
+c====
+c 2. noeuds de bord
+c====
+c
+      do 20 , iaux = 1 , 2
+c
+        v12(iaux) = v1(iaux) + sss*(v2(iaux)-v1(iaux))
+        v43(iaux) = v4(iaux) + sss*(v3(iaux)-v4(iaux))
+        v14(iaux) = v1(iaux) + ttt*(v4(iaux)-v1(iaux))
+        v23(iaux) = v2(iaux) + ttt*(v3(iaux)-v2(iaux))
+c
+   20 continue
+cgn      print 1789,'v12 =',v12
+cgn      print 1789,'v43 =',v43
+cgn      print 1789,'v14 =',v14
+cgn      print 1789,'v23 =',v23
+cgn 1789 format(a,2g14.7)
+c
+c====
+c 3. Calcul
+c====
+c
+      do 30 , iaux = 1 , 2
+c
+        vn(iaux) = unmttt * v12(iaux)
+     >           + ttt * v43(iaux)
+     >           + unmsss * v14(iaux)
+     >           + sss * v23(iaux)
+     >           - unmsss * unmttt * v1(iaux)
+     >           - unmsss * ttt * v4(iaux)
+     >           - sss * unmttt * v2(iaux)
+     >           - sss * ttt * v3(iaux)
+c
+   30 continue
+cgn      print 1789 ,'........ vn = ',vn
+cgn      print 1789 ,'........ pv = ',
+cgn     >         vn(2)*(v4(1)-v1(1)) - vn(1)*(v4(2)-v1(2))
+c
+      end