Télécharger lisolu.eso

Retour à la liste

Numérotation des lignes :

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

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