Esope source files

   1 : C QUEPOI    SOURCE    PV        13/04/16    21:15:22     7765           
   2 :       SUBROUTINE QUEPOI(ICHP1,IPSG,INDIC,NBCOMP,NOMTOT)
   3 : C-----------------------------------------------------------------------
   4 : C On teste le champoint ICHP1 afin de vérifier :
   5 : C   1) qu'il est non partitionné
   6 : C   2) qu'il a le bon nombre de composantes et/ou les bonnes composantes
   7 : C   3) que son support géométrique est IPSG
   8 : C Si INDIC vaut 1 en entrée, on modifie, si besoin, l'ordonnencement
   9 : C des infos du CHPO afin d'imposer le SPG de pointeur IPSG. Si INDIC
  10 : C vaut 0, des supports différents générent INDIC=-4 mais on n'imprime
  11 : C pas de message d'erreur.
  12 : C-----------------------------------------------------------------------
  13 : C
  14 : C---------------------------
  15 : C Parametres Entree/Sortie :
  16 : C---------------------------
  17 : C
  18 : C E/  ICHP1  : Champoint à tester
  19 : C E/  IPSG   : Maillage de référence, en général de type POI1
  20 : C E/S INDIC  : En entrée,
  21 : C                  0 On ne fait que vérifier le support géométrique,
  22 : C                  1 On impose le pointeur du support géométrique.
  23 : C              En sortie,
  24 : C                 -4 si les spgs sont différents (points différents),
  25 : C                 -3 si le nom des composantes sont incorrects,
  26 : C                 -2 si le nombre de composantes est incorrect,
  27 : C                 -1 si le champoint est partitionné,
  28 : C                  0 si les spgs sont identiques,
  29 : C                  1 si les points sont identiques.
  30 : C E/S NBCOMP : En entrée,
  31 : C                 >0 si on teste le nombre de compoantes,
  32 : C                  0 si on veut recuperer les noms de composantes,
  33 : C                 -1 si on ne veut faire aucun test.
  34 : C              En sortie,
  35 : C                 nombre de composantes du CHPO.
  36 : C E/S NOMTOT : En entrée,
  37 : C                 noms des composantes à tester (si NBCOMP > 0),
  38 : C                 remplir NOMTOT(1)='    ' dans l'appelant sinon.
  39 : C              En sortie,
  40 : C                 noms des composantes du CHPO (si NBCOMP = 0),
  41 : C                 non rempli sinon.
  42 : C
  43 : C-----------------------------------------------------------------------
  44 : C ATTENTION: TOUJOURS initialiser NOMTOT(dim) dans le prg appelant
  45 : C                   (dim=1 si NBCOMP=0, dim=NBCOMP sinon)
  46 : C-----------------------------------------------------------------------
  47 : C
  48 : C Langage : ESOPE + FORTRAN77
  49 : C
  50 : C Auteurs : F.AURIOL 09/93
  51 : C
  52 : C-----------------------------------------------------------------------
  53 :       IMPLICIT INTEGER(I-N)
  54 :       IMPLICIT REAL*8 (A-H,O-Z)
  55 :       CHARACTER*4 NOMTOT(*)
  56 : C
  57 : -INC CCOPTIO
  58 : -INC SMELEME
  59 : -INC SMCHPOI
  60 : -INC SMCOORD
  61 :       SEGMENT IBEXIS
  62 :             INTEGER IEXIS(NBPTS)
  63 :       ENDSEGMENT
  64 : C
  65 :       ININI = INDIC
  66 : C
  67 : C- Test si le CHPO est partitionné
  68 : C
  69 :       MCHPOI = ICHP1
  70 :       SEGACT MCHPOI
  71 :       NSOUPO = IPCHP(/1)
  72 :       IF (NSOUPO.NE.1) THEN
  73 :          INDIC = -1
  74 :          MOTERR(1:8) = 'CHAMPOIN'
  74 :          CALL ERREUR(132)
  75 :          SEGDES MCHPOI
  76 :          RETURN
  77 :       ENDIF
  78 : C
  79 : C- Test/Récupération du nom des composantes
  80 : C
  81 :       MSOUPO = IPCHP(1)
  82 :       SEGDES MCHPOI
  83 :       SEGACT MSOUPO
  84 :       NBCOM1 = NBCOMP
  85 :       NBCOMP = NOCOMP(/2)
  86 :       IF (NBCOM1.GT.-1) THEN
  87 :          IF (NBCOM1.EQ.0) THEN
  88 :             DO 5 ICOMP=1,NBCOMP
  89 :                NOMTOT(ICOMP) = NOCOMP(ICOMP)
  90 :  5          CONTINUE
  91 :          ELSE
  92 :             IF (NBCOM1.NE.NBCOMP) THEN
  93 :                INDIC = -2
  94 :                MOTERR(1:8)  = ' QUEPOI '
  95 :                MOTERR(9:16) = 'CHAMPOIN'
  96 :                INTERR(1)   = NBCOM1
  97 :                INTERR(2)   = NBCOMP
  97 :                CALL ERREUR(699)
  98 :                SEGDES MSOUPO
  99 :                RETURN
 100 :             ENDIF
 101 :             IF (NOMTOT(1).NE.'    ') THEN
 102 :                DO 10 ICOMP=1,NBCOMP
 102 :                   CALL PLACE(NOMTOT,NBCOMP,IPOS,NOCOMP(ICOMP))
 103 :                   IF (IPOS.EQ.0) THEN
 104 :                      INDIC = -3
 105 :                      MOTERR(1:4) = NOCOMP(ICOMP)
 105 :                      CALL ERREUR(197)
 106 :                      SEGDES MSOUPO
 107 :                      RETURN
 108 :                   ENDIF
 109 :  10            CONTINUE
 110 :             ENDIF
 111 :          ENDIF
 112 :       ENDIF
 113 : C
 114 : C- Récupération des infos du MSOUPO utilisées
 115 : C
 116 :       IPT2   = IGEOC
 117 :       MPOVAL = IPOVAL
 118 :       SEGDES MSOUPO
 119 : C
 120 : C- Transforme le maillage en POI1 si maillage quelconque
 121 : C- Le maillage POI1 de pointeur IPT1 est actif au retour de CHANGE
 122 : C
 123 :       MELEME = IPSG
 124 :       SEGACT MELEME
 125 :       IPT1   = MELEME
 126 :       NBSOUS = LISOUS(/1)
 127 :       IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN
 127 :          CALL CHANGE(IPT1,1)
 128 :          IF (IERR.NE.0) RETURN
 129 :       ENDIF
 130 : C
 131 : C- Si égalité des pointeurs INDIC=0
 132 : C
 133 :       IF (IPT2.EQ.IPT1) THEN
 134 :          INDIC = 0
 135 :          SEGDES IPT1
 136 :          RETURN
 137 :       ENDIF
 138 : C
 139 : C- Dans le cas d'un MELEME de POI1 création d'un CHPO de support
 140 : C- géométrique le POI1 en question.
 141 : C
 142 :       IF (ININI.EQ.1) THEN
 143 :          N  = IPT1.NUM(/2)
 144 :          NC = NBCOMP
 145 :          SEGINI MPOVA1
 146 :       ENDIF
 147 : C
 148 : C- Recherche si les points du MELEME de type POI1 sont dans le CHPO
 149 : C- et ordonnencement si INDIC=1
 150 : C
 151 :       NUMPT1 = IPT1.NUM(/2)
 152 :       SEGACT IPT2
 153 :       NUMPT2 = IPT2.NUM(/2)
 154 :       IF (NUMPT1.NE.NUMPT2) GOTO 110
 155 :       NBPTS=XCOOR(/1)/(IDIM+1)
 156 :       SEGINI IBEXIS
 157 :       DO 20 IEL=1,NBPTS
 158 :            IEXIS(IEL)=0
 159 :  20   CONTINUE
 160 :       DO 30 IEL=1,NUMPT1
 161 :            NOE = IPT1.NUM(1,IEL)
 162 :            IEXIS(NOE)=IEL
 163 :  30   CONTINUE
 164 :       IF (ININI.NE.1) THEN
 165 :             DO 15 IP=1,NUMPT2
 166 :                NOE=IPT2.NUM(1,IP)
 167 :                IF(IEXIS(NOE).EQ.0)GO TO 110
 168 :  15         CONTINUE
 169 :       ELSE
 170 :          SEGACT MPOVAL
 171 :             DO 60 IP=1,NUMPT2
 172 :                NOE=IPT2.NUM(1,IP)
 173 :                IEL=IEXIS(NOE)
 174 :                IF(IEL.EQ.0)GO TO 110
 175 :                   DO 50 NC1=1,NC
 176 :                      MPOVA1.VPOCHA(IEL,NC1) = VPOCHA(IP,NC1)
 177 :  50               CONTINUE
 178 :  60         CONTINUE
 179 :       ENDIF
 180 :       SEGSUP IBEXIS
 181 : C
 182 : C- Traitement si points identiques
 183 : C
 184 :       IF (ININI.EQ.1) THEN
 185 :          segact mpoval*mod
 186 :          DO 100 IEL=1,NUMPT1
 187 :             DO 90 NC1=1,NC
 188 :                VPOCHA(IEL,NC1) = MPOVA1.VPOCHA(IEL,NC1)
 189 :  90         CONTINUE
 190 :  100     CONTINUE
 191 :          SEGDES MPOVAL
 192 :          SEGSUP MPOVA1
 193 :          SEGACT MSOUPO*MOD
 194 :          IGEOC = IPT1
 195 :          SEGDES MSOUPO
 196 :       ENDIF
 197 :       INDIC = 1
 198 :       GOTO 120
 199 : C
 200 : C- Traitement si supports géométriques différents
 201 : C
 202 :  110  CONTINUE
 203 :       INDIC = -4
 204 :       IF (ININI.EQ.1) THEN
 205 :          SEGSUP MPOVA1
 206 :          MOTERR(1:8)  = 'CHAMPOIN'
 207 :          MOTERR(9:16) = 'MAILLAGE'
 208 :          INTERR(1)    = 1
 208 :          CALL ERREUR(698)
 209 :       ENDIF
 210 : C
 211 : C- Ménage
 212 : C
 213 :  120  CONTINUE
 214 :       SEGDES IPT2
 215 :       SEGDES IPT1
 216 : *
 217 :       RETURN
 218 :       END
 219 :  
 220 :  
 221 :  
 222 :  
 223 :