src/tool/AP_Conversion/pcstr2_5.h

   1 #ifdef _DEBUG_HOMARD_
   2       write (ulsort,texte(langue,1)) 'Entree', 'pcstr2_5'
   3 #endif
   4 c
   5 c         on repere le numero dans le calcul pour le fils aine
   6 c         a l'iteration n
   7 c
   8           f1hn = anfitr(trhn)
   9           f1hp = filtri(trhnp1)
  10           f1cn = ntreca(f1hn)
  11           prf1cn = prfcan(f1cn)
  12 cgn          print 17893, prf1cn
  13 cgn17893 format('prf1cn = ',i8)
  14 c
  15           if ( etanp1.eq.0 ) then
  16             trcnp1 = ntrsca(trhnp1)
  17             prfcap(trcnp1) = 1
  18           elseif ( etanp1.eq.1 .or. etanp1.eq.2 .or. etanp1.eq.3 ) then
  19             f1cp = ntrsca(f1hp)
  20             f2cp = ntrsca(f1hp+1)
  21 cgn          print 17894, f1cp,f2cp
  22 cgn17894 format('f1cp = ',i8,', f2cp = ',i8)
  23             prfcap(f1cp) = 1
  24             prfcap(f2cp) = 1
  25           endif
  26 c
  27 c doc.4.0. ===> etanp1 = 0 : le triangle est actif ; il est reactive.
  28 c               remarque : cela arrive seulement avec du deraffinement.
  29 c                   .                         .
  30 c                  . .                       . .
  31 c                 .   .                     .   .
  32 c                .     .                   .     .
  33 c               .........      ===>       .       .
  34 c              . .     . .               .         .
  35 c             .   .   .   .             .           .
  36 c            .     . .     .           .             .
  37 c           .................         .................
  38 c
  39           if ( etanp1.eq.0 ) then
  40 cgn        print *,'Passage par etanp1.eq.0'
  41 c
  42             f2cn = ntreca(f1hn+1)
  43             f3cn = ntreca(f1hn+2)
  44             f4cn = ntreca(f1hn+3)
  45             prf2cn = prfcan(f2cn)
  46             prf3cn = prfcan(f3cn)
  47             prf4cn = prfcan(f4cn)
  48 c
  49             do 241 , nrofon = 1 , nbfonc
  50 c
  51               vafott(nrofon,q1,trcnp1) = vafoen(nrofon,q1,prf2cn)
  52               vafott(nrofon,q2,trcnp1) = vafoen(nrofon,q2,prf3cn)
  53               vafott(nrofon,q3,trcnp1) = vafoen(nrofon,q3,prf4cn)
  54               vafott(nrofon,q4,trcnp1) =
  55      >                    unstr * ( vafoen(nrofon,q1,prf3cn)
  56      >                            + vafoen(nrofon,q2,prf2cn)
  57      >                            + vafoen(nrofon,q3,prf1cn) )
  58               vafott(nrofon,q5,trcnp1) =
  59      >                    unstr * ( vafoen(nrofon,q1,prf1cn)
  60      >                            + vafoen(nrofon,q2,prf4cn)
  61      >                            + vafoen(nrofon,q3,prf3cn) )
  62               vafott(nrofon,q6,trcnp1) =
  63      >                    unstr * ( vafoen(nrofon,q1,prf4cn)
  64      >                            + vafoen(nrofon,q2,prf1cn)
  65      >                            + vafoen(nrofon,q3,prf2cn) )
  66 c
  67   241       continue
  68 c
  69 c doc.4.1/2/3. ===> etanp1 = 1 : le triangle est decoupe en deux selon
  70 c                                l'arete 1
  71 c                  remarque : il y a 4 cas de figure selon les decoupages
  72 c                             eventuels des fils a l'iteration n
  73 c                  remarque : cela arrive seulement avec du
  74 c                             deraffinnement.
  75 c
  76           elseif ( etanp1.eq.1 ) then
  77 cgn        print *,'Passage par etanp1.eq.1'
  78 c
  79             f2cn = ntreca(f1hn+1)
  80             prf2cn = prfcan(f2cn)
  81             g1 = 0
  82             d1 = 0
  83 cgn            write(6,*) 'etanp1', etanp1
  84 cgn            write(6,*) 'f1hn+2=',f1hn+2,
  85 cgn     > 'mod(anhetr(f1hn+2),10)',mod(anhetr(f1hn+2),10)
  86             if ( mod(anhetr(f1hn+2),10).eq.0 ) then
  87               f3cn = ntreca(f1hn+2)
  88               prf3cn = prfcan(f3cn)
  89             elseif ( mod(anhetr(f1hn+2),10).eq.etanp1 ) then
  90               pf = anfitr(f1hn+2)
  91               g2 = ntreca(pf)
  92               prfg2n = prfcan(g2)
  93               g1 = ntreca(pf+1)
  94               prfg1n = prfcan(g1)
  95             else
  96               codret = codret + 1
  97               write(ulsort,*) '_5h A codret', codret
  98               write (ulsort,texte(langue,4)) 'n  ', trhn
  99               write (ulsort,texte(langue,5)) 'n  ', etan
 100               write (ulsort,texte(langue,4)) 'n+1', trhnp1
 101               write (ulsort,texte(langue,5)) 'n+1', etanp1
 102             endif
 103 cgn            write(6,*) 'etanp1', etanp1
 104 cgn            write(6,*) 'mod(anhetr(f1hn+3),10)',mod(anhetr(f1hn+3),10)
 105             if ( mod(anhetr(f1hn+3),10).eq.0 ) then
 106               f4cn = ntreca(f1hn+3)
 107               prf4cn = prfcan(f4cn)
 108             elseif ( mod(anhetr(f1hn+3),10).eq.etanp1 ) then
 109               pf = anfitr(f1hn+3)
 110               d2 = ntreca(pf)
 111               prfd2n = prfcan(d2)
 112               d1 = ntreca(pf+1)
 113               prfd1n = prfcan(d1)
 114             else
 115               codret = codret + 1
 116               write (ulsort,*) '_5h B codret', codret
 117               write (ulsort,texte(langue,4)) 'n  ', trhn
 118               write (ulsort,texte(langue,5)) 'n  ', etan
 119               write (ulsort,texte(langue,4)) 'n+1', trhnp1
 120               write (ulsort,texte(langue,5)) 'n+1', etanp1
 121             endif
 122 c
 123             if  ( g1.eq.0 .and. d1.eq.0 ) then
 124 c
 125 c                   .                         .
 126 c                  . .                       ...
 127 c                 .   .                     . . .
 128 c                .     .                   .  .  .
 129 c               .........      ===>       .   .   .
 130 c              . .     . .               .    .    .
 131 c             .   .   .   .             .     .     .
 132 c            .     . .     .           .      .      .
 133 c           .................         .................
 134 c                  A1                         A1
 135 c
 136 c
 137               do 24210 , nrofon = 1 , nbfonc
 138 c
 139 c        Pour le triangle fils aine NF
 140 c
 141                 vafott(nrofon,q1,f1cp) = vafoen(nrofon,q1,prf2cn)
 142 c
 143                 vafott(nrofon,q2,f1cp) = unstr*vafoen(nrofon,q1,prf1cn)
 144      >                                  +destr*vafoen(nrofon,q2,prf4cn)
 145 c
 146                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 147 c
 148                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q5,prf1cn)
 149      >                                        +vafoen(nrofon,q5,prf2cn))
 150 c
 151                 vafott(nrofon,q5,f1cp) = vafoen(nrofon,q5,prf4cn)
 152 c
 153                 vafott(nrofon,q6,f1cp) = unstr*(vafoen(nrofon,q1,prf4cn)
 154      >                                        +vafoen(nrofon,q2,prf1cn)
 155      >                                        +vafoen(nrofon,q3,prf2cn))
 156 c
 157 c        Pour le triangle fils NF+1
 158 c
 159                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 160 c
 161                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prf3cn)
 162 c
 163                 vafott(nrofon,q3,f2cp) = unstr*vafoen(nrofon,q1,prf1cn)+
 164      >                                   destr*vafoen(nrofon,q3,prf3cn)
 165 c
 166                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q1,prf3cn)
 167      >                                        +vafoen(nrofon,q2,prf2cn)
 168      >                                        +vafoen(nrofon,q3,prf1cn))
 169 c
 170               vafott(nrofon,q5,f2cp) = vafoen(nrofon,q5,prf3cn)
 171 c
 172               vafott(nrofon,q6,f2cp) = vafott(nrofon,q4,f1cp)
 173 c
 174 24210         continue
 175 c
 176             elseif  ( g1.ne.0 .and. d1.eq.0 ) then
 177 c
 178 c                   .                         .
 179 c                  . .                       ...
 180 c                 .   .                     . . .
 181 c                .     .                   .  .  .
 182 c               .........      ===>       .   .   .
 183 c              ...     . .               .    .    .
 184 c             . . .   .   .             .     .     .
 185 c            .  .  . .     .           .      .      .
 186 c           .................         .................
 187 c                  A1                         A1
 188 c
 189               do 24211 , nrofon = 1 , nbfonc
 190 c
 191 c        Pour le triangle fils aine NF
 192 c
 193                 vafott(nrofon,q1,f1cp) = vafoen(nrofon,q1,prf2cn)
 194 c
 195                 vafott(nrofon,q2,f1cp) = unstr*vafoen(nrofon,q1,prf1cn)+
 196      >                                   destr*vafoen(nrofon,q2,prf4cn)
 197 c
 198                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 199 c
 200                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q5,prf1cn)
 201      >                                        +vafoen(nrofon,q5,prf2cn))
 202 c
 203                 vafott(nrofon,q5,f1cp) = vafoen(nrofon,q5,prf4cn)
 204 c
 205                 vafott(nrofon,q6,f1cp) = unstr*(vafoen(nrofon,q1,prf4cn)
 206      >                                        +vafoen(nrofon,q2,prf1cn)
 207      >                                        +vafoen(nrofon,q3,prf2cn))
 208 c
 209 c        Pour le triangle fils NF+1
 210 c
 211                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 212 c
 213                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prfg1n)
 214 c
 215                 vafott(nrofon,q3,f2cp) = unstr*vafoen(nrofon,q1,prf1cn)
 216      >                                  +destr*vafoen(nrofon,q3,prfg2n)
 217 c
 218                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q3,prf1cn)
 219      >                                      +vafoen(nrofon,q2,prf2cn))+
 220      >                           unsqu*destr*(vafoen(nrofon,q1,prfg1n)
 221      >                                      +vafoen(nrofon,q2,prfg2n))
 222 c
 223               vafott(nrofon,q5,f2cp) = unsde*(vafoen(nrofon,q5,prfg1n)+
 224      >                                        vafoen(nrofon,q5,prfg2n))
 225 c
 226               vafott(nrofon,q6,f2cp) = vafott(nrofon,q4,f1cp)
 227 c
 228 24211         continue
 229 c
 230 c
 231             elseif  ( g1.eq.0 .and. d1.ne.0 ) then
 232 c                   .                         .
 233 c                  . .                       ...
 234 c                 .   .                     . . .
 235 c                .     .                   .  .  .
 236 c               .........      ===>       .   .   .
 237 c              . .     ...               .    .    .
 238 c             .   .   . . .             .     .     .
 239 c            .     . .  .  .           .      .      .
 240 c           .................         .................
 241 c                  A1                         A1
 242 c
 243               do 24212 , nrofon = 1 , nbfonc
 244 c
 245 c        Pour le triangle fils aine NF
 246 c
 247                 vafott(nrofon,q1,f1cp) = vafoen(nrofon,q1,prf2cn)
 248 c
 249                 vafott(nrofon,q2,f1cp) = unstr*vafoen(nrofon,q1,prf1cn)+
 250      >                                   destr*vafoen(nrofon,q2,prfd1n)
 251 c
 252                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prfd2n)
 253 c
 254                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q5,prf1cn)
 255      >                                        +vafoen(nrofon,q5,prf2cn))
 256 c
 257                 vafott(nrofon,q5,f1cp) = unsde*(vafoen(nrofon,q3,prfd1n)
 258      >                                        +vafoen(nrofon,q2,prfd2n))
 259 c
 260                 vafott(nrofon,q6,f1cp) = unstr*(vafoen(nrofon,q3,prf2cn)
 261      >                                       +vafoen(nrofon,q2,prf1cn))+
 262      >                            unsqu*destr*(vafoen(nrofon,q1,prfd1n)
 263      >                                       +vafoen(nrofon,q1,prfd2n))
 264 c
 265 c        Pour le triangle fils NF+1
 266 c
 267                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 268 c
 269                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prf3cn)
 270 c
 271                 vafott(nrofon,q3,f2cp) = unstr*vafoen(nrofon,q1,prf1cn)+
 272      >                                   destr*vafoen(nrofon,q3,prf3cn)
 273 c
 274                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q1,prf3cn)
 275      >                                        +vafoen(nrofon,q2,prf2cn)
 276      >                                        +vafoen(nrofon,q3,prf1cn))
 277 c
 278               vafott(nrofon,q5,f2cp) = vafoen(nrofon,q5,prf3cn)
 279 c
 280               vafott(nrofon,q6,f2cp) = vafott(nrofon,q4,f1cp)
 281 c
 282 24212         continue
 283 c
 284
 285             else
 286 c
 287 c                   .                         .
 288 c                  . .                       ...
 289 c                 .   .                     . . .
 290 c                .     .                   .  .  .
 291 c               .........      ===>       .   .   .
 292 c              ...     ...               .    .    .
 293 c             . . .   . . .             .     .     .
 294 c            .  .  . .  .  .           .      .      .
 295 c           .................         .................
 296 c                  A1                         A1
 297 c
 298               do 24213 , nrofon = 1 , nbfonc
 299 c
 300 c        Pour le triangle fils aine NF
 301 c
 302                 vafott(nrofon,q1,f1cp) = vafoen(nrofon,q1,prf2cn)
 303 c
 304                 vafott(nrofon,q2,f1cp) = unstr*vafoen(nrofon,q1,prf1cn)+
 305      >                                   destr*vafoen(nrofon,q2,prfd1n)
 306 c
 307                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prfd2n)
 308 c
 309                 vafott(nrofon,q4,f1cp)=unsde*(vafoen(nrofon,q5,prf1cn)+
 310      >                                       vafoen(nrofon,q5,prf2cn))
 311 c
 312                 vafott(nrofon,q5,f1cp)=unsde*(vafoen(nrofon,q3,prfd1n)+
 313      >                                        vafoen(nrofon,q2,prfd2n))
 314 c
 315                 vafott(nrofon,q6,f1cp) = unstr*(vafoen(nrofon,q3,prf2cn)
 316      >                                      +vafoen(nrofon,q2,prf1cn))+
 317      >                           unsqu*destr*(vafoen(nrofon,q1,prfd1n)
 318      >                                      +vafoen(nrofon,q1,prfd2n))
 319 c
 320 c        Pour le triangle fils NF+1
 321 c
 322                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 323 c
 324                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prfg1n)
 325 c
 326                 vafott(nrofon,q3,f2cp) = unstr*vafoen(nrofon,q1,prf1cn)+
 327      >                                   destr*vafoen(nrofon,q3,prfg2n)
 328 c
 329                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q3,prf1cn)
 330      >                                       +vafoen(nrofon,q2,prf2cn))+
 331      >                             unsqu*destr*(vafoen(nrofon,q1,prfg1n)
 332      >                                       +vafoen(nrofon,q2,prfg2n))
 333 c
 334                 vafott(nrofon,q5,f2cp) = unsde*(vafoen(nrofon,q5,prfg1n)
 335      >                                        +vafoen(nrofon,q5,prfg2n))
 336 c
 337                 vafott(nrofon,q6,f2cp) = vafott(nrofon,q4,f1cp)
 338 c
 339 24213         continue
 340 c
 341             endif
 342 c
 343 c doc.4.1/2/3. ===> etanp1 = 2 : le triangle est decoupe en deux selon
 344 c                                l'arete 2
 345 c
 346           elseif ( etanp1.eq.2  ) then
 347 cgn        print *,'Passage par etanp1.eq.2'
 348 c
 349             f3cn = ntreca(f1hn+2)
 350             prf3cn = prfcan(f3cn)
 351             g1 = 0
 352             d1 = 0
 353             if ( mod(anhetr(f1hn+1),10).eq.0 ) then
 354               f2cn = ntreca(f1hn+1)
 355               prf2cn = prfcan(f2cn)
 356             elseif ( mod(anhetr(f1hn+1),10).eq.etanp1 ) then
 357               pf = anfitr(f1hn+1)
 358               d2 = ntreca(pf+1)
 359               prfd2n = prfcan(d2)
 360               d1 = ntreca(pf)
 361               prfd1n = prfcan(d1)
 362             else
 363               codret = codret + 1
 364               write (ulsort,*) '_5h C codret', codret
 365               write (ulsort,texte(langue,4)) 'n  ', trhn
 366               write (ulsort,texte(langue,5)) 'n  ', etan
 367               write (ulsort,texte(langue,4)) 'n+1', trhnp1
 368               write (ulsort,texte(langue,5)) 'n+1', etanp1
 369             endif
 370             if ( mod(anhetr(f1hn+3),10).eq.0 ) then
 371               f4cn = ntreca(f1hn+3)
 372               prf4cn = prfcan(f4cn)
 373             elseif ( mod(anhetr(f1hn+3),10).eq.etanp1 ) then
 374               pf = anfitr(f1hn+3)
 375               g2 = ntreca(pf+1)
 376               prfg2n = prfcan(g2)
 377               g1 = ntreca(pf)
 378               prfg1n = prfcan(g1)
 379             else
 380               codret = codret + 1
 381               write (ulsort,*) '_5h D codret', codret
 382               write (ulsort,texte(langue,4)) 'n  ', trhn
 383               write (ulsort,texte(langue,5)) 'n  ', etan
 384               write (ulsort,texte(langue,4)) 'n+1', trhnp1
 385               write (ulsort,texte(langue,5)) 'n+1', etanp1
 386             endif
 387 c
 388             if  ( g1.eq.0 .and. d1.eq.0 ) then
 389 c
 390 c
 391 c                   .                         .
 392 c                  . .                       ...
 393 c                 .   .                     . . .
 394 c                .     .                   .  .  .
 395 c               .........      ===>       .   .   .
 396 c              . .     . .               .    .    .
 397 c             .   .   .   .             .     .     .
 398 c            .     . .     .           .      .      .
 399 c           .................         .................
 400 c                  A2                         A2
 401 c
 402 c
 403 c
 404               do 24220 , nrofon = 1 , nbfonc
 405 c
 406 c        Pour le triangle fils aine NF
 407 c
 408                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q1,prf4cn)+
 409      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 410 c
 411                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prf3cn)
 412 c
 413                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 414 c
 415                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q6,prf1cn)
 416      >                                        +vafoen(nrofon,q6,prf3cn))
 417                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 418      >                                        +vafoen(nrofon,q2,prf4cn)
 419      >                                        +vafoen(nrofon,q3,prf3cn))
 420 c
 421                 vafott(nrofon,q6,f1cp) = vafoen(nrofon,q6,prf4cn)
 422 c
 423 c        Pour le triangle fils NF+1
 424 c
 425                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 426 c
 427                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prf3cn)
 428 c
 429                 vafott(nrofon,q3,f2cp) = destr*vafoen(nrofon,q3,prf2cn)+
 430      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 431 c
 432                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q1,prf3cn)
 433      >                                        +vafoen(nrofon,q2,prf2cn)
 434      >                                        +vafoen(nrofon,q3,prf1cn))
 435 c
 436                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q4,f1cp)
 437 c
 438                 vafott(nrofon,q6,f2cp) = vafoen(nrofon,q6,prf2cn)
 439 c
 440 24220        continue
 441 c
 442 c
 443             elseif  ( g1.ne.0 .and. d1.eq.0 ) then
 444 c
 445 c                   .                         .
 446 c                  . .                       ...
 447 c                 .   .                     . . .
 448 c                .     .                   .  .  .
 449 c               .........      ===>       .   .   .
 450 c              ...     . .               .    .    .
 451 c             . . .   .   .             .     .     .
 452 c            .  .  . .     .           .      .      .
 453 c           .................         .................
 454 c                  A2                         A2
 455 c
 456 c
 457               do 24221 , nrofon = 1 , nbfonc
 458 c
 459 c        Pour le triangle fils aine NF
 460 c
 461                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q1,prf4cn)+
 462      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 463 c
 464                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prf3cn)
 465 c
 466                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 467 c
 468                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q6,prf1cn)
 469      >                                        +vafoen(nrofon,q6,prf3cn))
 470                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 471      >                                        +vafoen(nrofon,q2,prf4cn)
 472      >                                        +vafoen(nrofon,q3,prf3cn))
 473 c
 474                 vafott(nrofon,q6,f1cp) = vafoen(nrofon,q6,prf4cn)
 475 c
 476 c        Pour le triangle fils NF+1
 477 c
 478                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prfd2n)
 479 c
 480                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prf3cn)
 481 c
 482                 vafott(nrofon,q3,f2cp) = destr*vafoen(nrofon,q3,prfd1n)+
 483      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 484 c
 485                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q1,prf3cn)
 486      >                                      +vafoen(nrofon,q3,prf1cn))+
 487      >                            unsqu*destr*(vafoen(nrofon,q2,prfd1n)+
 488      >                                        vafoen(nrofon,q2,prfd2n))
 489 c
 490                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q4,f1cp)
 491 c
 492                 vafott(nrofon,q6,f2cp) = unsde*(vafoen(nrofon,q1,prfd1n)
 493      >                                        +vafoen(nrofon,q3,prfd2n))
 494 c
 495 24221        continue
 496 c
 497             elseif  ( g1.eq.0 .and. d1.ne.0 ) then
 498 c                   .                         .
 499 c                  . .                       ...
 500 c                 .   .                     . . .
 501 c                .     .                   .  .  .
 502 c               .........      ===>       .   .   .
 503 c              . .     ...               .    .    .
 504 c             .   .   . . .             .     .     .
 505 c            .     . .  .  .           .      .      .
 506 c           .................         .................
 507 c                  A2                         A2
 508 c
 509 c
 510               do 24222 , nrofon = 1 , nbfonc
 511 c
 512 c        Pour le triangle fils aine NF
 513 c
 514                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q3,prfg2n)+
 515      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 516 c
 517                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prf3cn)
 518 c
 519                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prfg1n)
 520 c
 521                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q6,prf1cn)
 522      >                                       +vafoen(nrofon,q6,prf3cn))
 523                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 524      >                                       +vafoen(nrofon,q3,prf3cn))+
 525      >                            unsqu*destr*(vafoen(nrofon,q2,prfg1n)
 526      >                                       +vafoen(nrofon,q2,prfg2n))
 527 c
 528                 vafott(nrofon,q6,f1cp) = unsde*(vafoen(nrofon,q3,prfg1n)
 529      >                                        +vafoen(nrofon,q3,prfg2n))
 530 c
 531 c        Pour le triangle fils NF+1
 532                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 533 c
 534                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prf3cn)
 535 c
 536                 vafott(nrofon,q3,f2cp) = destr*vafoen(nrofon,q3,prf2cn)+
 537      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 538 c
 539                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q1,prf3cn)
 540      >                                        +vafoen(nrofon,q2,prf2cn)
 541      >                                        +vafoen(nrofon,q3,prf1cn))
 542 c
 543                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q4,f1cp)
 544 c
 545                 vafott(nrofon,q6,f2cp) = vafoen(nrofon,q6,prf2cn)
 546 24222        continue
 547 c
 548             else
 549 c
 550 c                   .                         .
 551 c                  . .                       ...
 552 c                 .   .                     . . .
 553 c                .     .                   .  .  .
 554 c               .........      ===>       .   .   .
 555 c              ...     ...               .    .    .
 556 c             . . .   . . .             .     .     .
 557 c            .  .  . .  .  .           .      .      .
 558 c           .................         .................
 559 c                  A2                         A2
 560 c
 561 c
 562               do 24223 , nrofon = 1 , nbfonc
 563 c
 564 c        Pour le triangle fils aine NF
 565 c
 566                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q3,prfg2n)+
 567      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 568 c
 569                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prf3cn)
 570 c
 571                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prfg1n)
 572 c
 573                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q6,prf1cn)
 574      >                                       +vafoen(nrofon,q6,prf3cn))
 575                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 576      >                                      +vafoen(nrofon,q3,prf3cn))+
 577      >                             unsqu*destr*(vafoen(nrofon,q2,prfg1n)
 578      >                                        +vafoen(nrofon,q2,prfg2n))
 579 c
 580                 vafott(nrofon,q6,f1cp) = unsde*(vafoen(nrofon,q3,prfg1n)
 581      >                                       +vafoen(nrofon,q3,prfg2n))
 582 c
 583                 vafott(nrofon,q6,f1cp) = vafoen(nrofon,q6,prf4cn)
 584 c
 585 c        Pour le triangle fils NF+1
 586 c
 587                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prfd2n)
 588 c
 589                 vafott(nrofon,q2,f2cp) = vafoen(nrofon,q2,prf3cn)
 590 c
 591                 vafott(nrofon,q3,f2cp) = destr*vafoen(nrofon,q3,prfd1n)+
 592      >                                   unstr*vafoen(nrofon,q2,prf1cn)
 593 c
 594                 vafott(nrofon,q4,f2cp) = unstr*(vafoen(nrofon,q1,prf3cn)
 595      >                                      +vafoen(nrofon,q3,prf1cn))+
 596      >                           unsqu*destr*(vafoen(nrofon,q2,prfd1n)+
 597      >                                        vafoen(nrofon,q2,prfd2n))
 598 c
 599                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q4,f1cp)
 600 c
 601                 vafott(nrofon,q6,f2cp) = unsde*(vafoen(nrofon,q1,prfd1n)
 602      >                                       +vafoen(nrofon,q3,prfd2n))
 603 c
 604 24223        continue
 605             endif
 606 c doc.4.1/2/3. ===> etanp1 = 3 : le triangle est decoupe en deux selon
 607 c                                l'arete 3
 608 c
 609           elseif ( etanp1.eq.3  ) then
 610 cgn        print *,'Passage par etanp1.eq.3'
 611 c
 612             f4cn = ntreca(f1hn+3)
 613             prf4cn = prfcan(f4cn)
 614             g1 = 0
 615             d1 = 0
 616 cgn            write(6,*) 'etanp1', etanp1
 617 cgn            write(6,*) 'mod(anhetr(f1hn+1),10)',mod(anhetr(f1hn+1),10)
 618             if ( mod(anhetr(f1hn+1),10).eq.0 ) then
 619               f2cn = ntreca(f1hn+1)
 620               prf2cn = prfcan(f2cn)
 621             elseif ( mod(anhetr(f1hn+1),10).eq.etanp1 ) then
 622               pf = anfitr(f1hn+1)
 623               g1 = ntreca(pf+1)
 624               prfg1n = prfcan(g1)
 625               g2 = ntreca(pf)
 626               prfg2n = prfcan(g2)
 627             else
 628               codret = codret + 1
 629               write (ulsort,*) '_5h E codret', codret
 630               write (ulsort,texte(langue,4)) 'n  ', trhn
 631               write (ulsort,texte(langue,5)) 'n  ', etan
 632               write (ulsort,texte(langue,4)) 'n+1', trhnp1
 633               write (ulsort,texte(langue,5)) 'n+1', etanp1
 634             endif
 635 cgn            write(6,*) 'etanp1', etanp1
 636 cgn            write(6,*) 'mod(anhetr(f1hn+2),10)',mod(anhetr(f1hn+2),10)
 637             if ( mod(anhetr(f1hn+2),10).eq.0 ) then
 638               f3cn = ntreca(f1hn+2)
 639               prf3cn = prfcan(f3cn)
 640             elseif ( mod(anhetr(f1hn+2),10).eq.etanp1 ) then
 641               pf = anfitr(f1hn+2)
 642               d1 = ntreca(pf+1)
 643               prfd1n = prfcan(d1)
 644               d2 = ntreca(pf)
 645               prfd2n = prfcan(d2)
 646             else
 647               codret = codret + 1
 648               write (ulsort,*) '_5h F codret', codret
 649               write (ulsort,texte(langue,4)) 'n  ', trhn
 650               write (ulsort,texte(langue,5)) 'n  ', etan
 651               write (ulsort,texte(langue,4)) 'n+1', trhnp1
 652               write (ulsort,texte(langue,5)) 'n+1', etanp1
 653             endif
 654 c
 655             if  ( g1.eq.0 .and. d1.eq.0 ) then
 656 c
 657 c
 658 c                   .                         .
 659 c                  . .                       ...
 660 c                 .   .                     . . .
 661 c                .     .                   .  .  .
 662 c               .........      ===>       .   .   .
 663 c              . .     . .               .    .    .
 664 c             .   .   .   .             .     .     .
 665 c            .     . .     .           .      .      .
 666 c           .................         .................
 667 c                  A3                         A3
 668 c
 669 c
 670               do 24230 , nrofon = 1 , nbfonc
 671 c
 672 c        Pour le triangle fils aine NF
 673 c
 674                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q1,prf3cn)+
 675      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 676 c
 677                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prf3cn)
 678 c
 679                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 680 c
 681                 vafott(nrofon,q4,f1cp) = vafoen(nrofon,q4,prf3cn)
 682 c
 683                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 684      >                                        +vafoen(nrofon,q2,prf4cn)
 685      >                                        +vafoen(nrofon,q3,prf3cn))
 686 c
 687                 vafott(nrofon,q6,f1cp) = unsde*(vafoen(nrofon,q4,prf1cn)
 688      >                                        +vafoen(nrofon,q4,prf4cn))
 689 c
 690 c        Pour le triangle fils NF+1
 691 c
 692                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 693 c
 694                 vafott(nrofon,q2,f2cp) = destr*vafoen(nrofon,q2,prf2cn)+
 695      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 696 c
 697                vafott(nrofon,q3,f2cp) = vafoen(nrofon,q3,prf4cn)
 698 c
 699                 vafott(nrofon,q4,f2cp) = vafoen(nrofon,q4,prf2cn)
 700 c
 701                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q6,f1cp)
 702 c
 703                 vafott(nrofon,q6,f2cp) = unstr*(vafoen(nrofon,q1,prf4cn)
 704      >                                        +vafoen(nrofon,q2,prf1cn)
 705      >                                        +vafoen(nrofon,q3,prf2cn))
 706 c
 707 24230         continue
 708 c
 709             elseif  ( g1.ne.0 .and. d1.eq.0 ) then
 710 c
 711 c                   .                         .
 712 c                  . .                       ...
 713 c                 .   .                     . . .
 714 c                .     .                   .  .  .
 715 c               .........      ===>       .   .   .
 716 c              ...     . .               .    .    .
 717 c             . . .   .   .             .     .     .
 718 c            .  .  . .     .           .      .      .
 719 c           .................         .................
 720 c                  A3                         A3
 721 c
 722 c
 723               do 24231 , nrofon = 1 , nbfonc
 724 c
 725 c        Pour le triangle fils aine NF
 726 c
 727                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q1,prf3cn)+
 728      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 729 c
 730                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prf3cn)
 731 c
 732                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 733 c
 734                 vafott(nrofon,q4,f1cp) = vafoen(nrofon,q4,prf3cn)
 735 c
 736                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 737      >                                        +vafoen(nrofon,q2,prf4cn)
 738      >                                        +vafoen(nrofon,q3,prf3cn))
 739 c
 740                 vafott(nrofon,q6,f1cp) = unsde*(vafoen(nrofon,q4,prf1cn)
 741      >                                        +vafoen(nrofon,q4,prf4cn))
 742 c
 743 c        Pour le triangle fils NF+1
 744 c
 745                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prfg1n)
 746 c
 747                 vafott(nrofon,q2,f2cp) = destr*vafoen(nrofon,q2,prfg2n)+
 748      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 749 c
 750                vafott(nrofon,q3,f2cp) = vafoen(nrofon,q3,prf4cn)
 751 c
 752                 vafott(nrofon,q4,f2cp) = unsde*(vafoen(nrofon,q1,prfg1n)
 753      >                                        +vafoen(nrofon,q1,prfg2n))
 754 c
 755                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q6,f1cp)
 756 c
 757                 vafott(nrofon,q6,f2cp) = unstr*(vafoen(nrofon,q1,prf4cn)
 758      >                                       +vafoen(nrofon,q2,prf1cn))+
 759      >                            unsqu*destr*(vafoen(nrofon,q3,prfg1n)+
 760      >                                        vafoen(nrofon,q3,prfg2n))
 761 c
 762 24231         continue
 763             elseif  ( g1.eq.0 .and. d1.ne.0 ) then
 764 c
 765 c                   .                         .
 766 c                  . .                       ...
 767 c                 .   .                     . . .
 768 c                .     .                   .  .  .
 769 c               .........      ===>       .   .   .
 770 c              . .     ...               .    .    .
 771 c             .   .   . . .             .     .     .
 772 c            .     . .  .  .           .      .      .
 773 c           .................         .................
 774 c                  A3                         A3
 775 c
 776               do 24232 , nrofon = 1 , nbfonc
 777 c
 778 c        Pour le triangle fils aine NF
 779 c
 780                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q1,prfd1n)+
 781      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 782 c
 783                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prfd2n)
 784 c
 785                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 786 c
 787                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q1,prfd2n)
 788      >                                        +vafoen(nrofon,q2,prfd1n))
 789 c
 790                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 791      >                                      +vafoen(nrofon,q2,prf4cn))+
 792      >                           unsqu*destr*(vafoen(nrofon,q3,prfd1n)+
 793      >                                        vafoen(nrofon,q3,prfd2n))
 794 c
 795                 vafott(nrofon,q6,f1cp) = unsde*(vafoen(nrofon,q4,prf1cn)
 796      >                                       +vafoen(nrofon,q4,prf4cn))
 797 c
 798 c        Pour le triangle fils NF+1
 799 c
 800                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prf2cn)
 801 c
 802                 vafott(nrofon,q2,f2cp) = destr*vafoen(nrofon,q2,prf2cn)+
 803      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 804 c
 805                vafott(nrofon,q3,f2cp) = vafoen(nrofon,q3,prf4cn)
 806 c
 807                 vafott(nrofon,q4,f2cp) = vafoen(nrofon,q4,prf2cn)
 808 c
 809                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q6,f1cp)
 810 c
 811                 vafott(nrofon,q6,f2cp) = unstr*(vafoen(nrofon,q1,prf4cn)
 812      >                                        +vafoen(nrofon,q2,prf1cn)+
 813      >                                        vafoen(nrofon,q3,prf2cn))
 814 c
 815 24232         continue
 816             else
 817 c
 818 c                   .                         .
 819 c                  . .                       ...
 820 c                 .   .                     . . .
 821 c                .     .                   .  .  .
 822 c               .........      ===>       .   .   .
 823 c              ...     ...               .    .    .
 824 c             . . .   . . .             .     .     .
 825 c            .  .  . .  .  .           .      .      .
 826 c           .................         .................
 827 c                  A3                         A3
 828 c
 829               do 24233 , nrofon = 1 , nbfonc
 830 c
 831 c        Pour le triangle fils aine NF
 832 c
 833                 vafott(nrofon,q1,f1cp) = destr*vafoen(nrofon,q1,prfd1n)+
 834      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 835 c
 836                 vafott(nrofon,q2,f1cp) = vafoen(nrofon,q2,prfd2n)
 837 c
 838                 vafott(nrofon,q3,f1cp) = vafoen(nrofon,q3,prf4cn)
 839 c
 840                 vafott(nrofon,q4,f1cp) = unsde*(vafoen(nrofon,q1,prfd2n)
 841      >                                        +vafoen(nrofon,q2,prfd1n))
 842 c
 843                 vafott(nrofon,q5,f1cp) = unstr*(vafoen(nrofon,q1,prf1cn)
 844      >                                       +vafoen(nrofon,q2,prf4cn))+
 845      >                            unsqu*destr*(vafoen(nrofon,q3,prfd1n)+
 846      >                                        vafoen(nrofon,q3,prfd2n))
 847 c
 848                 vafott(nrofon,q6,f1cp) = unsde*(vafoen(nrofon,q4,prf1cn)
 849      >                                        +vafoen(nrofon,q4,prf4cn))
 850 c
 851 c        Pour le triangle fils NF+1
 852 c
 853                 vafott(nrofon,q1,f2cp) = vafoen(nrofon,q1,prfg1n)
 854 c
 855                 vafott(nrofon,q2,f2cp) = destr*vafoen(nrofon,q2,prfg2n)+
 856      >                                   unstr*vafoen(nrofon,q3,prf1cn)
 857 c
 858                vafott(nrofon,q3,f2cp) = vafoen(nrofon,q3,prf4cn)
 859 c
 860                 vafott(nrofon,q4,f2cp) = unsde*(vafoen(nrofon,q1,prfg1n)
 861      >                                       +vafoen(nrofon,q1,prfg2n))
 862 c
 863                 vafott(nrofon,q5,f2cp) = vafott(nrofon,q6,f1cp)
 864 c
 865                 vafott(nrofon,q6,f2cp) = unstr*(vafoen(nrofon,q1,prf4cn)
 866      >                                      +vafoen(nrofon,q2,prf1cn))+
 867      >                           unsqu*destr*(vafoen(nrofon,q3,prfg1n)+
 868      >                                        vafoen(nrofon,q3,prfg2n))
 869 c
 870 24233         continue
 871             endif
 872 cgn          else
 873 cgn        print *,'Passage tout droit !'
 874           endif
 875 c
 876 #ifdef _DEBUG_HOMARD_
 877       write (ulsort,texte(langue,1)) 'Sortie', 'pcstr2_5'
 878 #endif