Télécharger liinfg.eso

Retour à la liste

Numérotation des lignes :

  1. C LIINFG SOURCE PV 17/10/03 21:15:59 9581
  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. -INC CCGEOME
  16. C--------------------------------------------------------------------
  17. IRET=0
  18. C
  19. C **** INFORMATIONS GENERALES CASTEM2000 *****************
  20. C --- IQUOI=7
  21. IF (IFORM.EQ.1) READ(IORES,703,END=1000,ERR=1000) N
  22. IF (IFORM.EQ.0) READ(IORES,END=1000,ERR=1000) N
  23. if (iform.eq.2) ios=IXDRINT( ixdrr, n)
  24. C-------------------NIVEAU 2 ON A 7 VALEURS
  25. C-------------------NIVEAU 6 ON A 8 VALEURS
  26. C- A partir du niveau 20 on relit nsdpge mais on ne s'en sert plus...
  27. IF (N.NE.7.AND.N.NE.8) GO TO 41
  28. IF(IFORM.EQ.1)
  29. * READ(IORES,704,END=1000,ERR=1000)JFOUR
  30. * ,NIFOUR,IFOMOD,ILGNI,IIMPO
  31. * ,IOSPI ,ISOTYP
  32. IF(IFORM.EQ.1.AND.N.EQ.8)
  33. * READ(IORES,706,END=1000,ERR=1000)NSDPGE
  34. IF(IFORM.EQ.0.AND.N.EQ.7)
  35. * READ(IORES,END=1000,ERR=1000)JFOUR
  36. * ,NIFOUR,IFOMOD,ILGNI,IIMPO
  37. * ,IOSPI ,ISOTYP
  38. IF(IFORM.EQ.0.AND.N.EQ.8)
  39. * READ(IORES,END=1000,ERR=1000)JFOUR
  40. * ,NIFOUR,IFOMOD,ILGNI,IIMPO
  41. * ,IOSPI ,ISOTYP ,NSDPGE
  42. if (iform.eq.2) then
  43. ios=IXDRINT( ixdrr, jfour )
  44. ios=IXDRINT( ixdrr, nifour )
  45. ios=IXDRINT( ixdrr, ifomod )
  46. ios=IXDRINT( ixdrr, ilgni )
  47. ios=IXDRINT( ixdrr, iimpo )
  48. ios=IXDRINT( ixdrr, iospi )
  49. ios=IXDRINT( ixdrr, isotyp )
  50. ios=IXDRINT( ixdrr, nsdpge )
  51. endif
  52. GO TO 42
  53. 41 CONTINUE
  54. C --------------------ANCIEN NIVEAU UNE SEULE VALEUR
  55. IF (N.EQ.0) GO TO 1001
  56. IF (N.NE.1) GO TO 1000
  57. IF(IFORM.EQ.1) READ(IORES,705,END=1000,ERR=1000)JFOUR
  58. IF(IFORM.EQ.0) READ(IORES,END=1000,ERR=1000)JFOUR
  59. C --------------------
  60. 42 IF(IFOUR.EQ.-1) IFOUR=JFOUR
  61. IF(JFOUR.NE.IFOUR) CALL ERREUR(290)
  62. GO TO 1001
  63. C
  64. ********************* ON REBOUCLE EN LECTURE **********************
  65. 1000 CONTINUE
  66. IRET=1
  67. 1001 CONTINUE
  68. IF (IIMPI.EQ.5) THEN
  69. WRITE(IOIMP,7704)JFOUR
  70. * ,NIFOUR,IFOMOD,ILGNI,IIMPI
  71. * ,IOSPI ,ISOTYP
  72. IF (N.EQ.8) WRITE(IOIMP,7706)NSDPGE
  73. ENDIF
  74. RETURN
  75. C -------------------------------------------------------
  76. 703 FORMAT(23X,I4)
  77. 7704 FORMAT(' IFOUR',I4,' NIFOUR',I4,' IFOMOD',I4,' ILGNI',I4,
  78. *' IIMPI',I4,' IOSPI',I4,' ISOTYP',I4)
  79. 704 FORMAT(6X,I4,7X,I4,7X,I4,6X,I4,6X,I4,6X,I4,7X,I4)
  80. 705 FORMAT(6X,I4,7X,I4,7X,I4)
  81. 706 FORMAT(7X,I6)
  82. 7706 FORMAT(' NSDPGE',I6)
  83. END
  84.  
  85.  
  86.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales