Esope source files

   1 : C RESULT    SOURCE    GOUNAND   13/08/01    21:15:11     7810           
   2 :       SUBROUTINE RESULT(ICHPO1,ICHPOR)
   3 : C====================================================================
   4 : C     
   5 : C         CALCULE LA RESULTANTE D UN CHAMP PAR POINT
   6 : C     
   7 : C    ENTREES
   8 : C     ICHPO1 = UN CHAMP PAR POINT ARBITRAIRE
   9 : C    SORTIES
  10 : C     ICHPOR =  CHAMP PAR POINT RESULTANT
  11 : C               QUI A LES CARACTERISTIQUES SUIVANTES
  12 : C                NSOUPO=1   IGEOC=1ER POINT DU CHAMP DONNE
  13 : C     
  14 : C    ATTENTION : DANS L IMMEDIAT CET OPERATEUR SE CONTENTE DE
  15 : C      SOMMER LES VALEURS SUR LES DIFFERENTES COMPOSANTES
  16 : C     
  17 : C         CODE JACQUELINE BROCHARD AVRIL 85
  18 : C         corrections pour prendre en compte divers types 
  19 : C         de chpoints vide S. GOUNAND JUILLET 2013
  20 : C=====================================================================
  21 :       IMPLICIT INTEGER(I-N)
  22 :       IMPLICIT REAL*8(A-H,O-Z)
  23 : -INC SMCHPOI
  24 : -INC SMELEME
  25 : -INC CCOPTIO
  26 :       SEGMENT SICOMP
  27 :       CHARACTER*4 ICOMP(0)
  28 :       ENDSEGMENT
  29 :       SEGMENT IHARM(0)
  30 : C
  31 : C             STOCKENT LES NOMS DES COMPOSANTES ET LES HARMONIQUES
  32 : C
  33 :       MCHPO1=ICHPO1
  34 :       SEGACT MCHPO1
  35 :       NSOUP1=MCHPO1.IPCHP(/1)
  36 : C     
  37 : C     ON INITIALISE LE CHPOINT RESULTANT
  38 : C     
  39 :       NSOUPO=MIN(1,NSOUP1)
  40 :       NAT=MAX(1,MCHPO1.JATTRI(/1))
  41 :       SEGINI MCHPOI
  42 : C     
  43 : C     INITIALISATION DES TITRES DU CHPOINT RESULTANT ET DU IFOPOI
  44 : C     
  45 :       MTYPOI=MCHPO1.MTYPOI
  46 :       MOCHDE=MCHPO1.MOCHDE
  47 :       IFOPOI=MCHPO1.IFOPOI
  48 :       DO 111 NATI=1,NAT
  49 :          JATTRI(NATI)=MCHPO1.JATTRI(NATI)
  50 :  111  CONTINUE
  51 :       JATTRI(1)=2
  52 : * le champ par point resultant est de nature discrete (DEGAY)
  53 :       ICHPOR=MCHPOI
  54 :       IF (NSOUP1.GT.0) THEN
  55 : C     
  56 : C     ON RECUPERE LES NOMS DES COMPOSANTES ET ON LES MET DANS ICOMP
  57 : C     ON CHERCHE EGALEMENT LE NUMERO DU PREMIER NOEUD NON NUL DANS LES
  58 : C     IGEOC 
  59 : C     
  60 :          INODE=0
  61 :          SEGINI SICOMP,IHARM
  62 : * gounand Les deux lignes suivantes sont inutiles et potentiellement 
  63 : *         dangereuses si NC=0
  64 : *      ICOMP(**)=MSOUP1.NOCOMP(1)
  65 : *      IHARM(**)=MSOUP1.NOHARM(1)
  66 :          DO 100 IA=1,NSOUP1
  67 :             MSOUP1=MCHPO1.IPCHP(IA)
  68 :             SEGACT MSOUP1
  69 :             NC1=MSOUP1.NOCOMP(/2)
  70 :             DO 120 IB=1,NC1
  71 :                DO 140 IC=1,ICOMP(/2)
  72 :                   IF (ICOMP(IC).EQ.MSOUP1.NOCOMP(IB)
  73 :      S                 .AND.IHARM(IC).EQ.MSOUP1.NOHARM(IB)) GOTO 120
  74 :  140           CONTINUE
  75 :                ICOMP(**)=MSOUP1.NOCOMP(IB)
  76 :                IHARM(**)=MSOUP1.NOHARM(IB)
  77 :  120        CONTINUE
  78 :             IPT1=MSOUP1.IGEOC
  79 :             IF (IPT1.GT.0.AND.INODE.EQ.0) THEN
  80 :                SEGACT IPT1
  81 :                NBL=IPT1.NUM(/2)
  82 :                IF (NBL.GT.0) INODE=IPT1.NUM(1,1)
  83 :                SEGDES IPT1
  84 :             ENDIF
  85 :             SEGDES MSOUP1
  86 :  100     CONTINUE
  87 :          NC=ICOMP(/2)
  88 :          IF (NC.EQ.0) THEN
  89 : * On n'a pas trouvé de composantes => CHPO VIDE
  90 :             NSOUPO=0
  91 :             SEGADJ MCHPOI
  92 :          ELSE
  93 :             SEGINI MSOUPO
  94 :             IPCHP(1)=MSOUPO
  95 : C     
  96 : C     REMPLISSAGE DES NOMS DE COMPOSANTES ET DES HARMONIQUES
  97 : C     
  98 :             DO 210 I=1,NC
  99 :                NOCOMP(I)=ICOMP(I)
 100 :                NOHARM(I)=IHARM(I)
 101 :  210        CONTINUE
 102 : C     
 103 : C     CREATION DU SUPPORT GEOMETRIQUE DU CHPOINT RESULTANT
 104 : C     
 105 :             NBNN=1
 106 :             NBELEM=1
 107 : * On n'a pas trouvé de noeuds => CHPO VIDE + noms de composantes
 108 : * + IGEOC vide + IPOVAL vide
 109 : * On est un peu trop gentil
 110 :             IF (INODE.EQ.0) NBELEM=0
 111 :             NBSOUS=0
 112 :             NBREF=0
 113 :             SEGINI MELEME
 114 :             ITYPEL=1
 115 :             IF (INODE.NE.0) NUM(1,1)=INODE
 116 :             SEGDES MELEME
 117 :             IGEOC=MELEME
 118 : C
 119 : C     CREATION DES VALEURS DU CHPOINT RESULTANT
 120 : C            
 121 :             N=1
 122 :             IF (INODE.EQ.0) N=0
 123 :             SEGINI MPOVAL
 124 :             IPOVAL=MPOVAL
 125 :             IF (INODE.GT.0) THEN
 126 : C     
 127 : C     BOUCLE SUR LES SOUS PAQUETS DU CHPOINT ARGUMMENT
 128 : C     
 129 :                DO 200 IA=1,NSOUP1
 130 :                   MSOUP1=MCHPO1.IPCHP(IA)
 131 :                   SEGACT MSOUP1
 132 :                   NC1=MSOUP1.NOCOMP(/2)
 133 :                   MPOVA1=MSOUP1.IPOVAL
 134 :                   SEGACT MPOVA1
 135 : C     
 136 : C     ON CHERCHE LE NOM DE LA COMPOSANTE
 137 : C     
 138 :                   N1=MPOVA1.VPOCHA(/1)
 139 :                   DO 220 IB=1,NC1
 140 :                      DO 240 IC=1,NC
 141 :                         IF (ICOMP(IC).EQ.MSOUP1.NOCOMP(IB)
 142 :      S                       .AND.IHARM(IC).EQ.MSOUP1.NOHARM(IB))
 143 :      $                       GOTO 260
 144 :  240                 CONTINUE
 145 :  260                 CONTINUE
 146 : C     
 147 : C     ET ON ADDITIONNE
 148 : C     
 149 :                      DO 280 ID=1,N1
 150 :                         VPOCHA(1,IC)=VPOCHA(1,IC)+
 151 :      $                       MPOVA1.VPOCHA(ID,IB)
 152 :  280                 CONTINUE
 153 :  220              CONTINUE
 154 :                   SEGDES MPOVA1
 155 :                   SEGDES MSOUP1
 156 :  200           CONTINUE
 157 :             ENDIF
 158 :             SEGDES MPOVAL
 159 :             SEGDES MSOUPO
 160 :          ENDIF
 161 : C     
 162 : C     SUPPRESSION DES SEGMENTS DE TRAVAIL
 163 : C     
 164 :          SEGSUP SICOMP,IHARM
 165 :       ENDIF
 166 :       SEGDES MCHPOI
 167 :       SEGDES MCHPO1
 168 :       RETURN
 169 :       END
 170 : 
 171 : 
 172 : 
 173 : 
 174 :