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