Télécharger la plaquette Cast3M


fr en

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