1 : C OTER SOURCE CHAT 09/09/09 21:15:08 6493 2 : subroutine oter 3 : implicit integer(i-n) 4 : implicit real*8(a-h,o-z) 5 : -INC CCOPTIO 6 : -INC SMTABLE 7 : character*8 typind 8 : * 9 : * oter un indice d'une table en conservant la meme table 10 : * 10 : call lirobj ('TABLE', IPTABL,1,iretou) 11 : if(ierr.ne.0) return 11 : CALL QUETYP ( TYPIND,1,IRETOU) 12 : IF(IERR.NE.0) RETURN 13 : IF(TYPIND.EQ.'FLOTTANT' ) THEN 13 : CALL LIRREE ( XVA,1,IRETOU) 14 : ELSE 14 : CALL LIROBJ ( TYPIND , INDICE, 1,IRETOU) 15 : ENDIF 16 : IF ( IERR.NE.0) RETURN 17 : MTABLE = IPTABL 18 : SEGACT,MTABLE*MOD 19 : M = MLOTAB 20 : M0 = 0 21 : IF (TYPIND.EQ.'FLOTTANT') THEN 22 : DO 103 I=1,M 23 : IF( RMTABI(I) . EQ. XVA) THEN 24 : M0 = I 25 : GO TO 102 26 : ENDIF 27 : 103 CONTINUE 28 : ELSE 29 : DO 100 I=1,M 30 : IF (MTABTI(I) .EQ. TYPIND) THEN 31 : IF (MTABII(I) .EQ. INDICE) THEN 32 : M0 = I 33 : GOTO 102 34 : END IF 35 : END IF 36 : 100 CONTINUE 37 : 38 : * END DO 39 : ENDIF 40 : 102 CONTINUE 41 : * 42 : IF (M0 .EQ. 0) THEN 42 : CALL ERREUR (171) 43 : RETURN 44 : END IF 45 : * 46 : * write(6,*) ' M0 ', M0 47 : M = M - 1 48 : MLOTAB=MLOTAB-1 49 : * 50 : * END DO 51 : DO 210 I=M0,M 52 : MTABLE.MTABTI(I) = MTABLE.MTABTI(I+1) 53 : MTABLE.MTABTV(I) = MTABLE.MTABTV(I+1) 54 : MTABLE.RMTABI(I) = MTABLE.RMTABI(I+1) 55 : MTABLE.MTABII(I) = MTABLE.MTABII(I+1) 56 : MTABLE.MTABIV(I) = MTABLE.MTABIV(I+1) 57 : MTABLE.RMTABV(I) = MTABLE.RMTABV(I+1) 58 : 210 CONTINUE 59 : * END DO 60 : * 61 : SEGDES,MTABLE 62 : * 63 : END 64 :
© Cast3M 2003 - All rights reserved.
Disclaimer