Sources Esope | Cast3M

result
C RESULT    SOURCE    CB215821  20/11/25    13:39:13     10792          
      SUBROUTINE RESULT(ICHPO1,ICHPOR)
C====================================================================
C
C         CALCULE LA RESULTANTE D UN CHAMP PAR POINT
C
C    ENTREES
C     ICHPO1 = UN CHAMP PAR POINT ARBITRAIRE
C    SORTIES
C     ICHPOR =  CHAMP PAR POINT RESULTANT
C               QUI A LES CARACTERISTIQUES SUIVANTES
C                NSOUPO=1   IGEOC=1ER POINT DU CHAMP DONNE
C
C    ATTENTION : DANS L IMMEDIAT CET OPERATEUR SE CONTENTE DE
C      SOMMER LES VALEURS SUR LES DIFFERENTES COMPOSANTES
C
C         CODE JACQUELINE BROCHARD AVRIL 85
C         corrections pour prendre en compte divers types
C         de chpoints vide S. GOUNAND JUILLET 2013
C=====================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC SMCHPOI
-INC SMELEME
-INC PPARAM
-INC CCOPTIO
 
      SEGMENT SICOMP
        CHARACTER*(LOCOMP) ICOMP(0)
      ENDSEGMENT
 
      SEGMENT IHARM(0)
 
 
C
C             STOCKENT LES NOMS DES COMPOSANTES ET LES HARMONIQUES
C
      MCHPO1=ICHPO1
      SEGACT MCHPO1
      NSOUP1=MCHPO1.IPCHP(/1)
C
C     ON INITIALISE LE CHPOINT RESULTANT
C
      NSOUPO=MIN(1,NSOUP1)
      NAT=MAX(1,MCHPO1.JATTRI(/1))
      SEGINI MCHPOI
C
C     INITIALISATION DES TITRES DU CHPOINT RESULTANT ET DU IFOPOI
C
      MTYPOI=MCHPO1.MTYPOI
      MOCHDE=MCHPO1.MOCHDE
      IFOPOI=MCHPO1.IFOPOI
      DO 111 NATI=1,NAT
         JATTRI(NATI)=MCHPO1.JATTRI(NATI)
 111  CONTINUE
      JATTRI(1)=2
* le champ par point resultant est de nature discrete (DEGAY)
      ICHPOR=MCHPOI
      IF (NSOUP1.GT.0) THEN
C
C     ON RECUPERE LES NOMS DES COMPOSANTES ET ON LES MET DANS ICOMP
C     ON CHERCHE EGALEMENT LE NUMERO DU PREMIER NOEUD NON NUL DANS LES
C     IGEOC
C
         INODE=0
         SEGINI SICOMP,IHARM
* gounand Les deux lignes suivantes sont inutiles et potentiellement
*         dangereuses si NC=0
*      ICOMP(**)=MSOUP1.NOCOMP(1)
*      IHARM(**)=MSOUP1.NOHARM(1)
         DO 100 IA=1,NSOUP1
            MSOUP1=MCHPO1.IPCHP(IA)
            SEGACT MSOUP1
            NC1=MSOUP1.NOCOMP(/2)
            DO 120 IB=1,NC1
               DO 140 IC=1,ICOMP(/2)
                  IF (ICOMP(IC).EQ.MSOUP1.NOCOMP(IB)
     S                 .AND.IHARM(IC).EQ.MSOUP1.NOHARM(IB)) GOTO 120
 140           CONTINUE
               ICOMP(**)=MSOUP1.NOCOMP(IB)
               IHARM(**)=MSOUP1.NOHARM(IB)
 120        CONTINUE
            IPT1=MSOUP1.IGEOC
            IF (IPT1.GT.0.AND.INODE.EQ.0) THEN
               SEGACT IPT1
               NBL=IPT1.NUM(/2)
               IF (NBL.GT.0) INODE=IPT1.NUM(1,1)
            ENDIF
 100     CONTINUE
         NC=ICOMP(/2)
         IF (NC.EQ.0) THEN
* On n'a pas trouvé de composantes => CHPO VIDE
            NSOUPO=0
            SEGADJ MCHPOI
         ELSE
            SEGINI MSOUPO
            IPCHP(1)=MSOUPO
C
C     REMPLISSAGE DES NOMS DE COMPOSANTES ET DES HARMONIQUES
C
            DO 210 I=1,NC
               NOCOMP(I)=ICOMP(I)
               NOHARM(I)=IHARM(I)
 210        CONTINUE
C
C     CREATION DU SUPPORT GEOMETRIQUE DU CHPOINT RESULTANT
C
            NBNN=1
            NBELEM=1
* On n'a pas trouvé de noeuds => CHPO VIDE + noms de composantes
* + IGEOC vide + IPOVAL vide
* On est un peu trop gentil
            IF (INODE.EQ.0) NBELEM=0
            NBSOUS=0
            NBREF=0
            SEGINI MELEME
            ITYPEL=1
            IF (INODE.NE.0) NUM(1,1)=INODE
            IGEOC=MELEME
C
C     CREATION DES VALEURS DU CHPOINT RESULTANT
C
            N=1
            IF (INODE.EQ.0) N=0
            SEGINI MPOVAL
            IPOVAL=MPOVAL
            IF (INODE.GT.0) THEN
C
C     BOUCLE SUR LES SOUS PAQUETS DU CHPOINT ARGUMMENT
C
               DO 200 IA=1,NSOUP1
                  MSOUP1=MCHPO1.IPCHP(IA)
                  SEGACT MSOUP1
                  NC1=MSOUP1.NOCOMP(/2)
                  MPOVA1=MSOUP1.IPOVAL
                  SEGACT MPOVA1
C
C     ON CHERCHE LE NOM DE LA COMPOSANTE
C
                  N1=MPOVA1.VPOCHA(/1)
                  DO 220 IB=1,NC1
                     DO 240 IC=1,NC
                        IF (ICOMP(IC).EQ.MSOUP1.NOCOMP(IB)
     S                       .AND.IHARM(IC).EQ.MSOUP1.NOHARM(IB))
     $                       GOTO 260
 240                 CONTINUE
 260                 CONTINUE
C
C     ET ON ADDITIONNE
C
                     DO 280 ID=1,N1
                        VPOCHA(1,IC)=VPOCHA(1,IC)+
     $                       MPOVA1.VPOCHA(ID,IB)
 280                 CONTINUE
 220              CONTINUE
 200           CONTINUE
            ENDIF
         ENDIF
C
C     SUPPRESSION DES SEGMENTS DE TRAVAIL
C
         SEGSUP SICOMP,IHARM
      ENDIF
      END