C BORNER SOURCE CB215821 21/03/03 21:15:01 10910 ************************************************************************ * * * OPERATEUR BORN(ER) * * * ************************************************************************ SUBROUTINE BORNER IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMLMOTS -INC SMLENTI -INC SMLREEL -INC SMCHPOI -INC SMCHAML PARAMETER (NMOT = 3) CHARACTER*(4) LMOT(NMOT) CHARACTER*(LOCOMP) MOTC DATA LMOT / 'MAXI','MINI','COMP' / IPOBJ = 0 ITOBJ = 0 * === * 1 - Lecture de l'objet a borner * === * LISTENTI 1 CONTINUE CALL LIROBJ('LISTENTI',IPOBJ,0,IRETOU) IF (IERR.NE.0) RETURN IF (IRETOU.EQ.0) GOTO 2 MLENTI=IPOBJ SEGACT,MLENTI ITOBJ = 1 GOTO 100 * LISTREEL 2 CONTINUE CALL LIROBJ('LISTREEL',IPOBJ,0,IRETOU) IF (IERR.NE.0) RETURN IF (IRETOU.EQ.0) GOTO 3 MLREEL=IPOBJ SEGACT,MLREEL ITOBJ = 2 GOTO 100 * EVOLUTION 3 CONTINUE CALL LIROBJ('EVOLUTIO',IPOBJ,0,IRETOU) IF (IERR.NE.0) RETURN IF (IRETOU.EQ.0) GOTO 4 CALL ACTOBJ('EVOLUTIO',IPOBJ,1) ITOBJ = 3 GOTO 100 * CHPOINT 4 CONTINUE CALL LIROBJ('CHPOINT ',IPOBJ,0,IRETOU) IF (IERR.NE.0) RETURN IF (IRETOU.EQ.0) GOTO 5 CALL ACTOBJ('CHPOINT ',IPOBJ,1) CALL NBCOMP(IPOBJ,'CHPOINT ',NBCO) IF(NBCO .EQ. 0)THEN C Pour l'instant erreur pour les objets vides MOTERR='CHPOINT' INTERR= IPOBJ CALL ERREUR(356) RETURN ENDIF ITOBJ = 4 GOTO 100 * MCHAML 5 CONTINUE CALL LIROBJ('MCHAML ',IPOBJ,0,IRETOU) IF (IERR.NE.0) RETURN IF (IRETOU.EQ.0) GOTO 6 CALL ACTOBJ('MCHAML ',IPOBJ,1) CALL NBCOMP(IPOBJ,'MCHAML ',NBCO) IF(NBCO .EQ. 0)THEN C Pour l'instant erreur pour les objets vides MOTERR='MCHAML' INTERR= IPOBJ CALL ERREUR(356) RETURN ENDIF ITOBJ = 5 GOTO 100 * TYPE NON RECONNU ACTUELLEMENT 6 CONTINUE CALL QUETYP(MOTERR(1:8),0,IRETOU) IF (IRETOU.EQ.0) THEN CALL ERREUR(533) ELSE CALL ERREUR(39) ENDIF RETURN C* GOTO 100 * === * 2 - Lecture de l'operation a realiser et la(les) borne(s) associee(s) * === 100 CONTINUE * Quelques initialisations IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN IF (ITOBJ.EQ.3) THEN JG = 10 SEGINI,MLENTI C* ELSEIF(ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN ELSE C Cas des CHPOINTS et MCHAMLS JGN = LOCOMP JG = NBCO JGM = JG SEGINI,MLMOTS ENDIF SEGINI,MLENT1,MLREE1,MLREE2 ENDIF * ICOMP = 0 ILCOND = 1 110 CONTINUE IF (ITOBJ.EQ.3) THEN CALL LIRENT(I1,ILCOND,IRETOU) IF (IERR.NE.0) GOTO 900 IF (IRETOU.EQ.0) GOTO 200 ICOMP = ICOMP + 1 IF (ICOMP.GT.JG) THEN JG = JG + 10 SEGADJ,MLENTI,MLENT1 SEGADJ,MLREE1,MLREE2 ENDIF LECT(ICOMP) = I1 ELSEIF(ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN C Cas des CHPOINTS et MCHAMLS C Lecture optionnelle du nom de la composante CALL LIRCHA(MOTC,0,IRETOU) IF (IERR .NE.0) GOTO 900 IF (IRETOU.EQ.0) THEN C On n'a plus rien a lire normalement on va faire le travail GOTO 200 ELSE CALL PLACE(LMOT,NMOT,IMOT,MOTC(1:4)) IF(IMOT .NE. 0)THEN C On n'a pas lu de nom de composante mais le mot cle suivant ==> REFUS CALL REFUS IF (NBCO .EQ. 1)THEN C On prend la seule composante du CHAMP sans poser de question IF (ITOBJ.EQ.4)THEN C Cas des CHPOINTS MCHPOI=IPOBJ MSOUPO=MCHPOI.IPCHP(1) MOTC =MSOUPO.NOCOMP(1) ELSEIF(ITOBJ.EQ.5)THEN C Cas des MCHAMLS MCHELM=IPOBJ MCHAML=MCHELM.ICHAML(1) MOTC =MCHAML.NOMCHE(1) ELSE CALL ERREUR(5) ENDIF ELSE C On demande quelle composante==> ERREUR INTERR(1)=NBCO CALL ERREUR(761) RETURN ENDIF ENDIF ENDIF ICOMP = ICOMP + 1 IF (ICOMP.GT.NBCO) THEN IF (ITOBJ.EQ.4)THEN C Cas des CHPOINTS MOTERR='CHPOINT' ELSEIF(ITOBJ.EQ.5)THEN C Cas des MCHAMLS MOTERR='MCHAML' ELSE CALL ERREUR(5) ENDIF CALL ERREUR(980) RETURN ENDIF MOTS(ICOMP) = MOTC ENDIF CALL LIRMOT(LMOT,NMOT,IMOT,1) IF (IERR.NE.0) GOTO 900 IF (ITOBJ.EQ.1) THEN IMIN = 0 IMAX = 0 CALL LIRENT(I1,1,IRETOU) IF (IERR.NE.0) GOTO 900 IF (IMOT.EQ.1) THEN IMAX = I1 ELSEIF(IMOT.EQ.2) THEN IMIN = I1 ELSEIF(IMOT.EQ.3) THEN IMIN = I1 CALL LIRENT(IMAX,1,IRETOU) IF (IERR.NE.0) GOTO 900 IF (IMAX.LT.IMIN) THEN IMIN = IMAX IMAX = I1 ENDIF ELSE CALL ERREUR(5) ENDIF ELSE XMIN = 0. XMAX = 0. CALL LIRREE(X1,1,IRETOU) IF (IERR.NE.0) GOTO 900 IF (IMOT.EQ.1) THEN XMAX = X1 ELSEIF(IMOT.EQ.2) THEN XMIN = X1 ELSEIF(IMOT.EQ.3) THEN XMIN = X1 CALL LIRREE(XMAX,1,IRETOU) IF (IERR.NE.0) GOTO 900 IF (XMAX.LT.XMIN) THEN XMIN = XMAX XMAX = X1 ENDIF ELSE CALL ERREUR(5) ENDIF ENDIF IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN MLENT1.LECT(ICOMP) = IMOT MLREE1.PROG(ICOMP) = XMIN MLREE2.PROG(ICOMP) = XMAX ILCOND = 0 GOTO 110 ENDIF * === * 3 - Realisation des operations demandees * === 200 CONTINUE IPRES = 0 IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN IF (ICOMP.NE.JG) THEN JG = ICOMP SEGADJ,MLENT1 SEGADJ,MLREE1,MLREE2 IF (ITOBJ.EQ.3) THEN SEGADJ,MLENTI ELSEIF(ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN JGM = JG SEGADJ,MLMOTS ELSE CALL ERREUR(5) ENDIF ENDIF ENDIF IF (ITOBJ .EQ. 1) THEN CALL BORNE1(IPOBJ,IMOT,IMIN,IMAX,IPRES) IF (IPRES.NE.0) CALL ECROBJ('LISTENTI',IPRES) ELSEIF(ITOBJ .EQ. 2) THEN CALL BORNE2(IPOBJ,IMOT,XMIN,XMAX,IPRES) IF (IPRES.NE.0) CALL ECROBJ('LISTREEL',IPRES) ELSEIF(ITOBJ .EQ. 3) THEN CALL BORNE3(IPOBJ,MLENTI,MLENT1,MLREE1,MLREE2,IPRES) IF (IPRES.NE.0) CALL ECROBJ('EVOLUTIO',IPRES) ELSEIF(ITOBJ .EQ. 4) THEN CALL BORNE4(IPOBJ,MLMOTS,MLENT1,MLREE1,MLREE2,IPRES) IF (IPRES.NE.0) THEN CALL ACTOBJ('CHPOINT ',IPRES,1) CALL ECROBJ('CHPOINT ',IPRES) ENDIF ELSEIF(ITOBJ .EQ. 5) THEN CALL BORNE5(IPOBJ,MLMOTS,MLENT1,MLREE1,MLREE2,IPRES) IF (IPRES.NE.0) THEN CALL ACTOBJ('MCHAML ',IPRES,1) CALL ECROBJ('MCHAML ',IPRES) ENDIF ELSE CALL ERREUR(5) ENDIF * === * 4 - Menage des objets temporaires * === 900 CONTINUE IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN IF (ITOBJ.EQ.3) THEN SEGSUP,MLENTI ELSEIF(ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN SEGSUP,MLMOTS ENDIF SEGSUP,MLENT1,MLREE1,MLREE2 ENDIF END