C MAXIN7 SOURCE CB215821 20/11/25 13:34:11 10792 C subroutine maxin7(ipoin1,ipoin2,ipoin3,montyp,kplus,labs) c----------------------------------------------------------------------- c C objet : min max entre n chpoints (n>1) c creation : bp, 2014-12-05 c c----------------------------------------------------------------------- implicit real*8(a-h,o-z) implicit integer (i-n) character*(8) montyp -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMELEME C-----INITIALISATION---------------------------------------------------- MCHPO1=ipoin1 SEGINI,MCHPOI=MCHPO1 ipoin3 = MCHPOI NSOUPO=IPCHP(/1) DO 101 ISOUPO = 1,NSOUPO MSOUP1 = IPCHP(ISOUPO) SEGINI,MSOUPO=MSOUP1 NC=NOCOMP(/2) IPCHP(ISOUPO)=MSOUPO MPOVA1=IPOVAL SEGINI,MPOVAL=MPOVA1 IPOVAL=MPOVAL 101 CONTINUE c-----debut de boucle sur MCHPO2 1 MCHPO2=ipoin2 SEGACT,MCHPO2 NSOUP2=MCHPO2.IPCHP(/1) IF (NSOUP2.NE.NSOUPO) GOTO 990 DO 201 ISOUPO = 1,NSOUPO MSOUPO = IPCHP(ISOUPO) MSOUP2 = MCHPO2.IPCHP(ISOUPO) SEGACT,MSOUP2 c --ON TESTE SI 2 EST TOUT PAREIL-- IF(NOCOMP(/2).NE.NC) GOTO 991 DO 211 IC=1,NC IF(NOCOMP(IC).NE.MSOUP2.NOCOMP(IC)) GOTO 991 211 CONTINUE IPT2=MSOUP2.IGEOC IF(IPT2.NE.IGEOC) THEN * on se donne une chance : meleme avec les meme noeuds dans le * meme ordre mais pointeurs differents MELEME=IGEOC SEGACT,MELEME,IPT2 NBELEM=NUM(/2) IF(NBELEM.NE.IPT2.NUM(/2)) GOTO 992 DO IB=1,NBELEM IF(NUM(1,IB).NE.IPT2.NUM(1,IB)) GOTO 992 ENDDO ENDIF C --ON FAIT LE TRAVAIL-- MPOVAL=IPOVAL N=VPOCHA(/1) MPOVA2=MSOUP2.IPOVAL SEGACT,MPOVA2 IF( kplus.eq.1) THEN IF (labs.eq.0) THEN DO 301 j=1,NC DO 301 i=1,N VPOCHA(i,j)=MAX(VPOCHA(i,j),MPOVA2.VPOCHA(i,j)) 301 CONTINUE ELSE DO 3010 j=1,NC DO 3010 i=1,N VPOCHA(i,j)=MAX(ABS(VPOCHA(i,j)),ABS(MPOVA2.VPOCHA(i,j))) 3010 CONTINUE ENDIF ELSE IF (labs.eq.0) THEN DO 302 j=1,NC DO 302 i=1,N VPOCHA(i,j)=MIN(VPOCHA(i,j),MPOVA2.VPOCHA(i,j)) 302 CONTINUE ELSE DO 3020 j=1,NC DO 3020 i=1,N VPOCHA(i,j)=MIN(ABS(VPOCHA(i,j)),ABS(MPOVA2.VPOCHA(i,j))) 3020 CONTINUE ENDIF ENDIF 201 CONTINUE call lirobj(montyp,ipoin2,0,iretou) if(iretou.ne.0) go to 1 C-----FIN NORMALE------------------------------------------------------- DO 801 ISOUPO = 1,NSOUPO MSOUPO = IPCHP(ISOUPO) MPOVAL=IPOVAL 801 CONTINUE RETURN C-----ERREUR------------------------------------------------------------ 990 CONTINUE WRITE(IOIMP,*) 'NOMBRE DE ZONES DIFFERENT' WRITE(IOIMP,*) NSOUP2,NSOUPO GOTO 999 991 CONTINUE WRITE(IOIMP,*) 'COMPOSANTES DIFFERENTES' WRITE(IOIMP,*) NOCOMP(IC),' different de ',MSOUP2.NOCOMP(IC) GOTO 999 992 CONTINUE WRITE(IOIMP,*) 'SUPPORTS GEOMETRIQUES DIFFERENTS' WRITE(IOIMP,*) IPT2,' different de ',IGEOC GOTO 999 999 CONTINUE CALL ERREUR(214) SEGSUP,MCHPOI RETURN END