1 : C ENTNOM SOURCE CHAT 05/01/12 23:40:34 5004 2 : SUBROUTINE ENTNOM(IBAND,NOBJN,NOMM1,NOMM2,IRETOU,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C------------------------------------------------------------------- 6 : C LECTURE DES NOBJN NOMS D OBETS ( SI NOBJN NON NUL) 7 : C 8 : C Entrée : 9 : C IBAND - l'unité de lecture 10 : C NOBJN - le nombre de noms à lire 11 : C IFORM - flag décrivant le format du fichier 12 : C 13 : C Sortie : 14 : C NOMM1 - SEGMENT QUI CONTIENT LES NUMEROS DES OBJETS DS LEUR PILE 15 : C NOMM2 - SEGMENT QUI CONTIENT LE NOM DE CES OBJETS 16 : C IRETOU =0 SI TOUT S'EST BIEN PASSE. IRETOU=1 SINON. 17 : C 18 : C APPELE LFCDIE LFCDIM 19 : C APPELE PAR LIPIL 20 : C ECRIT PAR FARVACQUE - REPRIS PAR LENA 21 : C 22 : C------------------------------------------------------------------- 23 : -INC CCOPTIO 24 : -INC SMLENTI 25 : SEGMENT/NOMM1/(NOM1(NOBJN1)) 26 : SEGMENT NOMM2 27 : CHARACTER*(8) NOM2(NOBJN1) 28 : ENDSEGMENT 29 : C------------------------------------------------------------------- 30 : IRETOU=0 31 : SEGACT NOMM1 32 : SEGACT NOMM2 33 : NOBJN1=NOBJN 34 : SEGADJ NOMM1 35 : SEGADJ NOMM2 36 : 37 : IF (NOBJN.EQ.0) GO TO 1 38 : 39 : IF(IONIVE.LE.2) THEN 40 : JG=NOBJN1*2 41 : SEGINI MLENTI 41 : CALL LFANC(IBAND,NOBJN1,LECT,IRETOU,IFORM,NOM2) 42 : SEGSUP MLENTI 43 : ELSE 43 : CALL LFCDIN(IBAND,NOBJN1,NOM2,IRETOU,IFORM) 44 : ENDIF 45 : IF(IRETOU.NE.0) GO TO 1 46 : 46 : CALL LFCDIE(IBAND,NOBJN1,NOM1,IRETOU,IFORM) 47 : IF(IRETOU.NE.0)GO TO 1 48 : 49 : C ------------------------- 50 : IF(IIMPI.EQ.5) THEN 51 : WRITE(IOIMP,101) 52 : DO 2 I=1,NOBJN 53 : WRITE(IOIMP,100) NOM2(I),NOM1(I) 54 : 2 CONTINUE 55 : ENDIF 56 : C ------------------------- 57 : 1 CONTINUE 58 : SEGDES NOMM1 59 : SEGDES NOMM2 60 : RETURN 61 : 100 FORMAT(2X,A8,2X,I6) 62 : 101 FORMAT(' OBJETS NOMMES ET LEUR RANG DANS LA PILE : ') 63 : END 64 :
© Cast3M 2003 - All rights reserved.
Disclaimer