src/tool/HOMARD_00/homajc.F

   1       subroutine homajc ( codret )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c   HOmard : Mise A Jour des Coordonnees
  23 c   --       -    - -        -
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . codret . es  .    1   . code de retour des modules                 .
  29 c .        .     .        . en entree = celui du module d'avant        .
  30 c .        .     .        . en sortie = celui du module en cours       .
  31 c .        .     .        . 0 : pas de probleme                        .
  32 c .        .     .        . 1 : manque de temps cpu                    .
  33 c .        .     .        . 2x : probleme dans les memoires            .
  34 c .        .     .        . 3x : probleme dans les fichiers            .
  35 c .        .     .        . 5 : mauvaises options                      .
  36 c .        .     .        . 6 : problemes dans les noms d'objet        .
  37 c .        .     .        . 7 : non convergence de l'algorithme        .
  38 c ______________________________________________________________________
  39 c
  40 c
  41 c====
  42 c 0. declarations et dimensionnement
  43 c====
  44 c
  45 c 0.1. ==> generalites
  46 c
  47       implicit none
  48       save
  49 c
  50       character*6 nompro
  51       parameter ( nompro = 'HOMAJC' )
  52 c
  53 #include "nblang.h"
  54 #include "motcle.h"
  55 c
  56 c 0.2. ==> communs
  57 c
  58 #include "envex1.h"
  59 c
  60 #include "gmenti.h"
  61 #include "gmstri.h"
  62 c
  63 #include "cndoad.h"
  64 #include "nombtr.h"
  65 #include "nombqu.h"
  66 #include "envada.h"
  67 c
  68 #include "nombpe.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       integer codret
  73 c
  74 c 0.4. ==> variables locales
  75 c
  76       integer ulsort, langue, codava
  77       integer adopti, lgopti
  78       integer adopts, lgopts
  79       integer adetco, lgetco
  80       integer nrsect, nrssse
  81       integer nretap, nrsset
  82       integer iaux
  83       integer codre0
  84       integer codre1, codre2
  85       integer nbnhom, nbncal
  86 c
  87       character*6 saux
  88       character*8 nohman, nocman
  89 c
  90       integer nbmess
  91       parameter ( nbmess = 10 )
  92       character*80 texte(nblang,nbmess)
  93 c
  94 c 0.5. ==> initialisations
  95 c ______________________________________________________________________
  96 c
  97 c====
  98 c 1. les initialisations
  99 c====
 100 c
 101 #include "impr03.h"
 102 c
 103       codava = codret
 104 c
 105 c=======================================================================
 106       if ( codava.eq.0 ) then
 107 c=======================================================================
 108 c
 109 #ifdef _DEBUG_HOMARD_
 110       call gmprsx (nompro, nndoad )
 111       call gmprsx (nompro, nndoad//'.OptEnt' )
 112       call gmprsx (nompro, nndoad//'.OptRee' )
 113       call gmprsx (nompro, nndoad//'.OptCar' )
 114       call gmprsx (nompro, nndoad//'.EtatCour' )
 115 #endif
 116 c
 117 c 1.2. ==> le numero d'unite logique de la liste standard
 118 c
 119       call utulls ( ulsort, codret )
 120 c
 121 c 1.3. ==> la langue des messages
 122 c
 123       call gmadoj ( nndoad//'.OptEnt', adopti, lgopti, codret )
 124       if ( codret.eq.0 ) then
 125         langue = imem(adopti)
 126       else
 127         langue = 1
 128         codret = 2
 129       endif
 130 c
 131 #include "impr01.h"
 132 c
 133 c 1.4. ==> l'etat courant
 134 c
 135       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 136       if ( codret.eq.0 ) then
 137         nretap = imem(adetco) + 1
 138         imem(adetco) = nretap
 139         nrsset = -1
 140         imem(adetco+1) = nrsset
 141         nrsect = imem(adetco+2) + 10
 142         imem(adetco+2) = nrsect
 143         nrssse = nrsect
 144         imem(adetco+3) = nrssse
 145       else
 146         nretap = -1
 147         nrsset = -1
 148         nrsect = 200
 149         nrssse = nrsect
 150         codret = 2
 151       endif
 152 c
 153 #ifdef _DEBUG_HOMARD_
 154       write (ulsort,texte(langue,1)) 'Entree', nompro
 155       call dmflsh (iaux)
 156 #endif
 157 c
 158 c 1.4. ==> le debut des mesures de temps
 159 c
 160       call gtdems (nrsect)
 161 c
 162 c 1.5. ==> les messages
 163 c
 164       texte(1,4) =
 165      > '(//,a6,'' M I S E    A    J O U R    C O O R D O N N E E S'')'
 166       texte(1,5) = '(55(''=''),/)'
 167       texte(1,6) = '(''Incoherence des nombres de noeuds'')'
 168 c
 169       texte(2,4) =
 170      > '(//,a6,'' U P D A T I N G    O F    C O O R D I N A T E S'')'
 171       texte(2,5) = '(54(''=''),/)'
 172       texte(2,6) = '(''Non coherence for the number of nodes'')'
 173 c
 174 c 1.6. ==> le titre
 175 c
 176       call utcvne ( nretap, nrsset, saux, iaux, codret )
 177 c
 178       write (ulsort,texte(langue,4)) saux
 179       write (ulsort,texte(langue,5))
 180 c
 181       nrsset = 0
 182       imem(adetco+1) = nrsset
 183 c
 184 c 1.7. ==> les noms d'objets a conserver
 185 c
 186       if ( codret.eq.0 ) then
 187         call gmadoj ( nndoad//'.OptCar', adopts, lgopts, codret )
 188         if ( codret.ne.0 ) then
 189           codret = 2
 190         endif
 191       endif
 192 c
 193 c====
 194 c 2. les structures de base
 195 c====
 196 #ifdef _DEBUG_HOMARD_
 197       write (ulsort,90002) '2. les structures de base ; codret', codret
 198 #endif
 199 c
 200 c 2.1. ==> le maillage homard
 201 c
 202       if ( codret.eq.0 ) then
 203 c
 204       nohman = smem(adopts+2)
 205 #ifdef _DEBUG_HOMARD_
 206       write (ulsort,*) 'nohman : ', nohman
 207 #endif
 208 c
 209       endif
 210 c
 211 c 2.2. ==> le maillage de calcul
 212 c
 213       if ( codret.eq.0 ) then
 214 c
 215       nocman = smem(adopts)
 216 #ifdef _DEBUG_HOMARD_
 217       write (ulsort,*) 'nocman : ', nocman
 218 #endif
 219 c
 220       endif
 221 c
 222 c====
 223 c 3. mise a jour des coordonnees
 224 c====
 225 c
 226 #ifdef _DEBUG_HOMARD_
 227       write (ulsort,90002) '3. maj des coordonnees ; codret', codret
 228 #endif
 229 #ifdef _DEBUG_HOMARD_
 230       call gmprsx (nompro//' - HOMARD', nohman//'.Noeud')
 231       call gmprsx (nompro//' - Calcul', nocman//'.Noeud')
 232 #endif
 233 c
 234 c 3.1. ==> verification de la coherence du nombre de noeuds
 235 c
 236       if ( codret.eq.0 ) then
 237 c
 238       call gmliat ( nohman//'.Noeud', 1, nbnhom, codre1 )
 239       call gmliat ( nocman//'.Noeud', 1, nbncal, codre2 )
 240 c
 241       codre0 = min ( codre1, codre2  )
 242       codret = max ( abs(codre0), codret,
 243      >               codre1, codre2  )
 244 c
 245       endif
 246 c
 247       if ( codret.eq.0 ) then
 248 c
 249 #ifdef _DEBUG_HOMARD_
 250       write (ulsort,90002) 'nbnhom', nbnhom
 251       write (ulsort,90002) 'nbncal', nbncal
 252 #endif
 253 c
 254       if ( nbnhom.ne.nbncal ) then
 255         write (ulsort,texte(langue,6))
 256         write (ulsort,90002) 'HOMARD', nbnhom
 257         write (ulsort,90002) 'Calcul', nbncal
 258         codret = 31
 259       endif
 260 c
 261       endif
 262 c
 263 c 3.2. ==> Copie des coordonnees
 264 c
 265       if ( codret.eq.0 ) then
 266 c
 267 #ifdef _DEBUG_HOMARD_
 268       call gmprot (nompro//' - Calcul', nocman//'.Noeud.Coor',
 269      >             3*nbnhom-9, 3*nbnhom)
 270       call gmprot (nompro//' - HOMARD avant', nohman//'.Noeud.Coor',
 271      >             3*nbnhom-9, 3*nbnhom)
 272 #endif
 273 c
 274       call gmcpoj ( nocman//'.Noeud.Coor',
 275      >              nohman//'.Noeud.Coor', codret )
 276 c
 277 #ifdef _DEBUG_HOMARD_
 278       call gmprot (nompro//' - HOMARD apres', nohman//'.Noeud.Coor',
 279      >             3*nbnhom-9, 3*nbnhom)
 280 #endif
 281 c
 282       endif
 283 c
 284 c====
 285 c 4. la fin
 286 c====
 287 c
 288 #ifdef _DEBUG_HOMARD_
 289       write (ulsort,90002) '4. fin de '//nompro//' ; codret', codret
 290 #endif
 291 c
 292 c 4.1. ==> message si erreur
 293 c
 294       if ( codret.ne.0 ) then
 295 c
 296 #include "envex2.h"
 297 c
 298         write (ulsort,texte(langue,1)) 'Sortie', nompro
 299         write (ulsort,texte(langue,2)) codret
 300 c
 301       endif
 302 c
 303 c 4.2. ==> fin des mesures de temps de la section
 304 c
 305       call gtfims (nrsect)
 306 c
 307 #ifdef _DEBUG_HOMARD_
 308       write (ulsort,texte(langue,1)) 'Sortie', nompro
 309       call dmflsh (iaux)
 310 #endif
 311 c
 312 c=======================================================================
 313       endif
 314 c=======================================================================
 315 c
 316       end