src/tool/Suivi_Frontiere/sfgrf0.F

   1       subroutine sfgrf0 ( nocmaf,
   2      >                    nbmail,
   3      >                    adtyel, adfael,
   4      >                    adnufa, adgrpo, adgrtb,
   5      >                    nbfmed, lifami,
   6      >                    ulsort, langue, codret)
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c   Suivi de Frontiere - GRoupes de la Frontiere - phase 0
  28 c   -        -           --            -                 -
  29 c ______________________________________________________________________
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . nocmaf . e   . char*8 . nom de l'objet maillage de la frontiere    .
  33 c . nbmail .  s  .   1    . nombre de mailles                          .
  34 c . adtyel .  s  .   1    . type des elements                          .
  35 c . adfael .  s  .   1    . famille MED des elements                   .
  36 c . adnufa .  s  .   1    . numero des familles                        .
  37 c . adgrpo .  s  .   1    . pointeurs des groupes                      .
  38 c . adgrtb .  s  .   1    . table des groupes                          .
  39 c . nbfmed .   s .   1    . nombre de familles de mailles de frontiere .
  40 c . lifami .   s .   *    . liste des familles a explorer              .
  41 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  42 c . langue . e   .    1   . langue des messages                        .
  43 c .        .     .        . 1 : francais, 2 : anglais                  .
  44 c . codret . es  .    1   . code de retour des modules                 .
  45 c .        .     .        . 0 : pas de probleme                        .
  46 c .        .     .        . 2 : probleme avec la memoire               .
  47 c .        .     .        . 3 : probleme avec le fichier               .
  48 c .        .     .        . 5 : contenu incorrect                      .
  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 = 'SFGRF0' )
  62 c
  63 #include "nblang.h"
  64 c
  65 c 0.2. ==> communs
  66 c
  67 #include "envex1.h"
  68 c
  69 #include "gmenti.h"
  70 #include "envca1.h"
  71 c
  72 c 0.3. ==> arguments
  73 c
  74       integer nbfmed, nbmail
  75       integer adtyel, adfael
  76       integer adnufa, adgrpo, adgrtb
  77       integer lifami(*)
  78 c
  79       character*8 nocmaf
  80 c
  81       integer ulsort, langue, codret
  82 c
  83 c 0.4. ==> variables locales
  84 c
  85       integer iaux, jaux
  86       integer nbnomb
  87 c
  88       character*8 ncinfo, ncnoeu, nccono, nccode
  89       character*8 nccoex, ncfami
  90       character*8 ncequi, ncfron, ncnomb
  91 c
  92       integer nbmess
  93       parameter ( nbmess = 10 )
  94       character*80 texte(nblang,nbmess)
  95 c
  96 c 0.5. ==> initialisations
  97 c ______________________________________________________________________
  98 c
  99 c====
 100 c 1. messages
 101 c====
 102 c
 103 #include "impr01.h"
 104 c
 105 #ifdef _DEBUG_HOMARD_
 106       write (ulsort,texte(langue,1)) 'Entree', nompro
 107       call dmflsh (iaux)
 108 #endif
 109 c
 110       codret = 0
 111 c
 112 c====
 113 c 2. recuperation des adresses
 114 c====
 115 c 2.1. ==> les informations generales
 116 c
 117       if ( codret.eq.0 ) then
 118 c
 119 #ifdef _DEBUG_HOMARD_
 120       call gmprsx (nompro,nocmaf )
 121 #endif
 122 c
 123 #ifdef _DEBUG_HOMARD_
 124       write (ulsort,texte(langue,3)) 'UTNOMC', nompro
 125 #endif
 126       call utnomc ( nocmaf,
 127      >                sdim,   mdim,
 128      >               degre, mailet, maconf, homolo, hierar,
 129      >              nbnomb,
 130      >              ncinfo, ncnoeu, nccono, nccode,
 131      >              nccoex, ncfami,
 132      >              ncequi, ncfron, ncnomb,
 133      >              ulsort, langue, codret)
 134 c
 135 #ifdef _DEBUG_HOMARD_
 136       call gmprsx (nompro, ncnoeu )
 137       call gmprsx (nompro, nccono )
 138       call gmprsx (nompro, ncfami )
 139 #endif
 140 c
 141       endif
 142 c
 143 c 2.2. ==> caracteristiques des mailles frontiere
 144 c
 145       if ( codret.eq.0 ) then
 146 c
 147 #ifdef _DEBUG_HOMARD_
 148       write (ulsort,texte(langue,3)) 'UTAD11', nompro
 149 #endif
 150       iaux = 77
 151       call utad11 ( iaux, ncnoeu, nccono,
 152      >                jaux,   jaux,   jaux,  jaux,
 153      >              adtyel, adfael,   jaux,  jaux,
 154      >              ulsort, langue, codret )
 155 c
 156       endif
 157 c
 158       if ( codret.eq.0 ) then
 159 c
 160       call gmliat ( nccono, 1, nbmail, codret )
 161 c
 162       endif
 163 c
 164 c 2.3. ==> adresses des tableaux des groupes dans les familles
 165 c
 166       if ( codret.eq.0 ) then
 167 c
 168 #ifdef _DEBUG_HOMARD_
 169       write (ulsort,texte(langue,3)) 'UTAD13', nompro
 170 #endif
 171       iaux = 10
 172       call utad13 ( iaux, ncfami,
 173      >              adnufa, jaux,
 174      >              adgrpo,  jaux, adgrtb,
 175      >              ulsort, langue, codret )
 176 c
 177       endif
 178 c
 179 c====
 180 c 3. reperage des numeros des familles de segments
 181 c====
 182 #ifdef _DEBUG_HOMARD_
 183       write (ulsort,*) '3. reperage ; codret = ', codret
 184 #endif
 185 c
 186       if ( codret.eq.0 ) then
 187 c
 188 #ifdef _DEBUG_HOMARD_
 189       write (ulsort,texte(langue,3)) 'SFGRF1', nompro
 190 #endif
 191       call sfgrf1 ( nbfmed, lifami,
 192      >              nbmail, imem(adtyel), imem(adfael),
 193      >              ulsort, langue, codret )
 194 c
 195       endif
 196 c
 197 c====
 198 c 4. la fin
 199 c====
 200 c
 201       if ( codret.ne.0 ) then
 202 c
 203 #include "envex2.h"
 204 c
 205       write (ulsort,texte(langue,1)) 'Sortie', nompro
 206       write (ulsort,texte(langue,2)) codret
 207 c
 208       endif
 209 c
 210 #ifdef _DEBUG_HOMARD_
 211       write (ulsort,texte(langue,1)) 'Sortie', nompro
 212       call dmflsh (iaux)
 213 #endif
 214 c
 215       end