1 subroutine deisno ( ncmpin, nosupp, noindi,
2 > arsupp, arindi, nbval,
4 > ulsort, langue, codret)
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c traitement des DEcisions - Initialisations - par Saut - NOeuds
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . ncmpin . e . 1 . nombre de composantes de l'indicateur .
32 c . nosupp . e . nbnoto . support pour les noeuds .
33 c . noindi . e . nbnoto . valeurs reelles pour les noeuds .
34 c . arsupp . s . nbarto . support pour les aretes .
35 c . arindi . s . nbarto . valeurs reelles pour les aretes .
36 c . nbval . s . 1 . nombres de valeurs pour les aretes .
37 c . hetare . e . nbarto . historique de l'etat des aretes .
38 c . somare . e .2*nbarto. numeros des extremites d'arete .
39 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
40 c . langue . e . 1 . langue des messages .
41 c . . . . 1 : francais, 2 : anglais .
42 c . codret . es . 1 . code de retour des modules .
43 c . . . . 0 : pas de probleme .
44 c . . . . 2 : probleme dans le traitement .
45 c ______________________________________________________________________
48 c 0. declarations et dimensionnement
51 c 0.1. ==> generalites
57 parameter ( nompro = 'DEISNO' )
72 integer nosupp(nbnoto)
73 integer arsupp(nbarto)
75 integer hetare(nbarto), somare(2,nbarto)
77 integer ulsort, langue, codret
79 double precision noindi(nbnoto,ncmpin)
80 double precision arindi(nbarto,ncmpin)
82 c 0.4. ==> variables locales
85 integer noeud1, noeud2
91 parameter (nbmess = 10 )
92 character*80 texte(nblang,nbmess)
93 c ______________________________________________________________________
99 c 1.1. ==> Les messages
103 #ifdef _DEBUG_HOMARD_
104 write (ulsort,texte(langue,1)) 'Entree', nompro
108 texte(1,4) =' (''. Saut entre '',a)'
110 texte(2,4) = '(''. Jump between '',a)'
115 #ifdef _DEBUG_HOMARD_
116 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
120 c 2. On affecte a chaque arete l'ecart du champ entre ses deux noeuds
121 c extremites. On ne tient pas compte du noeud milieu en degre 2.
122 c Attention : il ne faut s'interesser qu'aux aretes actives, sinon
123 c on cree des sauts artificiels !
126 if ( codret.eq.0 ) then
128 c 2.1. ==> A priori, aucune arete n'est concernee
130 do 21 , iaux = 1 , nbarto
135 do 20 , iaux = 1, nbarto
137 if ( mod(hetare(iaux),10).eq.0 ) then
140 cgn if ( iaux.le.-42 ) then
144 noeud1 = somare(1,iaux)
145 noeud2 = somare(2,iaux)
146 if ( nosupp(noeud1).ne.0 .and. nosupp(noeud2).ne.0 ) then
150 do 200 , nrcomp = 1 , ncmpin
151 arindi(iaux,nrcomp) = abs ( noindi(noeud1,nrcomp) -
152 > noindi(noeud2,nrcomp) )
154 cgn if ( glop.eq.1) then
155 cgn write(ulsort,*)'==========================='
156 cgn write(ulsort,*)'ARETE = ',iaux
157 cgn write(ulsort,*)' Noeud 1 = ',noeud1,', d''indic '
158 cgn write(ulsort,*)(noindi(noeud1,nrcomp), nrcomp = 1 , ncmpin)
159 cgn write(ulsort,*)' Noeud 2 = ',noeud2,', d''indic '
160 cgn write(ulsort,*)(noindi(noeud2,nrcomp), nrcomp = 1 , ncmpin)
161 cgn write(ulsort,*)' ==> champ ',
162 cgn > (arindi(iaux,nrcomp),nrcomp=1 , ncmpin)
177 if ( codret.ne.0 ) then
181 write (ulsort,texte(langue,1)) 'Sortie', nompro
182 write (ulsort,texte(langue,2)) codret
183 write (ulsort,texte(langue,5)) typenh
187 #ifdef _DEBUG_HOMARD_
188 write (ulsort,texte(langue,1)) 'Sortie', nompro