Télécharger lisolu.eso

Retour à la liste

Numérotation des lignes :

lisolu
  1. C LISOLU SOURCE CHAT 05/01/13 01:22:25 5004
  2. SUBROUTINE LISOLU(MSOLUT,IRETOU,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C CE SUBROUTINE LIT SUR LE FICHIER IORES UN OBJET MSOLUT
  7. C APPELE PAR WRPIL
  8. C APPELLE : SOPAPF ECDIFE ECDIFR
  9. C ECRIT PAR FARVACQUE - REPRIS PAR LENA
  10. C=======================================================================
  11. C
  12. DIMENSION ILENA(10)
  13. DIMENSION ITABM1(2)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMSOLUT
  18. C
  19. C
  20. IRETOU=0
  21. ILENA(1)=0
  22. ILENA(2)=0
  23. ILENA(3)=0
  24. MSOLUT =0
  25.  
  26. NTOTO=2
  27. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  28. IF (IRETOU.NE.0)GO TO 998
  29.  
  30. NIPO =ILENA(1)
  31. cmb-vieux-et-faux IF (NIPO.EQ.0) GO TO 99
  32. SEGINI MSOLUT
  33. IF(NIPO.GE.3) MSOLIS(3)=ILENA(2)
  34.  
  35. NTOTO=2
  36. CALL LFCDIM (IORES,NTOTO,ITABM1,IRETOU,IFORM)
  37. IF (IRETOU.NE.0)GO TO 998
  38. WRITE(ITYSOL,FMT='(2A4)') ITABM1(1),ITABM1(2)
  39.  
  40. C ... Si NIPO==0 il n'y avait que le ITYSOL de sauvé ...
  41. IF (NIPO.EQ.0) GO TO 99
  42.  
  43. C MODI 19 DEC 1 CARTE
  44. C CALL LFCDIE (IORES,NIPO,MSOLIS,IRETOU,IFORM)
  45. CALL LFCDEE (IORES,NIPO,MSOLIS(1),IRETOU,IFORM)
  46. IF (IRETOU.NE.0)GO TO 998
  47.  
  48. CALL LFCDIE (IORES,NIPO,MSOLIT,IRETOU,IFORM)
  49. IF (IRETOU.NE.0)GO TO 998
  50.  
  51. C ON PREND LES MSOLIS UN PAR UN
  52. MSOLRE = MSOLIS(1)
  53. IF (MSOLRE.EQ.0) GO TO 11
  54. NTOTO=1
  55. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  56. IF (IRETOU.NE.0)GO TO 998
  57. N=ILENA(1)
  58. SEGINI MSOLRE
  59. CALL LFCDI2 (IORES,N,SOLRE(1),IRETOU,IFORM)
  60. IF (IRETOU.NE.0)GO TO 998
  61. SEGDES MSOLRE
  62. MSOLIS(1)=MSOLRE
  63. 11 CONTINUE
  64. C LISTE DES PAS------------------------------
  65. MSOLEN=MSOLIS(2)
  66. IF (MSOLEN.EQ.0) GO TO 12
  67. NTOTO=1
  68. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  69. IF (IRETOU.NE.0)GO TO 998
  70. N=ILENA(1)
  71. SEGINI MSOLEN
  72. C MODI 19 DEC 1 CARTE
  73. C CALL LFCDIE (IORES,N,ISOLEN,IRETOU,IFORM)
  74. CALL LFCDEE (IORES,N,ISOLEN(1),IRETOU,IFORM)
  75. IF (IRETOU.NE.0)GO TO 998
  76. SEGDES MSOLEN
  77. MSOLIS(2)=MSOLEN
  78. C LISTE DE MMODE-----------------------------
  79. 12 CONTINUE
  80. MSOLEN=MSOLIS(4)
  81. IF (MSOLEN.EQ.0) GO TO 13
  82. NTOTO=1
  83. ILENA(1)=N
  84. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  85. IF (IRETOU.NE.0)GO TO 998
  86. N=ILENA(1)
  87. SEGINI MSOLEN
  88. MSOLIS(4)=MSOLEN
  89. DO 20 IPAS =1,N
  90. ILENA(1)=0
  91. ILENA(2)=0
  92. ILENA(3)=0
  93. MMODE=0
  94. NTOTO=3
  95. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  96. IF (IRETOU.NE.0)GO TO 998
  97. NIPAS= ILENA(1)
  98. IF (NIPAS.NE.IPAS) GO TO 998
  99. ISOMME = ILENA(2)+ILENA(3)
  100. C TEST SI MMODE EXISTE-----------
  101. IF (ISOMME.EQ.0) GO TO 21
  102. LVALM=ILENA(2)
  103. NIMOD=ILENA(3)
  104. SEGINI MMODE
  105. NTOTO=3
  106. CALL LFCDI2 (IORES,LVALM,FMMODD,IRETOU,IFORM)
  107. IF (IRETOU.NE.0)GO TO 998
  108. CALL LFCDIE (IORES,NIMOD,IMMODD,IRETOU,IFORM)
  109. IF (IRETOU.NE.0)GO TO 998
  110. SEGDES MMODE
  111. 21 CONTINUE
  112. ISOLEN(IPAS)=MMODE
  113. 20 CONTINUE
  114. SEGDES MSOLEN
  115. 13 CONTINUE
  116.  
  117. C ON VA RELIRE LESPOINTEURS---------------
  118. DO 18 II=5,NIPO
  119. MSOLEN=MSOLIS(II)
  120. IF(MSOLEN.EQ.0) GOTO 18
  121. NTOTO=1
  122. CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
  123. IF (IRETOU.NE.0)GO TO 998
  124. N=ILENA(1)
  125. SEGINI MSOLEN
  126. CALL LFCDIE (IORES,N,ISOLEN,IRETOU,IFORM)
  127. IF (IRETOU.NE.0)GO TO 998
  128. SEGDES MSOLEN
  129. MSOLIS(II)=MSOLEN
  130. 18 CONTINUE
  131. 998 CONTINUE
  132. 99 RETURN
  133. END
  134.  
  135.  
  136.  

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