1 : C BORNER SOURCE FANDEUR 10/12/15 21:15:20 6808 2 : 3 : ************************************************************************ 4 : * * 5 : * OPERATEUR BORN(ER) * 6 : * * 7 : ************************************************************************ 8 : 9 : SUBROUTINE BORNER 10 : 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8(A-H,O-Z) 13 : 14 : -INC CCOPTIO 15 : -INC SMLMOTS 16 : -INC SMLENTI 17 : -INC SMLREEL 18 : 19 : PARAMETER (NMOT = 3) 20 : CHARACTER*4 LMOT(NMOT) 21 : CHARACTER*16 MOTC 22 : 23 : DATA LMOT / 'MAXI','MINI','COMP' / 24 : 25 : IPOBJ = 0 26 : ITOBJ = 0 27 : 28 : * === 29 : * 1 - Lecture de l'objet a borner 30 : * === 31 : * LISTENTI 32 : 1 CONTINUE 32 : CALL LIROBJ('LISTENTI',IPOBJ,0,IRETOU) 33 : IF (IERR.NE.0) RETURN 34 : IF (IRETOU.EQ.0) GOTO 2 35 : ITOBJ = 1 36 : GOTO 100 37 : * LISTREEL 38 : 2 CONTINUE 38 : CALL LIROBJ('LISTREEL',IPOBJ,0,IRETOU) 39 : IF (IERR.NE.0) RETURN 40 : IF (IRETOU.EQ.0) GOTO 3 41 : ITOBJ = 2 42 : GOTO 100 43 : * EVOLUTION 44 : 3 CONTINUE 44 : CALL LIROBJ('EVOLUTIO',IPOBJ,0,IRETOU) 45 : IF (IERR.NE.0) RETURN 46 : IF (IRETOU.EQ.0) GOTO 4 47 : ITOBJ = 3 48 : GOTO 100 49 : * CHPOINT 50 : 4 CONTINUE 50 : CALL LIROBJ('CHPOINT ',IPOBJ,0,IRETOU) 51 : IF (IERR.NE.0) RETURN 52 : IF (IRETOU.EQ.0) GOTO 5 53 : ITOBJ = 4 54 : GOTO 100 55 : * MCHAML 56 : 5 CONTINUE 56 : CALL LIROBJ('MCHAML ',IPOBJ,0,IRETOU) 57 : IF (IERR.NE.0) RETURN 58 : IF (IRETOU.EQ.0) GOTO 6 59 : ITOBJ = 5 60 : GOTO 100 61 : * TYPE NON RECONNU ACTUELLEMENT 62 : 6 CONTINUE 62 : CALL QUETYP(MOTERR(1:8),0,IRETOU) 63 : IF (IRETOU.EQ.0) THEN 63 : CALL ERREUR(533) 64 : ELSE 64 : CALL ERREUR(39) 65 : ENDIF 66 : RETURN 67 : C* GOTO 100 68 : 69 : * === 70 : * 2 - Lecture de l'operation a realiser et la(les) borne(s) associee(s) 71 : * === 72 : 100 CONTINUE 73 : * Quelques initialisations 74 : IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 75 : JG = 10 76 : IF (ITOBJ.EQ.3) THEN 77 : SEGINI,MLENTI 78 : C* ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 79 : ELSE 80 : JGN = 4 81 : JGM = JG 82 : SEGINI,MLMOTS 83 : ENDIF 84 : SEGINI,MLENT1 85 : SEGINI,MLREE1,MLREE2 86 : ENDIF 87 : * 88 : ICOMP = 0 89 : ILCOND = 1 90 : 110 CONTINUE 91 : IF (ITOBJ.EQ.3) THEN 91 : CALL LIRENT(I1,ILCOND,IRETOU) 92 : IF (IERR.NE.0) GOTO 900 93 : IF (IRETOU.EQ.0) GOTO 200 94 : ICOMP = ICOMP + 1 95 : IF (ICOMP.GT.JG) THEN 96 : JG = JG + 10 97 : SEGADJ,MLENTI,MLENT1 98 : SEGADJ,MLREE1,MLREE2 99 : ENDIF 100 : LECT(ICOMP) = I1 101 : ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 101 : CALL LIRCHA(MOTC,ILCOND,IRETOU) 102 : IF (IERR.NE.0) GOTO 900 103 : IF (IRETOU.EQ.0) GOTO 200 104 : ICOMP = ICOMP + 1 105 : IF (ICOMP.GT.JG) THEN 106 : JG = JG + 10 107 : JGM = JG 108 : SEGADJ,MLMOTS 109 : SEGADJ,MLENT1 110 : SEGADJ,MLREE1,MLREE2 111 : ENDIF 112 : MOTS(ICOMP) = MOTC(1:4) 113 : ENDIF 114 : 114 : CALL LIRMOT(LMOT,NMOT,IMOT,1) 115 : IF (IERR.NE.0) GOTO 900 116 : 117 : IF (ITOBJ.EQ.1) THEN 118 : IMIN = 0 119 : IMAX = 0 119 : CALL LIRENT(I1,1,IRETOU) 120 : IF (IERR.NE.0) GOTO 900 121 : IF (IMOT.EQ.1) THEN 122 : IMAX = I1 123 : ELSE IF (IMOT.EQ.2) THEN 124 : IMIN = I1 125 : C* ELSE IF (IMOT.EQ.3) THEN 126 : ELSE 127 : IMIN = I1 127 : CALL LIRENT(IMAX,1,IRETOU) 128 : IF (IERR.NE.0) GOTO 900 129 : IF (IMAX.LT.IMIN) THEN 130 : IMIN = IMAX 131 : IMAX = I1 132 : ENDIF 133 : ENDIF 134 : ELSE 135 : XMIN = 0. 136 : XMAX = 0. 136 : CALL LIRREE(X1,1,IRETOU) 137 : IF (IERR.NE.0) GOTO 900 138 : IF (IMOT.EQ.1) THEN 139 : XMAX = X1 140 : ELSE IF (IMOT.EQ.2) THEN 141 : XMIN = X1 142 : C* ELSE IF (IMOT.EQ.3) THEN 143 : ELSE 144 : XMIN = X1 144 : CALL LIRREE(XMAX,1,IRETOU) 145 : IF (IERR.NE.0) GOTO 900 146 : IF (XMAX.LT.XMIN) THEN 147 : XMIN = XMAX 148 : XMAX = X1 149 : ENDIF 150 : ENDIF 151 : ENDIF 152 : 153 : IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 154 : MLENT1.LECT(ICOMP) = IMOT 155 : MLREE1.PROG(ICOMP) = XMIN 156 : MLREE2.PROG(ICOMP) = XMAX 157 : ILCOND = 0 158 : GOTO 110 159 : ENDIF 160 : 161 : * === 162 : * 3 - Realisation des operations demandees 163 : * === 164 : 200 CONTINUE 165 : IPRES = 0 166 : 167 : IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 168 : IF (ICOMP.NE.JG) THEN 169 : JG = ICOMP 170 : SEGADJ,MLENT1 171 : SEGADJ,MLREE1,MLREE2 172 : IF (ITOBJ.EQ.3) THEN 173 : SEGADJ,MLENTI 174 : C* ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 175 : ELSE 176 : JGM = JG 177 : SEGADJ,MLMOTS 178 : ENDIF 179 : ENDIF 180 : ENDIF 181 : 182 : IF (ITOBJ .EQ. 1) THEN 182 : CALL BORNE1(IPOBJ,IMOT,IMIN,IMAX,IPRES) 182 : IF (IPRES.NE.0) CALL ECROBJ('LISTENTI',IPRES) 183 : ELSE IF (ITOBJ .EQ. 2) THEN 183 : CALL BORNE2(IPOBJ,IMOT,XMIN,XMAX,IPRES) 183 : IF (IPRES.NE.0) CALL ECROBJ('LISTREEL',IPRES) 184 : ELSE IF (ITOBJ .EQ. 3) THEN 184 : CALL BORNE3(IPOBJ,MLENTI,MLENT1,MLREE1,MLREE2,IPRES) 184 : IF (IPRES.NE.0) CALL ECROBJ('EVOLUTIO',IPRES) 185 : ELSE IF (ITOBJ .EQ. 4) THEN 185 : CALL BORNE4(IPOBJ,MLMOTS,MLENT1,MLREE1,MLREE2,IPRES) 185 : IF (IPRES.NE.0) CALL ECROBJ('CHPOINT ',IPRES) 186 : C* ELSE IF (ITOBJ .EQ. 5) THEN 187 : ELSE 187 : CALL BORNE5(IPOBJ,MLMOTS,MLENT1,MLREE1,MLREE2,IPRES) 187 : IF (IPRES.NE.0) CALL ECROBJ('MCHAML ',IPRES) 188 : ENDIF 189 : 190 : * === 191 : * 4 - Menage des objets temporaires 192 : * === 193 : 900 CONTINUE 194 : IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 195 : IF (ITOBJ.EQ.3) THEN 196 : SEGSUP,MLENTI 197 : C* ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN 198 : ELSE 199 : SEGSUP,MLMOTS 200 : ENDIF 201 : SEGSUP,MLENT1,MLREE1,MLREE2 202 : ENDIF 203 : 204 : RETURN 205 : END 206 : 207 :
© Cast3M 2003 - All rights reserved.
Disclaimer