--- /dev/null
+ subroutine utmcz0 ( nbzord, cazord,
+ > nbfich,
+ > nomref, lgnofi, poinno,
+ > nomufi, nomstr,
+ > ulsort, langue, codret )
+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 : Mot-Cle - caracterisation des Zones a Raffiner - 0
+c -- - - - -
+c ______________________________________________________________________
+c . . . . .
+c . nom . e/s . taille . description .
+c .____________________________________________________________________.
+c . nbzord . es . 1 . nombre de zones a raffiner/deraffiner .
+c . . . . si negatif, les zones sont 2D (en x et y) .
+c . cazord . s . 20 * . caracteristiques zone a raffiner/deraffiner.
+c . . . nbzord . 1 : >0 si a raffiner, <0 si a deraffiner .
+c . . . . . si rectangle : .
+c . . . . 1 : +-1 .
+c . . . . de 2 a 5 : xmin, xmax, ymin, ymax .
+c . . . . . si parallelepipede : .
+c . . . . 1 : +-2 .
+c . . . . de 2 a 7 : xmin, xmax, ymin, ymax .
+c . . . . zmin, zmax .
+c . . . . . si disque : .
+c . . . . 1 : +-3 .
+c . . . . de 8 a 10 : rayon, xcentr, ycentr .
+c . . . . . si sphere : .
+c . . . . 1 : +-4 .
+c . . . . de 8 a 11 : rayon, xcentr, ycentr, zcentr .
+c . . . . . si cylindre : .
+c . . . . 1 : +-5 .
+c . . . . 8 : rayon .
+c . . . . de 12 a 14 : xaxe, yaxe, zaxe .
+c . . . . de 15 a 17 : xbase, ybase, zbase .
+c . . . . 18 : hauteur .
+c . . . . . si disque perce : .
+c . . . . 1 : +-6 .
+c . . . . de 9 a 10 : xcentr, ycentr .
+c . . . . 19 : rayon interieur .
+c . . . . 20 : rayon exterieur .
+c . . . . . si tuyau : .
+c . . . . 1 : +-7 .
+c . . . . de 12 a 14 : xaxe, yaxe, zaxe .
+c . . . . de 15 a 17 : xbase, ybase, zbase .
+c . . . . 18 : hauteur .
+c . . . . 19 : rayon interieur .
+c . . . . 20 : rayon exterieur .
+c . nomref . e . nbfich . nom de reference des fichiers .
+c . lgnofi . e . nbfich . longueurs des noms des fichiers .
+c . poinno . e .0:nbfich. pointeur dans le tableau des noms .
+c . nomufi . e . lgtanf . noms des fichiers .
+c . nomstr . e . nbfich . nom des structures .
+c . ulsort . e . 1 . numero d'unite logique de la liste standard.
+c . langue . e . 1 . langue des messages .
+c . . . . 1 : francais, 2 : anglais .
+c . codret . es . 1 . code de retour des modules .
+c . . . . 0 : pas de probleme .
+c . . . . 2 : probleme de lecture .
+c . . . . 3 : type inconnu .
+c ______________________________________________________________________
+c
+c====
+c 0. declarations et dimensionnement
+c====
+c
+c 0.1. ==> generalites
+c
+ implicit none
+ save
+c
+ character*6 nompro
+ parameter ( nompro = 'UTMCZ0' )
+c
+#include "nblang.h"
+#include "motcle.h"
+c
+ integer nbmcle
+ parameter ( nbmcle = 20 )
+c
+c 0.2. ==> communs
+c
+#include "envex1.h"
+c
+c 0.3. ==> arguments
+c
+ integer nbzord
+ integer nbfich
+ integer lgnofi(nbfich), poinno(0:nbfich)
+c
+ character*8 nomref(nbfich), nomufi(*), nomstr(nbfich)
+c
+ double precision cazord(nbmcle,nbzord)
+c
+ integer ulsort, langue, codret
+c
+c 0.4. ==> variables locales
+c
+ integer iaux, jaux
+ integer nrfich
+ integer nrzord, tyzord, tyzosi
+ integer numero, nrmcle
+c
+ character*8 mclref(nbmcle)
+ character*200 sau200
+c
+ logical mccode(nbmcle)
+ logical mccod2(nbmcle)
+c
+ double precision daux
+c
+ integer nbmess
+ parameter ( nbmess = 10 )
+ character*80 texte(nblang,nbmess)
+c
+ character*13 messag(nblang,7)
+c
+c 0.5. ==> initialisations
+c ______________________________________________________________________
+c
+c====
+c 1. messages
+c====
+c
+c 1.1. ==> tout va bien
+c
+ codret = 0
+c
+c 1.2. ==> les messages
+c
+#include "impr01.h"
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Entree', nompro
+ call dmflsh (iaux)
+#endif
+c
+ texte(1,4) = '(''Nombre de zones a raffiner :'',i8)'
+ texte(1,5) = '(''Numero de la zone en cours de recherche :'',i8)'
+ texte(1,6) = '(''Type de la zone : '',a)'
+ texte(1,7) = '(''Le type '',i8,'' est inconnu.'')'
+ texte(1,8) = '(''La valeur de '',a,'' est indecodable.'')'
+c
+ texte(2,4) = '(''Number of zones to refine :'',i8)'
+ texte(2,5) = '(''Search for zone #'',i8)'
+ texte(2,6) = '(''Type of zone : '',a)'
+ texte(2,7) = '(''The type #'',i8,'' is unknown.'')'
+ texte(2,8) = '(''The value for '',a,'' cannot be uncoded.'')'
+c
+c 1234567890123
+ messag(1,1) = 'Rectangle '
+ messag(1,2) = 'Parallepipede'
+ messag(1,3) = 'Disque '
+ messag(1,4) = 'Sphere '
+ messag(1,5) = 'Cylindre '
+ messag(1,6) = 'Disque perce '
+ messag(1,7) = 'Tuyau '
+c
+ messag(2,1) = 'Rectangle '
+ messag(2,2) = 'Parallepiped '
+ messag(2,3) = 'Disk '
+ messag(2,4) = 'Sphere '
+ messag(2,5) = 'Cylindre '
+ messag(2,6) = 'Disk '
+ messag(2,7) = 'Pipe '
+c
+c 1.3. ==> preliminaires
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,4)) nbzord
+#endif
+ mclref( 1) = mczrty
+ mclref( 2) = mcrxmi
+ mclref( 3) = mcrxma
+ mclref( 4) = mcrymi
+ mclref( 5) = mcryma
+ mclref( 6) = mcrzmi
+ mclref( 7) = mcrzma
+ mclref( 8) = mcrray
+ mclref( 9) = mcrxce
+ mclref(10) = mcryce
+ mclref(11) = mcrzce
+ mclref(12) = mcrxax
+ mclref(13) = mcryax
+ mclref(14) = mcrzax
+ mclref(15) = mcrxba
+ mclref(16) = mcryba
+ mclref(17) = mcrzba
+ mclref(18) = mcrhau
+ mclref(19) = mcrrai
+ mclref(20) = mcrrae
+c
+#ifdef _DEBUG_HOMARD_
+ write(ulsort,*) mclref
+#endif
+c
+c====
+c 2. on parcourt toutes les posssibilites de zones de raffinement
+c====
+c
+ do 20 , nrzord = 1 , nbzord
+c
+c 2.0. ==> On n'a rien au debut
+c
+ do 201 , iaux = 1 , nbmcle
+ mccode(iaux) = .false.
+ 201 continue
+c
+ do 200 , nrfich = 1 , nbfich
+c
+c 2.1. ==> si c'est un des mots-cles possibles, on verifie si c'est
+c pour la bonne zone
+c
+ if ( codret.eq.0 ) then
+c
+cgn write(ulsort,*) nomref(nrfich)
+ nrmcle = -1
+ do 21 , iaux = 1 , nbmcle
+cgn write(ulsort,*) 'mclref(',iaux,') =', mclref(iaux)
+ if ( nomref(nrfich).eq.mclref(iaux) ) then
+ nrmcle = iaux
+cgn write(ulsort,*) '==> nrmcle =',iaux
+ goto 211
+ endif
+ 21 continue
+c
+ 211 continue
+c
+ if ( nrmcle.ge.1 ) then
+c
+ call utchen ( nomstr(nrfich), numero,
+ > ulsort, langue, codret )
+c
+ if ( nrzord.ne.numero ) then
+ goto 200
+ endif
+c
+ else
+c
+ goto 200
+c
+ endif
+c
+ endif
+c
+c 2.2. ==> Recherche de la valeur
+c 2.2.1. ==> Mise sous forme de chaine de la 3eme donnee sur la ligne
+c
+ if ( codret.eq.0 ) then
+c
+ iaux = poinno(nrfich-1) + 1
+ jaux = lgnofi(nrfich)
+ call uts8ch ( nomufi(iaux), jaux, sau200,
+ > ulsort, langue, codret )
+c
+ endif
+cgn write(ulsort,*) 'nrmcle =',nrmcle,nomufi(iaux),
+cgn >'sau200 = ',sau200
+c
+c 2.2.2. ==> Conversions
+c
+ if ( codret.eq.0 ) then
+c
+c 2.2.2.1. ==> Conversion du type : entier a decoder, puis reel
+c
+ if ( nrmcle.eq.1 ) then
+c
+ call utchen ( sau200, tyzord,
+ > ulsort, langue, codret )
+c
+ cazord(nrmcle,nrzord) = dble(tyzord)
+ if ( tyzord.gt.0 ) then
+ tyzosi = 1
+ else
+ tyzosi = -1
+ endif
+ tyzord = abs(tyzord)
+c
+c 2.2.2.2. ==> Conversion des coordonnees : reel
+c
+ elseif ( nrmcle.ge.2 ) then
+c
+ call utchre ( sau200, daux,
+ > ulsort, langue, codret )
+ cazord(nrmcle,nrzord) = daux
+c
+ if ( codret.ne.0 ) then
+ write (ulsort,texte(langue,5)) nrzord
+ write (ulsort,texte(langue,8)) mclref(nrmcle)
+ endif
+c
+ endif
+c
+ endif
+c
+c 2.2.3. ==> Memorisation du passage par le mot-cle
+c
+ if ( codret.eq.0 ) then
+c
+ mccode(nrmcle) = .true.
+c
+ endif
+c
+c 2.3. ==> Controle ; si on a tout trouve, on passe a la zone suivante
+c
+ if ( codret.eq.0 ) then
+c
+ if ( mccode(1) ) then
+c
+c 2.3.1. ==> Cas du rectangle
+c
+ if ( tyzord.eq.1 ) then
+c
+ if ( mccode(2) .and. mccode(3) .and.
+ > mccode(4) .and. mccode(5) ) then
+c
+ goto 20
+c
+ endif
+c
+c 2.3.2. ==> Cas du parallelepipede
+c
+ elseif ( tyzord.eq.2 ) then
+c
+ if ( mccode(2) .and. mccode(3) .and.
+ > mccode(4) .and. mccode(5) .and.
+ > mccode(6) .and. mccode(7) ) then
+c
+ goto 20
+c
+ endif
+c
+c 2.3.3. ==> Cas du disque
+c
+ elseif ( tyzord.eq.3 ) then
+c
+ if ( mccode( 8) .and. mccode( 9) .and.
+ > mccode(10) ) then
+c
+ goto 20
+c
+ endif
+c
+c 2.3.4. ==> Cas de la sphere
+c
+ elseif ( tyzord.eq.4 ) then
+c
+ if ( mccode( 8) .and. mccode( 9) .and.
+ > mccode(10) .and. mccode(11) ) then
+c
+ goto 20
+c
+ endif
+c
+c 2.3.5. ==> Cas du cylindre
+c
+ elseif ( tyzord.eq.5 ) then
+c
+ if ( mccode( 8) .and.
+ > mccode(12) .and. mccode(13) .and.
+ > mccode(14) .and. mccode(15) .and.
+ > mccode(16) .and. mccode(17) .and.
+ > mccode(18) ) then
+c
+ goto 20
+c
+ endif
+c
+c 2.3.6. ==> Cas du disque perce
+c
+ elseif ( tyzord.eq.6 ) then
+c
+ if ( mccode( 9) .and. mccode(10) .and.
+ > mccode(19) .and. mccode(20) ) then
+c
+ goto 20
+c
+ endif
+c
+c 2.3.7. ==> Cas du tuyau
+c
+ elseif ( tyzord.eq.7 ) then
+c
+ if ( mccode(12) .and. mccode(13) .and.
+ > mccode(14) .and. mccode(15) .and.
+ > mccode(16) .and. mccode(17) .and.
+ > mccode(18) .and. mccode(19) .and.
+ > mccode(20) ) then
+c
+ goto 20
+c
+ endif
+c
+c 2.3.n. ==> Type inconnu
+c
+ else
+ write (ulsort,texte(langue,7)) tyzord*tyzosi
+ codret = 3
+ endif
+c
+ endif
+c
+ endif
+c
+ 200 continue
+c
+c 2.4. ==> si on arrive ici, c'est qu'il en manque pour la zone courante
+c
+ if ( codret.eq.0 ) then
+c
+ do 240 , iaux = 1 , nbmcle
+ mccod2(iaux) = .false.
+ 240 continue
+c
+ write (ulsort,texte(langue,5)) nrzord
+ write (ulsort,texte(langue,6)) messag(langue,tyzord)
+ if ( tyzord.eq.1 ) then
+ do 241 , iaux = 2 , 5
+ mccod2(iaux) = .true.
+ 241 continue
+ elseif ( tyzord.eq.2 ) then
+ do 242 , iaux = 2 , 7
+ mccod2(iaux) = .true.
+ 242 continue
+ elseif ( tyzord.eq.3 ) then
+ do 243 , iaux = 8 , 10
+ mccod2(iaux) = .true.
+ 243 continue
+ elseif ( tyzord.eq.4 ) then
+ do 244 , iaux = 8 , 11
+ mccod2(iaux) = .true.
+ 244 continue
+ elseif ( tyzord.ge.5 ) then
+ mccod2(8) = .true.
+ do 245 , iaux = 12 , 18
+ mccod2(iaux) = .true.
+ 245 continue
+ elseif ( tyzord.eq.6 ) then
+ do 246 , iaux = 8 , 10
+ mccod2(iaux) = .true.
+ 246 continue
+ mccod2(19) = .true.
+ elseif ( tyzord.eq.7 ) then
+ mccod2(8) = .true.
+ do 248 , iaux = 12 , 19
+ mccod2(iaux) = .true.
+ 248 continue
+ endif
+ do 24 , iaux = 2 , nbmcle
+ if ( .not.mccode(iaux) .and. mccod2(iaux) ) then
+ write (ulsort,texte(langue,8)) mclref(iaux)
+ endif
+ 24 continue
+c
+ codret = 2
+c
+ endif
+c
+ 20 continue
+c
+c====
+c 3. la fin
+c====
+c
+ if ( codret.ne.0 ) then
+c
+ call dmflsh(iaux)
+c
+#include "envex2.h"
+c
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ write (ulsort,texte(langue,2)) codret
+c
+ endif
+c
+#ifdef _DEBUG_HOMARD_
+ write (ulsort,texte(langue,1)) 'Sortie', nompro
+ call dmflsh (iaux)
+#endif
+c
+ end
