1 subroutine utsex0 ( nocsol, option,
2 > ulsort, langue, codret )
3 c ______________________________________________________________________
7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
10 c aupres des huissiers de justice Simart et Lavoir a Clamart
11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
12 c aupres des huissiers de justice
13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
15 c HOMARD est une marque deposee d'Electricite de France
21 c ______________________________________________________________________
23 c UTilitaire - Solution - EXtrusion - phase 0
25 c ______________________________________________________________________
27 c . nom . e/s . taille . description .
28 c .____________________________________________________________________.
29 c . nocsol . e . char8 . nom de l'objet solution a modifier .
30 c . option . e . 1 . option de la modification .
31 c . . . . 1 : passage du 3D au 2D .
32 c . . . . 2 : passage du 2D au 3D .
33 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
34 c . langue . e . 1 . langue des messages .
35 c . . . . 1 : francais, 2 : anglais .
36 c . codret . es . 1 . code de retour des modules .
37 c . . . . 0 : pas de probleme .
38 c . . . . 1 : probleme .
39 c ______________________________________________________________________
42 c 0. declarations et dimensionnement
45 c 0.1. ==> generalites
51 parameter ( nompro = 'UTSEX0' )
73 integer ulsort, langue, codret
75 c 0.4. ==> variables locales
80 integer edsuav, edsuap, edsaav, edsaap, nbenti
83 integer nbcham, nbpafo, nbprof, nblopg
84 integer adinch, adinpf, adinpr, adinlg
87 parameter ( nbmess = 20 )
88 character*80 texte(nblang,nbmess)
90 c 0.5. ==> initialisations
91 c ______________________________________________________________________
100 write (ulsort,texte(langue,1)) 'Entree', nompro
104 texte(1,4) = '(''Solution sur le domaine '',i1,''D'')'
105 texte(1,6) = '(''Option de conversion '',i8,'' invalide.'')'
106 texte(1,7) = '(''Il faut 1 ou 2.'')'
107 texte(1,8) = '(''Nombre de champs : '', i3)'
108 texte(1,9) = '(''Nombre de paquets de fonctions : '', i3)'
110 texte(2,4) = '(''Solution to convert for '',i1,''D'')'
111 texte(2,6) = '(''Option for conversion '',i8,'' is uncorrect.'')'
112 texte(2,7) = '(''1 or 2 is needed.'')'
113 texte(2,8) = '(''Number of fields : '', i3)'
114 texte(2,9) = '(''Number of packs of functions: '', i3)'
119 c 2. Les types MED a echanger
122 if ( option.eq.1 ) then
129 elseif ( option.eq.2 ) then
137 write (ulsort,texte(langue,6)) option
138 write (ulsort,texte(langue,7))
142 #ifdef _DEBUG_HOMARD_
143 10000 format(43('='))
145 write (ulsort,90002) 'nbquac', nbquac, nbquto
146 write (ulsort,90002) 'nbheac', nbheac, nbheto
147 write (ulsort,90002) 'nbtria', nbtria
148 write (ulsort,90002) 'nbquad', nbquad
149 write (ulsort,90002) 'nbhexa', nbhexa
150 write (ulsort,90002) 'nbpent', nbpent
151 write (ulsort,texte(langue,4)) 1+fp0012(option)
152 write (ulsort,90002) 'tbiaux', tbiaux
153 call gmprsx (nompro//' - nocsol', nocsol )
154 cgn call gmprsx ('nocsol.InfoCham', nocsol//'.InfoCham' )
155 cgn call gmprsx (' ', '%%%%%%18' )
156 cgn call gmprsx ('nocsol.InfoPaFo', nocsol//'.InfoPaFo' )
157 if ( option.eq.22 ) then
158 call gmprsx (' ', '%%%%%%22' )
159 call gmprsx (' ', '%%Fo0054' )
160 call gmprsx (' ', '%%%%%%20' )
161 call gmprsx (' ', '%%%%%%20.ValeursR' )
162 call gmprsx (' ', '%%%%%%21' )
163 call gmprsx (' ', '%%%%%%21.ValeursR' )
164 elseif ( option.eq.11 ) then
165 call gmprsx (' ', '%%%%%%25' )
166 call gmprsx (' ', '%%Fo0059' )
167 call gmprsx (' ', '%%%%%%28' )
168 call gmprsx (' ', '%%%%%%28.ValeursR' )
169 call gmprsx (' ', '%%%%%%30' )
170 call gmprsx (' ', '%%%%%%30.ValeursR' )
172 cgn call gmprsx (nompro, nocsol//'.InfoProf' )
177 c 3. recuperation des pointeurs lies a la solution
179 #ifdef _DEBUG_HOMARD_
180 write (ulsort,90002) '3. recuperation ; codret', codret
183 if ( codret.eq.0 ) then
185 call utcaso ( nocsol,
186 > nbcham, nbpafo, nbprof, nblopg,
187 > adinch, adinpf, adinpr, adinlg,
188 > ulsort, langue, codret )
190 #ifdef _DEBUG_HOMARD_
191 write (ulsort,texte(langue,8)) nbcham
192 write (ulsort,texte(langue,9)) nbpafo
198 c 4. Pour chacun des deux types de mailles
200 #ifdef _DEBUG_HOMARD_
201 write (ulsort,90002) '4. chacun des deux types ; codret', codret
204 do 40 , nuedel = 1 , 2
206 c 4.1. ==> Les types de mailles a echanger
208 edsuav = tbiaux(nuedel,1)
209 edsuap = tbiaux(nuedel,2)
210 edsaav = tbiaux(fp0012(nuedel),1)
211 edsaap = tbiaux(fp0012(nuedel),2)
212 nbenti = tbiaux(nuedel,3)
213 #ifdef _DEBUG_HOMARD_
214 write (ulsort,90015) 'Passage de', edsuav,' a', edsuap
215 write (ulsort,90015) 'Type associe de', edsaav,' a', edsaap
216 write (ulsort,90002) 'nbenti', nbenti
219 c 4.2. ==> exploration des paquets de fonctions
220 #ifdef _DEBUG_HOMARD_
221 write (ulsort,90002) '4.2. paquets ; codret', codret
224 if ( codret.eq.0 ) then
226 #ifdef _DEBUG_HOMARD_
227 write (ulsort,texte(langue,3)) 'UTSEX1', nompro
229 call utsex1 ( nbpafo, smem(adinpf),
230 > edsuav, edsuap, edsaav, edsaap, nbenti,
231 > ulsort, langue, codret )
235 c 4.3. ==> exploration des champs
236 #ifdef _DEBUG_HOMARD_
237 write (ulsort,90002) '4.3. champs ; codret', codret
240 if ( codret.eq.0 ) then
242 #ifdef _DEBUG_HOMARD_
243 write (ulsort,texte(langue,3)) 'UTSEX3', nompro
245 call utsex3 ( nbcham, smem(adinch),
246 > edsuav, edsuap, edsaav, edsaap, nbenti,
247 > ulsort, langue, codret )
257 #ifdef _DEBUG_HOMARD_
258 if ( codret.eq.0 ) then
259 cgn write (ulsort,10000)
260 write (ulsort,texte(langue,4)) 1+option
261 call gmprsx (nompro, nocsol )
262 call gmprsx (nompro, nocsol//'.InfoCham' )
263 call gmprsx (nompro, nocsol//'.InfoPaFo' )
264 call gmprsx (nompro, nocsol//'.InfoProf' )
265 cgn write (ulsort,10000)
269 if ( codret.ne.0 ) then
273 write (ulsort,texte(langue,1)) 'Sortie', nompro
274 write (ulsort,texte(langue,2)) codret
278 #ifdef _DEBUG_HOMARD_
279 write (ulsort,texte(langue,1)) 'Sortie', nompro