src/tool/Utilitaire/utequa.F

   1       subroutine utequa ( nbquto, nbqual, nbnoal, sdim,
   2      >                    coonoe, somare, arequa,
   3      >                    nmprog, avappr, ulbila,
   4      >                    ulsort, langue, codret )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  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
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c    UTilitaire - Examen des QUAdrangles
  26 c    --           -          ---
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . nbquto . e   .   1    . nombre de quadrangles a examiner           .
  32 c . nbqual . e   .   1    . nombre de quadrangles pour les allocations .
  33 c . nbnoal . e   .   1    . nombre de noeuds pour les allocations      .
  34 c . sdim   . e   .   1    . dimension du maillage                      .
  35 c . coonoe . e   . nbnoal . coordonnees des noeuds                     .
  36 c .        .     . * sdim .                                            .
  37 c . somare . e   . 2*nbar . numeros des extremites d'arete             .
  38 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  39 c . nmprog . e   . char*  . nom du programme a pister                  .
  40 c . avappr . e   .   1    . 1 : impression avant l'appel a "nmprog"    .
  41 c .        .     .        . 2 : impression apres l'appel a "nmprog"    .
  42 c . ulbila . e   .   1    . unite logique d'ecriture du bilan          .
  43 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  44 c . langue . e   .    1   . langue des messages                        .
  45 c .        .     .        . 1 : francais, 2 : anglais                  .
  46 c . codret . es  .    1   . code de retour des modules                 .
  47 c .        .     .        . 0 : pas de probleme                        .
  48 c .        .     .        . >0 : probleme dans le controle             .
  49 c ______________________________________________________________________
  50 c
  51 c====
  52 c 0. declarations et dimensionnement
  53 c====
  54 c
  55 c 0.1. ==> generalites
  56 c
  57       implicit none
  58       save
  59 c
  60       character*6 nompro
  61       parameter ( nompro = 'UTEQUA' )
  62 c
  63 #include "nblang.h"
  64 c
  65 c 0.2. ==> communs
  66 c
  67 #include "envex1.h"
  68 #include "impr02.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       integer nbquto, nbqual, nbnoal, sdim
  73       integer somare(2,*)
  74       integer arequa(nbqual,4)
  75 c
  76       double precision coonoe(nbnoal,sdim)
  77 c
  78       character*(*) nmprog
  79 c
  80       integer avappr
  81 c
  82       integer ulbila
  83       integer ulsort, langue, codret
  84 c
  85 c 0.4. ==> variables locales
  86 c
  87       integer codre0
  88       integer iaux, jaux, kaux, laux
  89       integer ulaux
  90       integer a1, a2, a3, a4
  91       integer sa1a2, sa2a3, sa3a4, sa4a1
  92       integer listar(4)
  93 c
  94       double precision v1(3), v2(3), v3(3), v4(3)
  95       double precision v12(3), v34(3)
  96       double precision daux
  97 c
  98       character*1 saux01(3)
  99 c
 100       integer nbmess
 101       parameter ( nbmess = 20 )
 102       character*80 texte(nblang,nbmess)
 103 c
 104 c 0.5. ==> initialisations
 105 c
 106       data saux01 / 'x', 'y', 'z' /
 107 c ______________________________________________________________________
 108 c
 109 c====
 110 c 1. messages
 111 c====
 112 c
 113 #include "impr01.h"
 114 c
 115 #ifdef _DEBUG_HOMARD_
 116       write (ulsort,texte(langue,1)) 'Entree', nompro
 117       call dmflsh (iaux)
 118 #endif
 119 c
 120       texte(1,5) = '(5x,''Controle des '',i10,1x,a)'
 121       texte(1,6) = '(a,'' numero '',i10)'
 122       texte(1,7) = '(''Les '',a,'' sont :'',4i10)'
 123       texte(1,8) = '(''Les '',a,'' sont confondus :'',4i10)'
 124       texte(1,10) = '(''Le '',a,'' est croise.'')'
 125       texte(1,16) =
 126      > '(5x,''Pas de probleme dans la definition des quadrangles'',/)'
 127       texte(1,17) = '(/,''Mauvais code pour '',a,'' : '',i10,/)'
 128       texte(1,18) = '(/,''.. A l''''entree de '',a,'' :'',/)'
 129       texte(1,19) = '(/,''.. Avant appel a '',a,'' :'',/)'
 130       texte(1,20) = '(/,''.. Apres appel a '',a,'' :'',/)'
 131 c
 132       texte(2,5) = '(5x,''Control of '',i10,1x,a)'
 133       texte(2,6) = '(a,'' # '',i10)'
 134       texte(2,7) = '(''The '',a,'' are :'',4i10)'
 135       texte(2,8) = '(''The '',a,'' are similar :'',4i10)'
 136       texte(2,10) = '(''The '',a,'' is overlapped.'')'
 137       texte(2,16) = '(5x,''No problem with quadrangle definition'',/)'
 138       texte(2,17) = '(/,''Bad code for '',a,'' : '',i10,/)'
 139       texte(2,18) = '(/,''.. At the beginning of '',a,'' :'',/)'
 140       texte(2,19) = '(/,''.. Before calling '',a,'' :'',/)'
 141       texte(2,20) = '(/,''.. After calling '',a,'' :'',/)'
 142 c
 143  1000 format('Arete a',i1,' :',i10,' de',i10,' a',i10)
 144  1001 format('Noeud',i10,' :', 3(2x,a,' =',g12.5) )
 145 c
 146 #ifdef _DEBUG_HOMARD_
 147       if ( avappr.ge.0 .and. avappr.le.2 ) then
 148         write (ulsort,texte(langue,18+avappr)) nmprog
 149       else
 150         write (ulsort,texte(langue,17)) nmprog, avappr
 151       endif
 152 #endif
 153       write (ulsort,texte(langue,5)) nbquto, mess14(langue,3,4)
 154 c
 155 c 1.3. ==> constantes
 156 c
 157       codret = 0
 158 c
 159 c====
 160 c 2. verification
 161 c====
 162 c
 163 ccc      do 20 , iaux = 1 , nbquto
 164       do 20 , iaux = 1 , 1
 165 c
 166 #ifdef _DEBUG_HOMARD_
 167       write (ulsort,texte(langue,6)) mess14(langue,2,4), iaux
 168 #endif
 169 c
 170         codre0 = 0
 171 c
 172 c 2.1. ==> les aretes doivent etre differentes ...
 173 c
 174         a1 = arequa(iaux,1)
 175         a2 = arequa(iaux,2)
 176         a3 = arequa(iaux,3)
 177         a4 = arequa(iaux,4)
 178 c
 179         if ( a1.eq.a2 .or.
 180      >       a1.eq.a3 .or.
 181      >       a1.eq.a4 .or.
 182      >       a2.eq.a3 .or.
 183      >       a2.eq.a4 .or.
 184      >       a3.eq.a4 ) then
 185           codre0 = 1
 186           write (ulsort,texte(langue,6)) mess14(langue,2,4), iaux
 187           write (ulsort,texte(langue,8)) mess14(langue,3,1), a1,a2,a3,a4
 188           write (ulbila,texte(langue,6)) mess14(langue,2,4), iaux
 189           write (ulbila,texte(langue,8)) mess14(langue,3,1), a1,a2,a3,a4
 190         endif
 191 c
 192 c 2.2. ==> les aretes doivent se suivre ...
 193 c
 194         if ( codre0.eq.0 ) then
 195 c
 196         listar(1) = a1
 197         listar(2) = a2
 198         listar(3) = a3
 199         listar(4) = a4
 200         jaux = 4
 201         kaux = 4
 202 c
 203 #ifdef _DEBUG_HOMARD_
 204       write (ulsort,texte(langue,3)) 'UTVAR0', nompro
 205 #endif
 206         call utvar0 ( jaux, iaux, kaux, listar, somare,
 207      >                ulbila, ulsort, langue, codre0 )
 208 c
 209         endif
 210 c
 211 c 2.3. ==> les sommets doivent etre differents ...
 212 c
 213         if ( codre0.eq.0 ) then
 214 c
 215 #ifdef _DEBUG_HOMARD_
 216       write (ulsort,texte(langue,3)) 'UTSOQU', nompro
 217 #endif
 218         call utsoqu ( somare, a1, a2, a3, a4,
 219      >                sa1a2, sa2a3, sa3a4, sa4a1 )
 220 c
 221         if ( sa1a2.eq.sa2a3 .or.
 222      >       sa1a2.eq.sa3a4 .or.
 223      >       sa1a2.eq.sa4a1 .or.
 224      >       sa2a3.eq.sa3a4 .or.
 225      >       sa2a3.eq.sa4a1 .or.
 226      >       sa1a2.eq.sa4a1 ) then
 227 c
 228           codre0 = 1
 229 c
 230           if ( ulsort.ne.ulbila ) then
 231             jaux = 2
 232           else
 233             jaux = 1
 234           endif
 235 c
 236           do 23 , kaux = 1 , jaux
 237 c
 238             if ( kaux.eq.1 ) then
 239               ulaux = ulsort
 240             else
 241               ulaux = ulbila
 242             endif
 243 c
 244             write (ulaux,texte(langue,8)) mess14(langue,3,-1),
 245      >                                    sa1a2, sa2a3, sa3a4, sa4a1
 246             write(ulaux,*) 'a1',somare(1,a1),somare(2,a1)
 247             write(ulaux,*) coonoe(somare(1,a1),1),coonoe(somare(1,a1),2)
 248      >           ,coonoe(somare(1,a1),3)
 249             write(ulaux,*) coonoe(somare(2,a1),1),coonoe(somare(2,a1),2)
 250      >           ,coonoe(somare(2,a1),3)
 251             write(ulaux,*) 'a2',somare(1,a2),somare(2,a2)
 252             write(ulaux,*) coonoe(somare(1,a2),1),coonoe(somare(1,a2),2)
 253      >           ,coonoe(somare(1,a2),3)
 254             write(ulaux,*) coonoe(somare(2,a2),1),coonoe(somare(2,a2),2)
 255      >           ,coonoe(somare(2,a2),3)
 256             write(ulaux,*) 'a3',somare(1,a3),somare(2,a3)
 257             write(ulaux,*) coonoe(somare(1,a3),1),coonoe(somare(1,a3),2)
 258      >           ,coonoe(somare(1,a3),3)
 259             write(ulaux,*) coonoe(somare(2,a3),1),coonoe(somare(2,a3),2)
 260      >           ,coonoe(somare(2,a3),3)
 261             write(ulaux,*) 'a4',somare(1,a4),somare(2,a4)
 262             write(ulaux,*) coonoe(somare(1,a4),1),coonoe(somare(1,a4),2)
 263      >           ,coonoe(somare(1,a4),3)
 264             write(ulaux,*) coonoe(somare(2,a4),1),coonoe(somare(2,a4),2)
 265      >           ,coonoe(somare(2,a4),3)
 266             write(ulaux,*) coonoe(sa1a2,1), coonoe(sa1a2,2),
 267      >           coonoe(sa1a2,3)
 268             write(ulaux,*) coonoe(sa2a3,1), coonoe(sa2a3,2),
 269      >           coonoe(sa2a3,3)
 270             write(ulaux,*) coonoe(sa3a4,1), coonoe(sa3a4,2),
 271      >           coonoe(sa3a4,3)
 272             write(ulaux,*) coonoe(sa4a1,1), coonoe(sa4a1,2),
 273      >           coonoe(sa4a1,3)
 274 c
 275    23     continue
 276 c
 277         endif
 278 c
 279         endif
 280 c
 281 c 2.4. ==> il ne faut pas croiser ...
 282 c          pour cela, il faut que les deux produits vectoriels
 283 c          a1xa2 et a3xa4 soient dans la meme orientation. On teste
 284 c          si leur produit scalaire est >0
 285 c          Remarque : cela suppose que le quadrangle est plan
 286 c
 287 c               sa4a1  a4  sa3a4             sa4a1      sa2a3
 288 c                   ._______.                     .       .
 289 c                   .       .                     ..     ..
 290 c                   .       .                     . .a4 . .
 291 c                 a1.       .a3                 a1.  . .  .a3
 292 c                   .       .                     .   .   .
 293 c                   .       .                     .  . .  .
 294 c                   .       .                     . .   . .
 295 c                   .       .                     .. a2  ..
 296 c                   ._______.                     .       .
 297 c               sa1a2   a2  sa2a3            sa1a2     sa3a4
 298 c
 299 c
 300         if ( codre0.eq.0 ) then
 301 c
 302         if ( sdim.eq.2 ) then
 303 c
 304           v1(1)    = coonoe(sa4a1,1) - coonoe(sa1a2,1)
 305           v1(2)    = coonoe(sa4a1,2) - coonoe(sa1a2,2)
 306 c
 307           v2(1)    = coonoe(sa2a3,1) - coonoe(sa1a2,1)
 308           v2(2)    = coonoe(sa2a3,2) - coonoe(sa1a2,2)
 309 c
 310           v3(1)    = coonoe(sa2a3,1) - coonoe(sa3a4,1)
 311           v3(2)    = coonoe(sa2a3,2) - coonoe(sa3a4,2)
 312 c
 313           v4(1)    = coonoe(sa4a1,1) - coonoe(sa3a4,1)
 314           v4(2)    = coonoe(sa4a1,2) - coonoe(sa3a4,2)
 315 c
 316 c         v12 represente le produit vectoriel a1xa2.
 317 c
 318           v12(3) = v1(1)*v2(2) - v1(2)*v2(1)
 319 c
 320 c         v34 represente le produit vectoriel a3xa4.
 321 c
 322           v34(3) = v3(1)*v4(2) - v3(2)*v4(1)
 323 c
 324           daux = v12(3)*v34(3)
 325 c
 326 #ifdef _DEBUG_HOMARD_
 327           if ( iaux.eq.1 ) then
 328           write (ulsort,texte(langue,7)) mess14(langue,3,-1),
 329      >                                   sa1a2, sa2a3, sa3a4, sa4a1
 330           write (ulsort,1001) sa1a2,
 331      >                  (saux01(laux),coonoe(sa1a2,laux),laux=1,sdim)
 332           write (ulsort,1001) sa2a3,
 333      >                  (saux01(laux),coonoe(sa2a3,laux),laux=1,sdim)
 334           write (ulsort,1001) sa3a4,
 335      >                  (saux01(laux),coonoe(sa3a4,laux),laux=1,sdim)
 336           write (ulsort,1001) sa4a1,
 337      >                  (saux01(laux),coonoe(sa4a1,laux),laux=1,sdim)
 338           write (ulsort,*) ' '
 339           write (ulsort,1789) 'v1', v1(1), v1(2)
 340           write (ulsort,1789) 'v2', v2(1), v2(2)
 341           write (ulsort,1789) 'v3', v3(1), v3(2)
 342           write (ulsort,1789) 'v4', v4(1), v4(2)
 343           write (ulsort,*) ' '
 344           write (ulsort,1789) 'v12(3) = ', v12(3)
 345           write (ulsort,1789) 'v34(3) = ', v34(3)
 346           write (ulsort,1789) ' ==> daux =',daux
 347           endif
 348  1789 format(a,' : ',2g13.5,a,g13.5)
 349 #endif
 350 c
 351         else
 352 c
 353           v1(1)    = coonoe(sa4a1,1) - coonoe(sa1a2,1)
 354           v1(2)    = coonoe(sa4a1,2) - coonoe(sa1a2,2)
 355           v1(3)    = coonoe(sa4a1,3) - coonoe(sa1a2,3)
 356 c
 357           v2(1)    = coonoe(sa2a3,1) - coonoe(sa1a2,1)
 358           v2(2)    = coonoe(sa2a3,2) - coonoe(sa1a2,2)
 359           v2(3)    = coonoe(sa2a3,3) - coonoe(sa1a2,3)
 360 c
 361           v3(1)    = coonoe(sa2a3,1) - coonoe(sa3a4,1)
 362           v3(2)    = coonoe(sa2a3,2) - coonoe(sa3a4,2)
 363           v3(3)    = coonoe(sa2a3,3) - coonoe(sa3a4,3)
 364 c
 365           v4(1)    = coonoe(sa4a1,1) - coonoe(sa3a4,1)
 366           v4(2)    = coonoe(sa4a1,2) - coonoe(sa3a4,2)
 367           v4(3)    = coonoe(sa4a1,3) - coonoe(sa3a4,3)
 368 c
 369 c         v12 represente le produit vectoriel a1xa2.
 370 c
 371           v12(1) = v1(2)*v2(3) - v1(3)*v2(2)
 372           v12(2) = v1(3)*v2(1) - v1(1)*v2(3)
 373           v12(3) = v1(1)*v2(2) - v1(2)*v2(1)
 374 c
 375 c         v34 represente le produit vectoriel a3xa4.
 376 c
 377           v34(1) = v3(2)*v4(3) - v3(3)*v4(2)
 378           v34(2) = v3(3)*v4(1) - v3(1)*v4(3)
 379           v34(3) = v3(1)*v4(2) - v3(2)*v4(1)
 380 c
 381           daux = v12(1)*v34(1) + v12(2)*v34(2) + v12(3)*v34(3)
 382 c
 383 #ifdef _DEBUG_HOMARD_
 384           if ( iaux.eq.1 ) then
 385           write (ulsort,texte(langue,7)) mess14(langue,3,-1),
 386      >                                   sa1a2, sa2a3, sa3a4, sa4a1
 387           write (ulsort,1001) sa1a2,
 388      >                  (saux01(laux),coonoe(sa1a2,laux),laux=1,sdim)
 389           write (ulsort,1001) sa2a3,
 390      >                  (saux01(laux),coonoe(sa2a3,laux),laux=1,sdim)
 391           write (ulsort,1001) sa3a4,
 392      >                  (saux01(laux),coonoe(sa3a4,laux),laux=1,sdim)
 393           write (ulsort,1001) sa4a1,
 394      >                  (saux01(laux),coonoe(sa4a1,laux),laux=1,sdim)
 395           write (ulsort,*) ' '
 396           write (ulsort,1792) 'v1', v1(1), v1(2)
 397           write (ulsort,1792) 'v2', v2(1), v2(2)
 398           write (ulsort,1792) 'v3', v3(1), v3(2)
 399           write (ulsort,1792) 'v4', v4(1), v4(2)
 400           write (ulsort,*) ' '
 401           write (ulsort,1792) 'v12(1) = ', v12(1)
 402           write (ulsort,1792) 'v12(2) = ', v12(2)
 403           write (ulsort,1792) 'v12(3) = ', v12(3)
 404           write (ulsort,1792) 'v34(1) = ', v34(1)
 405           write (ulsort,1792) 'v34(2) = ', v34(2)
 406           write (ulsort,1792) 'v34(3) = ', v34(3)
 407           write (ulsort,1792) ' ==> daux =',daux
 408           endif
 409  1792 format(a,' : ',2g13.5,a,g13.5)
 410 #endif
 411 c
 412         endif
 413 c
 414         if ( daux.le.0.d0 ) then
 415 c
 416           codre0 = 1
 417 c
 418           if ( ulsort.ne.ulbila ) then
 419             jaux = 2
 420           else
 421             jaux = 1
 422           endif
 423 c
 424           do 24 , kaux = 1 , jaux
 425 c
 426             if ( kaux.eq.1 ) then
 427               ulaux = ulsort
 428             else
 429               ulaux = ulbila
 430             endif
 431 c
 432             write (ulaux,texte(langue,6)) mess14(langue,2,4), iaux
 433             write (ulaux,texte(langue,7)) mess14(langue,3,-1),
 434      >                                   sa1a2, sa2a3, sa3a4, sa4a1
 435             write (ulaux,texte(langue,10)) mess14(langue,1,4)
 436             write(ulaux,1001) sa1a2,
 437      >                    (saux01(laux),coonoe(sa1a2,laux),laux=1,sdim)
 438             write(ulaux,1001) sa2a3,
 439      >                    (saux01(laux),coonoe(sa2a3,laux),laux=1,sdim)
 440             write(ulaux,1001) sa3a4,
 441      >                    (saux01(laux),coonoe(sa3a4,laux),laux=1,sdim)
 442             write(ulaux,1001) sa4a1,
 443      >                    (saux01(laux),coonoe(sa4a1,laux),laux=1,sdim)
 444 cgn            write(ulaux,*) coonoe(sa1a2,1), coonoe(sa1a2,2),
 445 cgn     >                     coonoe(sa1a2,3)
 446 cgn            write(ulaux,*) coonoe(sa2a3,1), coonoe(sa2a3,2),
 447 cgn     >                     coonoe(sa2a3,3)
 448 cgn            write(ulaux,*) coonoe(sa3a4,1), coonoe(sa3a4,2),
 449 cgn     >                     coonoe(sa3a4,3)
 450 cgn            write(ulaux,*) coonoe(sa4a1,1), coonoe(sa4a1,2),
 451 cgn     >                     coonoe(sa4a1,3)
 452             write(ulaux,1000) 1,a1,somare(1,a1),somare(2,a1)
 453 cgn            write(ulaux,1001) somare(1,a1),coonoe(somare(1,a1),1),
 454 cgn     >           coonoe(somare(1,a1),2),coonoe(somare(1,a1),3)
 455 cgn            write(ulaux,1001) somare(2,a1),coonoe(somare(2,a1),1),
 456 cgn     >           coonoe(somare(2,a1),2),coonoe(somare(2,a1),3)
 457             write(ulaux,1000) 2,a2,somare(1,a2),somare(2,a2)
 458 cgn            write(ulaux,1001) somare(1,a2),coonoe(somare(1,a2),1),
 459 cgn     >           coonoe(somare(1,a2),2),coonoe(somare(1,a2),3)
 460 cgn            write(ulaux,1001) somare(2,a2),coonoe(somare(2,a2),1),
 461 cgn     >           coonoe(somare(2,a2),2),coonoe(somare(2,a2),3)
 462             write(ulaux,1000) 3,a3,somare(1,a3),somare(2,a3)
 463 cgn            write(ulaux,1001) somare(1,a3), coonoe(somare(1,a3),1),
 464 cgn     >           coonoe(somare(1,a3),2),coonoe(somare(1,a3),3)
 465 cgn            write(ulaux,1001) somare(2,a3), coonoe(somare(2,a3),1),
 466 cgn     >           coonoe(somare(2,a3),2),coonoe(somare(2,a3),3)
 467             write(ulaux,1000) 4,a4,somare(1,a4),somare(2,a4)
 468 cgn            write(ulaux,1001) somare(1,a4), coonoe(somare(1,a4),1),
 469 cgn     >           coonoe(somare(1,a4),2),coonoe(somare(1,a4),3)
 470 cgn            write(ulaux,1001) somare(2,a4), coonoe(somare(2,a4),1),
 471 cgn     >           coonoe(somare(2,a4),2),coonoe(somare(2,a4),3)
 472 c
 473    24     continue
 474 c
 475         endif
 476 c
 477         endif
 478 c
 479 c 2.5. ==> cumul des erreurs
 480 c
 481         codret = codret + codre0
 482 c
 483    20 continue
 484 c
 485 c 2.6. ==> tout va bien
 486 c
 487       if ( codret.eq.0 ) then
 488         write (ulsort,texte(langue,16))
 489         write (ulbila,texte(langue,16))
 490       endif
 491 c
 492 c====
 493 c 3. la fin
 494 c====
 495 c
 496       if ( codret.ne.0 ) then
 497 c
 498 #include "envex2.h"
 499 c
 500       write (ulsort,texte(langue,1)) 'Sortie', nompro
 501       write (ulsort,texte(langue,2)) codret
 502 c
 503       endif
 504 c
 505 #ifdef _DEBUG_HOMARD_
 506       write (ulsort,texte(langue,1)) 'Sortie', nompro
 507       call dmflsh (iaux)
 508 #endif
 509 c
 510       end