src/tool/Modification/mmmodi.F

   1       subroutine mmmodi ( 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  Modification de Maillage - Modification
  23 c  -               -          ----
  24 c
  25 c remarque : on n'execute ce programme que si le precedent s'est
  26 c            bien passe
  27 c
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . codret . es  .    1   . code de retour des modules                 .
  33 c .        .     .        . en entree = celui du module d'avant        .
  34 c .        .     .        . en sortie = celui du module en cours       .
  35 c .        .     .        . 0 : pas de probleme                        .
  36 c .        .     .        . 1 : manque de temps cpu                    .
  37 c .        .     .        . 2x : probleme dans les memoires            .
  38 c .        .     .        . 3x : probleme dans les fichiers            .
  39 c .        .     .        . 5 : mauvaises options                      .
  40 c .        .     .        . 6 : problemes dans les noms d'objet        .
  41 c ______________________________________________________________________
  42 c
  43 c====
  44 c 0. declarations et dimensionnement
  45 c====
  46 c
  47 c 0.1. ==> generalites
  48 c
  49       implicit none
  50       save
  51 c
  52       character*6 nompro
  53       parameter ( nompro = 'MMMODI' )
  54 c
  55 #include "motcle.h"
  56 #include "nblang.h"
  57 c
  58 c 0.2. ==> communs
  59 c
  60 #include "gmenti.h"
  61 #include "cndoad.h"
  62 c
  63 c 0.3. ==> arguments
  64 c
  65       integer codret
  66 c
  67 c 0.4. ==> variables locales
  68 c
  69       integer ulsort, langue, codava
  70       integer adopti, lgopti
  71       integer adetco, lgetco
  72       integer nrsect, nrssse
  73       integer nretap, nrsset
  74       integer iaux
  75       integer codre0
  76       integer codre1, codre2
  77 c
  78       integer ulenst, ulsost
  79 c
  80       character*6 saux
  81       character*8 typobs, nohman, nohmap
  82 c
  83       integer nbmess
  84       parameter ( nbmess = 10 )
  85       character*80 texte(nblang,nbmess)
  86 c
  87 c 0.5. ==> initialisations
  88 c ______________________________________________________________________
  89 c
  90 c====
  91 c 1. les initialisations
  92 c====
  93 c
  94       codava = codret
  95 c
  96 c=======================================================================
  97       if ( codava.eq.0 ) then
  98 c=======================================================================
  99 c
 100 #ifdef _DEBUG_HOMARD_
 101       call gmprsx (nompro, nndoad )
 102       call gmprsx (nompro, nndoad//'.OptEnt' )
 103       call gmprsx (nompro, nndoad//'.OptRee' )
 104       call gmprsx (nompro, nndoad//'.OptCar' )
 105       call gmprsx (nompro, nndoad//'.EtatCour' )
 106 #endif
 107 c
 108 c 1.2. ==> le numero d'unite logique de la liste standard
 109 c
 110       call utulls ( ulsort, codret )
 111 c
 112 c 1.3. ==> la langue des messages
 113 c
 114       call gmadoj ( nndoad//'.OptEnt', adopti, lgopti, codret )
 115       if ( codret.eq.0 ) then
 116         langue = imem(adopti)
 117       else
 118         langue = 1
 119         codret = 2
 120       endif
 121 c
 122 c 1.4. ==> l'etat courant
 123 c
 124       call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
 125 c
 126       if ( codret.eq.0 ) then
 127         nretap = imem(adetco) + 1
 128         imem(adetco) = nretap
 129         nrsset = -1
 130         imem(adetco+1) = nrsset
 131         nrsect = imem(adetco+2) + 10
 132         imem(adetco+2) = nrsect
 133         nrssse = nrsect
 134         imem(adetco+3) = nrssse
 135       else
 136         nretap = -1
 137         nrsset = -1
 138         nrsect = 200
 139         nrssse = nrsect
 140         codret = 2
 141       endif
 142 c
 143 c 1.4. ==> le debut des mesures de temps
 144 c
 145       call gtdems (nrsect)
 146 c
 147 c 1.5. ==> les messages
 148 c
 149 #include "impr01.h"
 150 c
 151 #ifdef _DEBUG_HOMARD_
 152       write (ulsort,texte(langue,1)) 'Entree', nompro
 153       call dmflsh (iaux)
 154 #endif
 155 c
 156       texte(1,4) =
 157      > '(//,a6,'//
 158      >''' M O D I F I C A T I O N    D E    M A I L L A G E'')'
 159       texte(1,5) = '(56(''=''),/)'
 160       texte(1,7) = '(''Changement de degre :'',i4)'
 161       texte(1,8) = '(''Creation de joints  :'',i4)'
 162 c
 163       texte(2,4) = '(//,a6,'' M E S H    M O D I F I C A T I O N'')'
 164       texte(2,5) = '(50(''=''),/)'
 165       texte(2,7) = '(''Modification of degree :'',i4)'
 166       texte(2,8) = '(''Creation of junctions  :'',i4)'
 167 c
 168 c 1.6. ==> le titre
 169 c
 170       call utcvne ( nretap, nrsset, saux, iaux, codret )
 171 c
 172       write (ulsort,texte(langue,4)) saux
 173       write (ulsort,texte(langue,5))
 174 c
 175       nrsset = 0
 176       imem(adetco+1) = nrsset
 177 c
 178 c 1.7. ==> les numeros d'unite logique au terminal
 179 c
 180       call dmunit ( ulenst, ulsost )
 181 c
 182 c====
 183 c 2. les structures de base
 184 c====
 185 c
 186 c 2.1. ==> le maillage homard a l'iteration n
 187 c
 188       typobs = mchman
 189       iaux = 0
 190       call utosno ( typobs, nohman, iaux, ulsort, langue, codre1 )
 191 c
 192 c 2.2. ==> le maillage homard a l'iteration n+1
 193 c
 194       typobs = mchmap
 195       iaux = 0
 196       call utosno ( typobs, nohmap, iaux, ulsort, langue, codre2 )
 197 c
 198 c 2.3. ==> bilan
 199 c
 200       codre0 = min ( codre1, codre2 )
 201       codret = max ( abs(codre0), codret,
 202      >               codre1, codre2 )
 203 c
 204 c====
 205 c 3. Compactage de la memoire
 206 c====
 207 #ifdef _DEBUG_HOMARD_
 208       write (ulsort,*) '3. Compactage ; codret = ', codret
 209 #endif
 210 c
 211       if ( codret.eq.0 ) then
 212 c
 213 #ifdef _DEBUG_HOMARD_
 214       write (ulsort,texte(langue,3)) 'UTCOMP', nompro
 215 #endif
 216 c
 217       call utcomp (ulsort, langue, codret)
 218 c
 219       endif
 220 c
 221 c====
 222 c 4. Modifications du maillage
 223 c====
 224 c
 225       if ( codret.eq.0 ) then
 226 c
 227 #ifdef _DEBUG_HOMARD_
 228       write (ulsort,texte(langue,7)) imem(adopti+40)
 229       write (ulsort,texte(langue,8)) imem(adopti+41)
 230 #endif
 231 c
 232 c 4.1. ==> Modification du degre du maillage
 233 c
 234       imem(adetco+3) = imem(adetco+3) + 1
 235 c
 236       if ( imem(adopti+40).eq.1 ) then
 237 c
 238       if ( codret.eq.0 ) then
 239 c
 240 #ifdef _DEBUG_HOMARD_
 241       write (ulsort,texte(langue,3)) 'MMDEGR', nompro
 242 #endif
 243 c
 244         call mmdegr ( lgopti, imem(adopti), lgetco, imem(adetco),
 245      >                nohman,
 246      >                ulsort, langue, codret )
 247 c
 248       endif
 249 c
 250       endif
 251 c
 252 c 4.2. ==> Creation de joints
 253 c
 254       imem(adetco+3) = imem(adetco+3) + 1
 255 c
 256       if ( imem(adopti+41).eq.1 ) then
 257 c
 258       if ( codret.eq.0 ) then
 259 c
 260 #ifdef _DEBUG_HOMARD_
 261       write (ulsort,texte(langue,3)) 'MMAGRE', nompro
 262 #endif
 263 c
 264         call mmagre ( lgopti, imem(adopti), lgetco, imem(adetco),
 265      >                nohman,
 266      >                ulsort, langue, codret )
 267 c
 268       endif
 269 c
 270       endif
 271 c
 272       endif
 273 c
 274 c====
 275 c 5. transfert du maillage dans la structure de l'iteration n+1
 276 c====
 277 c
 278       if ( codret.eq.0 ) then
 279 c
 280 #ifdef _DEBUG_HOMARD_
 281       write (ulsort,texte(langue,3)) 'CMTRNP', nompro
 282 #endif
 283 c
 284       iaux = 1
 285       call cmtrnp ( nohman, nohmap, iaux,
 286      >              lgopti, imem(adopti), lgetco, imem(adetco),
 287      >              ulsort, langue, codret )
 288 c
 289       endif
 290 c
 291 c====
 292 c 6. la fin
 293 c====
 294 c
 295 c 6.1. ==> message si erreur
 296 c
 297       if ( codret.ne.0 ) then
 298 c
 299         write (ulsort,texte(langue,1)) 'Sortie', nompro
 300         write (ulsort,texte(langue,2)) codret
 301 c
 302       endif
 303 c
 304 c 6.2. ==> fin des mesures de temps de la section
 305 c
 306       call gtfims (nrsect)
 307 c
 308       imem(adetco+2) = imem(adetco+2) + 20
 309 c
 310 #ifdef _DEBUG_HOMARD_
 311       write (ulsort,texte(langue,1)) 'Sortie', nompro
 312       call dmflsh (iaux)
 313 #endif
 314 c
 315 c=======================================================================
 316       endif
 317 c=======================================================================
 318 c
 319       end