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