subroutine uthcad ( bindec, nbaret, aredec ) 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 : Hexaedre coupe par Conformite - Aretes Coupees c -- - - - - c ______________________________________________________________________ c . . . . . c . nom . e/s . taille . description . c .____________________________________________________________________. c . bindec . e . 1 . binaire du decoupage . c . nbaret . s . 1 . nombre d'aretes coupees . c . aredec . s . 12 . numeros locaux des aretes coupees . c .____________________________________________________________________. c c==== c 0. declarations et dimensionnement c==== c c 0.1. ==> generalites c implicit none save c c 0.2. ==> communs c c#include "hexcf0.h" #include "hexcf1.h" c c 0.3. ==> arguments c integer bindec integer nbaret, aredec(12) c c 0.4. ==> variables locales c integer iaux, jaux character*3 saux03 c c==== c 1. traitement c==== c nbaret = 0 jaux = 1 do 11 , iaux = 1 , 12 c cgn print *, charde(bindec)(jaux:jaux+3) saux03 = charde(bindec)(jaux:jaux+3) if ( saux03.ne.' ' ) then read(saux03,'(i3)') aredec(iaux) nbaret = nbaret + 1 jaux = jaux + 3 else goto 12 endif c 11 continue c 12 continue cgn print *, 'Nombre d aretes coupees :', nbaret cgn print *, 'aredec =', (aredec(iaux),iaux=1,nbaret) c end