Esope source files

   1 : C EXTR23    SOURCE    JC220346  12/12/13    21:15:03     7610           
   2 : ************************************************************************
   3 : * NOM         : extr23
   4 : * DESCRIPTION : Extrait les valeurs d'un CHPOINT a une composante pour
   5 : *               les mettre dans un LISTREEL
   6 : ************************************************************************
   7 : * HISTORIQUE :  12/12/2012 : JCARDO : création de la subroutine
   8 : * HISTORIQUE :  13/12/2012 : JCARDO : nouvel argument MLMOTS contenant
   9 : *                                     la liste des composantes à sortir
  10 : * HISTORIQUE :
  11 : ************************************************************************
  12 : * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  13 : * en cas de modification de ce sous-programme afin de faciliter
  14 : * la maintenance !
  15 : ************************************************************************
  16 : * APPELÉ PAR : extrai.eso
  17 : ************************************************************************
  18 : * ENTRÉES :: aucune
  19 : * SORTIES :: aucune
  20 : ************************************************************************
  21 : * SYNTAXE (GIBIANE) :
  22 : *
  23 : *          LREEL1 = EXTR 'VALE' (MOT1 | LMOT1) CHPO1 (MAIL1) ;
  24 : *
  25 : ************************************************************************
  26 :       SUBROUTINE EXTR23(ICHPOI,MLMOTS,MELEME,MLREEL)
  27 : *
  28 :       IMPLICIT INTEGER(I-N)
  29 :       IMPLICIT REAL*8(A-H,O-Z)
  30 : *
  31 : -INC CCOPTIO
  32 : -INC SMCHPOI
  33 : -INC SMELEME
  34 : -INC SMLREEL
  35 : -INC SMLMOTS
  36 : *
  37 :       CHARACTER*4 MCO
  38 : *
  39 : *
  40 : *     Création de la liste de réels renvoyée en sortie
  41 :       JG=0
  42 :       SEGINI,MLREEL
  43 : *
  44 : ************************************************************************
  45 : *   G E S T I O N   D E S   C O M P O S A N T E S   M U L T I P L E S
  46 : ************************************************************************
  47 : *
  48 : *     a) SI L'ON N'A PAS FOURNI DE LISTE DE COMPOSANTES
  49 : *     => on verifie que le CHPOINT ne contient qu'une seule composante
  50 : *        =============================================================
  51 :       IF (MLMOTS.NE.0) GOTO 50
  52 :       MCHPOI=ICHPOI
  53 :       SEGACT,MCHPOI
  54 :       NSOUPO=IPCHP(/1)
  55 :       IF (NSOUPO.EQ.0) GOTO 1000
  56 : *     /!\ on suppose que la partition est bien faite,
  57 : *         c'est-à-dire 1 SOUPO = 1 liste de composante unique)
  58 :       IF (NSOUPO.GT.1) GOTO 9
  59 :       MSOUPO=IPCHP(1)
  60 :       SEGACT,MSOUPO
  61 :       IF (NOCOMP(/2).GT.1) GOTO 9
  62 :       GOTO 100
  63 : *
  64 : *     (ERREUR 180 => "Il faut spécifier un champ par point avec une
  65 : *                     seule composante")
  65 :     9 CALL ERREUR(180)
  66 :       RETURN
  67 : *
  68 : *
  69 : *     b) SI ON A SPECIFIE LA LISTE DES COMPOSANTES A SORTIR
  70 : *     => on appelle EXCOPP pour faire le travail
  71 : *        ==================================================
  72 :    50 SEGACT,MLMOTS
  73 :       ICO=0
  74 :       NCO=MOTS(/2)
  75 : *     (label 51 = boucle sur les composantes)
  76 :    51 CONTINUE
  77 :       IF (ICO.EQ.NCO) GOTO 1000
  78 :       ICO=ICO+1
  79 :       MCO=MOTS(ICO)
  79 :       CALL EXCOPP(ICHPOI,MCO,MCHPOI,MCO,0)
  80 :       SEGACT,MCHPOI
  81 :       MSOUPO=IPCHP(1)
  82 :       SEGACT,MSOUPO
  83 : *
  84 : *
  85 : *
  86 : ************************************************************************
  87 : *   G E S T I O N   D E   L ' O R D R E   D U   L I S T R E E L
  88 : ************************************************************************
  89 : *
  90 : *     a) UN MELEME A ETE FOURNI POUR SPECIFIER L'ORDRE DE SORTIE
  91 : *        =======================================================
  92 : *
  93 :   100 CONTINUE
  94 :       IF (MELEME.EQ.0) GOTO 200
  95 : *
  96 : *     On vérifie qu'il est composé uniquement de POI1
  97 :       SEGACT,MELEME
  98 :       IF (LISOUS(/1).GT.0.OR.ITYPEL.NE.1) THEN
  99 :           MOTERR(1:8)='MAILLAGE'
 100 :           MOTERR(9:24)='POI1'
 100 :           CALL ERREUR(1025)
 101 :           RETURN
 102 :       ENDIF
 103 : *
 104 : *     Agrandissement du LISTREEL
 105 :       NP1=NUM(/2)
 106 :       JG=JG+NP1
 107 :       SEGADJ,MLREEL
 108 : *
 109 : *     Remplissage du LISTREEL selon l'ordre demandé
 110 :       IPT1=IGEOC
 111 :       MPOVAL=IPOVAL
 112 :       SEGACT,IPT1,MPOVAL
 113 :       NP2=IPT1.NUM(/2)
 114 :       DO 150 I2=1,NP2
 115 :           DO I3=1,NP1
 116 :               IF (IPT1.NUM(1,I2).EQ.NUM(1,I3)) THEN
 117 :                   PROG(JG-NP1+I3)=VPOCHA(I2,1)
 118 :                   GOTO 150
 119 :               ENDIF
 120 :           ENDDO
 121 :   150 CONTINUE
 122 : *
 123 :       SEGDES,MPOVAL,IPT1,MELEME
 124 :       GOTO 950
 125 : *
 126 : *
 127 : *     b) ON NE S'INTERESSE PAS A L'ORDRE DE SORTIE
 128 : *        => Remplissage du LISTREEL dans l'ordre du VPOCHA
 129 : *        =================================================
 130 : *
 131 :   200 CONTINUE
 132 : *
 133 :       MPOVAL=IPOVAL
 134 :       SEGACT,MPOVAL
 135 :       NP2=VPOCHA(/1)
 136 :       JG=JG+NP2
 137 :       SEGADJ,MLREEL
 138 :       DO I2=1,NP2
 139 :           PROG(JG-NP2+I2)=VPOCHA(I2,1)
 140 :       ENDDO
 141 : *
 142 :       SEGDES,MPOVAL
 143 : *
 144 : *
 145 : *
 146 :   950 CONTINUE
 147 :       IF (MLMOTS.NE.0) THEN
 147 :           CALL DTCHPO(MCHPOI)
 148 :           GOTO 51
 149 :       ELSE
 150 :           SEGDES,MSOUPO
 151 :       ENDIF
 152 : *
 153 : *
 154 :  1000 CONTINUE
 155 :       IF (MLMOTS.EQ.0) THEN
 156 :           SEGDES,MCHPOI
 157 :       ELSE
 158 :           SEGDES,MLMOTS
 159 :       ENDIF
 160 :       SEGDES,MLREEL
 161 : *
 162 : *
 163 :       RETURN
 164 : *
 165 :       END
 166 : *
 167 :