1 : C CREOB SOURCE FANDEUR 08/01/16 21:15:01 6022 2 : SUBROUTINE CREOB (ITYPE,NOMM1,NOMM2,ITLACC) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : RECREER LES OBJETS 7 : C APPELE PAR : LIPIL 8 : C : 9 : C ECRIT PAR FARVACQUE -REPRIS PAR LENA 10 : C 11 : C======================================================================= 12 : C======================================================================= 13 : -INC CCOPTIO 14 : C 15 : C 16 : SEGMENT/ITLACC/(ITLAC(0)) 17 : SEGMENT/NOMM1/(NOM1(NOBJN1)) 18 : SEGMENT NOMM2 19 : CHARACTER*(8) NOM2(NOBJN1) 20 : ENDSEGMENT 21 : C 22 : CHARACTER*(*) ITYPE 23 : 24 : CHARACTER*8 NOMM 25 : CHARACTER*512 CK 26 : REAL*8 XK 27 : LOGICAL BK 28 : 29 : C-------------------------------------------------------------------- 30 : SEGACT NOMM1,NOMM2 31 : IMAX1=ITLAC(/1) 32 : NOBJN=NOM1(/1) 33 : C ------------------------------------------------------------------ 34 : C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS******************* 35 : C 36 : IF(NOBJN.EQ.0) GOTO 1 37 : 38 : DO 1094 I=1,NOBJN 39 : IERT=0 40 : J=NOM1(I) 41 : NOMM=NOM2(I) 42 : IF (J.GT.IMAX1) THEN 43 : WRITE(IOIMP,808) ITYPE,NOM2(I) 44 : GO TO 1094 45 : ENDIF 46 : 47 : K=ITLAC(J) 48 : IF(IIMPI.NE.0) WRITE(IOIMP,801)ITYPE,NOM2(I),J,K 49 : 50 : IF(ITYPE.EQ.'ENTIER '.OR.ITYPE.EQ.'FLOTTANT'.OR.ITYPE.EQ. 51 : $ 'LOGIQUE '.OR.ITYPE.EQ.'MOT ') 51 : $ CALL QUEVAL(K,ITYPE,IERT,IK,XK,CK,BK,IOK) 52 : 53 : IF(IERT.EQ.1) THEN 53 : CALL ERREUR(5) 54 : GOTO 1 55 : ENDIF 56 : 57 : IF(ITYPE.EQ.'ENTIER ') THEN 57 : CALL NOMENT(NOMM,IK) 58 : ELSE IF(ITYPE.EQ.'FLOTTANT') THEN 58 : CALL NOMREE(NOMM,XK) 59 : ELSE IF(ITYPE.EQ.'LOGIQUE ') THEN 59 : CALL NOMLOG(NOMM,BK) 60 : ELSE IF(ITYPE.EQ.'MOT ') THEN 60 : CALL NOMCHA(NOMM,CK(1:IK)) 61 : ELSE 61 : CALL NOMOBJ(ITYPE,NOMM,K) 62 : ENDIF 63 : 1094 CONTINUE 64 : 65 : 1 CONTINUE 66 : SEGDES NOMM1 67 : SEGDES NOMM2 68 : RETURN 69 : C ------------------------------------------------------- 70 : 801 FORMAT(2X,A8,2X,A8,2X,2I6) 71 : 808 FORMAT(2X,A8,' * ATTENTION ERREUR SUR L''OBJET ',A8) 72 : END 73 : 74 :
© Cast3M 2003 - All rights reserved.
Disclaimer