1 : C LIRBAS SOURCE CHAT 05/01/13 01:20:37 5004 2 : SUBROUTINE LIRBAS(ICOND,IRET1 ,IRET2 ) 3 : C 4 : C LECTURE D'UNE BASE ELEMENTAIRE 5 : C ICOND LECTURE IMPERATIVE OU NON 6 : C IRET1=MSOBAS : POINTEURS DE LA BASE ELEMENTAIRE 7 : C IRET2=MSOBAS : 8 : C 9 : IMPLICIT INTEGER(I-N) 10 : -INC CCOPTIO 11 : -INC SMBASEM 12 : -INC SMSTRUC 13 : C 14 : IRET1=0 15 : IRET2=0 15 : CALL LIROBJ('BASEMODA',IP2,ICOND,IRETOU) 16 : IF(IERR.NE.0) RETURN 17 : IF(IRETOU.EQ.0) RETURN 18 : MBASEM=IP2 19 : SEGACT MBASEM 20 : NBAS=LISBAS(/1) 21 : MSOBAS=LISBAS(1) 22 : IF(NBAS.EQ.1) GOTO 40 23 : C BASE COMPLEXE 23 : CALL LIROBJ('STRUCTUR',IRET,1,IRETOU) 24 : IF(IERR.NE.0) GOTO 4000 25 : MSTRUC=IRET 26 : SEGACT MSTRUC 27 : NSTRU=LISTRU(/1) 28 : MSOSTU=LISTRU(1) 29 : IF(NSTRU.EQ.1) GOTO 20 30 : C STRUCTURE COMPLEXE 30 : CALL LIRENT(IP3,1,IRETOU) 31 : IF(IERR.NE.0) GOTO 3000 32 : C ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES 33 : SEGACT MSOSTU 34 : ISRAI1=ISRAID 35 : SEGDES MSOSTU 36 : DO 10 NS=2,NSTRU 37 : MSOSTU=LISTRU(NS) 38 : SEGACT MSOSTU 39 : IF(ISRAI1.NE.ISRAID) GOTO 2000 40 : SEGDES MSOSTU 41 : 10 CONTINUE 42 : IF(IP3.LE.0.OR.IP3.GT.NSTRU) GOTO 4000 43 : MSOSTU=LISTRU(IP3) 44 : 20 CONTINUE 45 : SEGDES MSTRUC 46 : C ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE 47 : DO 85 NB=1,NBAS 48 : MSOBAS=LISBAS(NB) 49 : SEGACT MSOBAS 50 : IF(IBSTRM(1).EQ.MSOSTU) GOTO 35 51 : SEGDES MSOBAS 52 : 85 CONTINUE 53 : C *** INCOHERENCE ENTRE LA BASE ET LA STRUCTURE 54 : GOTO 4000 55 : 2000 CONTINUE 56 : SEGDES MSOSTU 57 : 3000 CONTINUE 58 : SEGDES MSTRUC 58 : 4000 CALL ERREUR(216) 59 : SEGDES MBASEM 60 : GOTO 5000 61 : C 62 : 35 CONTINUE 63 : SEGDES MSOBAS 64 : 40 CONTINUE 65 : SEGDES MBASEM 66 : IRET1=MSOBAS 67 : IRET2=MBASEM 68 : 5000 CONTINUE 69 : RETURN 70 : END 71 :
© Cast3M 2003 - All rights reserved.
Disclaimer