Esope source files

   1 : C ORDON4    SOURCE    PV        09/11/16    21:15:14     6538           
   2 :       SUBROUTINE ORDON4  (MELEME)
   3 : ************************************************************************
   4 : *                             O R D O N N
   5 : *                             -----------
   6 : *            SOUS-PROGRAMME ASSOCIE A LA DIRECTIVE "ORDONNER"
   7 : * FONCTION:
   8 : * ---------
   9 : *   reordonner une ligne de seg2 ou seg3
  10 : *     
  11 : *   on ordonne selon la proximite au premier pt pour des POI1 (PP 97)
  12 : *     
  13 : C+PP  
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8 (A-H,O-Z)
  16 : C+PP  
  17 : -INC CCOPTIO
  18 : -INC SMELEME
  19 :       SEGMENT TTRAV
  20 :       INTEGER     ILIS(NNOE)
  21 :       ENDSEGMENT
  22 : C+PP  
  23 : -INC SMLREEL
  24 : -INC SMLENTI
  25 : -INC SMCOORD
  26 : -INC TMCOLAC
  27 :       DIMENSION P(3)
  28 : C+PP  
  29 : *     
  30 : * on verifie d'abord que l'objet est simple
  31 : *     
  32 :       icompl=0
  33 :       SEGACT MELEME
  34 :       IF(LISOUS(/1).NE.0.OR.ITYPEL.GT.3) then
  34 :         CALL RENUEL(MELEME)
  35 :         return
  36 :       endif
  37 : C+PP  
  38 :       IF(ITYPEL.EQ.1)THEN
  39 :          SEGACT,MELEME*MOD
  40 :          NBELEM=ICOLOR(/1)
  41 : C Si le nombre d'éléments POI1 est inférieur ou égal à 2
  42 : C Il n'y a rien à faire
  43 :          IF(NBELEM.LE.2) GOTO 9998
  44 :          IREF=NUM(1,1)
  45 :          IREF=(IDIM+1)*(IREF-1)
  46 :          DO IE1=1,IDIM
  47 :             P(IE1)=XCOOR(IREF+IE1)
  48 :          ENDDO
  49 :          JG=NBELEM-1
  50 :          SEGINI,MLREEL,MLENTI
  51 :          DO IE1=1,JG
  52 :             IREF=NUM(1,IE1+1)
  53 :             LECT(IE1)=IREF
  54 :             IREF=(IDIM+1)*(IREF-1)
  55 :             DIST2=0.D0
  56 :             DO IE2=1,IDIM
  57 :                DIST2=DIST2+(P(IE2)-XCOOR(IREF+IE2))**2
  58 :             ENDDO
  59 :             PROG(IE1)=DIST2
  60 :          ENDDO
  60 :          CALL GENOS2(PROG,LECT,JG)
  61 :          DO IE1=1,JG
  62 :             NUM(1,IE1+1)=LECT(IE1)
  63 :          ENDDO
  64 :          SEGSUP,MLREEL,MLENTI
  65 :       ELSE
  66 : C+PP  
  66 :          CALL LIGMAI(MELEME,TTRAV,0)
  67 :          IF(IERR.NE.0) RETURN
  68 :          SEGACT TTRAV
  69 :          SEGACT MELEME*MOD
  70 :          IA=1
  71 :          DO 1 I=1,NUM(/2)
  72 :             IA=IA-1
  73 :             DO 2 J=1,NUM(/1)
  74 :                IA=IA+1
  75 :                NUM(J,I)=ILIS(IA)
  76 :  2          CONTINUE
  77 :  1       CONTINUE
  78 :          SEGSUP TTRAV
  79 :       ENDIF
  80 :  9998 CONTINUE
  81 :       SEGDES,MELEME
  82 : c
  83 :       IF(IPSAUV.NE.0) THEN
  84 :         ICOLAC = IPSAUV
  85 :         SEGACT ICOLAC
  86 :         ILISSE=ILISSG
  87 :         SEGACT ILISSE*MOD
  87 :         CALL TYPFIL('MAILLAGE',ICO)
  88 :            ITLACC = KCOLA(ICO)
  89 :            SEGACT ITLACC*MOD
  89 :           CALL AJOUN0(ITLACC,MELEME,ILISSE,1) 
  90 :           SEGDES ICOLAC,ILISSE   
  91 :          ENDIF   
  92 :       RETURN
  93 :       END
  94 : 
  95 :  
  96 :  
  97 :  
  98 :  
  99 :  
 100 :  
 101 :  
 102 :  
 103 :  
 104 :