1 : C LIINFG SOURCE PV 05/04/13 21:15:54 5073 2 : SUBROUTINE LIINFG(IRET,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : LECTURE DES INFOS GENERALES 7 : C OPTIO REST IORES ; 8 : C APPELE PAR : LIPIL 9 : C APPELLE : ERREUR 10 : C ECRIT PAR FARVACQUE -REPRIS PAR LENA 11 : C 12 : C======================================================================= 13 : -INC CCOPTIO 14 : -INC CCFXDR 15 : C-------------------------------------------------------------------- 16 : IRET=0 17 : C 18 : C **** INFORMATIONS GENERALES CASTEM2000 ***************** 19 : C --- IQUOI=7 20 : IF (IFORM.EQ.1) READ(IORES,703,END=1000,ERR=1000) N 21 : IF (IFORM.EQ.0) READ(IORES,END=1000,ERR=1000) N 22 : if (iform.eq.2) ios=IXDRINT( ixdrr, n) 23 : C-------------------NIVEAU 2 ON A 7 VALEURS 24 : C-------------------NIVEAU 6 ON A 8 VALEURS 25 : IF (N.NE.7.AND.N.NE.8) GO TO 41 26 : IF(IFORM.EQ.1) 27 : * READ(IORES,704,END=1000,ERR=1000)JFOUR 28 : * ,NIFOUR,IFOMOD,IECHO,IIMPO 29 : * ,IOSPI ,ISOTYP 30 : IF(IFORM.EQ.1.AND.N.EQ.8) 31 : * READ(IORES,706,END=1000,ERR=1000)NSDPGE 32 : IF(IFORM.EQ.0.AND.N.EQ.7) 33 : * READ(IORES,END=1000,ERR=1000)JFOUR 34 : * ,NIFOUR,IFOMOD,IECHO,IIMPO 35 : * ,IOSPI ,ISOTYP 36 : IF(IFORM.EQ.0.AND.N.EQ.8) 37 : * READ(IORES,END=1000,ERR=1000)JFOUR 38 : * ,NIFOUR,IFOMOD,IECHO,IIMPO 39 : * ,IOSPI ,ISOTYP ,NSDPGE 40 : if (iform.eq.2) then 41 : ios=IXDRINT( ixdrr, jfour ) 42 : ios=IXDRINT( ixdrr, nifour ) 43 : ios=IXDRINT( ixdrr, ifomod ) 44 : ios=IXDRINT( ixdrr, iecho ) 45 : ios=IXDRINT( ixdrr, iimpo ) 46 : ios=IXDRINT( ixdrr, iospi ) 47 : ios=IXDRINT( ixdrr, isotyp ) 48 : ios=IXDRINT( ixdrr, nsdpge ) 49 : endif 50 : GO TO 42 51 : 41 CONTINUE 52 : C --------------------ANCIEN NIVEAU UNE SEULE VALEUR 53 : IF (N.EQ.0) GO TO 1001 54 : IF (N.NE.1) GO TO 1000 55 : IF(IFORM.EQ.1) READ(IORES,705,END=1000,ERR=1000)JFOUR 56 : IF(IFORM.EQ.0) READ(IORES,END=1000,ERR=1000)JFOUR 57 : C -------------------- 58 : 42 IF(IFOUR.EQ.-1) IFOUR=JFOUR 58 : IF(JFOUR.NE.IFOUR) CALL ERREUR(290) 59 : GO TO 1001 60 : C 61 : ********************* ON REBOUCLE EN LECTURE ********************** 62 : 1000 CONTINUE 63 : IRET=1 64 : 1001 CONTINUE 65 : IF(IIMPI.EQ.5) WRITE(IOIMP,7704)JFOUR 66 : * ,NIFOUR,IFOMOD,IECHO,IIMPI 67 : * ,IOSPI ,ISOTYP 68 : IF(IIMPI.EQ.5.AND.N.EQ.8) WRITE(IOIMP,7706)NSDPGE 69 : RETURN 70 : C ------------------------------------------------------- 71 : 703 FORMAT(23X,I4) 72 : 7704 FORMAT(' IFOUR',I4,' NIFOUR',I4,' IFOMOD',I4,' IECHO',I4, 73 : *' IIMPI',I4,' IOSPI',I4,' ISOTYP',I4) 74 : 704 FORMAT(6X,I4,7X,I4,7X,I4,6X,I4,6X,I4,6X,I4,7X,I4) 75 : 705 FORMAT(6X,I4,7X,I4,7X,I4) 76 : 706 FORMAT(7X,I6) 77 : 7706 FORMAT(' NSDPGE',I6) 78 : END 79 : 80 : 81 : 82 : 83 : 84 :
© Cast3M 2003 - All rights reserved.
Disclaimer