Numérotation des lignes :

C MAXIN7    SOURCE    JC220346  16/06/16    21:15:02     8974           C      subroutine maxin7(ipoin1,ipoin2,ipoin3,montyp,kplus,labs)c-----------------------------------------------------------------------cC     objet :  min max entre n chpoints (n>1)c     creation : bp, 2014-12-05cc-----------------------------------------------------------------------       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          SEGDES,MELEME,IPT2        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         SEGDES,MSOUP2,MPOVA2  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        SEGDES,MSOUPO,MPOVAL 801  CONTINUE      SEGDES,MCHPOI      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        SEGDES,MELEME,IPT2        WRITE(IOIMP,*) 'SUPPORTS GEOMETRIQUES DIFFERENTS'        WRITE(IOIMP,*)  IPT2,' different de ',IGEOC        GOTO 999 999  CONTINUE      CALL ERREUR(214)      SEGSUP,MCHPOI      SEGDES,MCHPO1,MCHPO2      RETURN       END

© Cast3M 2003 - Tous droits réservés.
Mentions légales