Sources Esope | Cast3M

maxin7
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