1 : C WRSOLU SOURCE CHAT 05/01/13 04:12:56 5004 2 : SUBROUTINE WRSOLU(MSOLUT,IRETOU,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C CE SUBROUTINE ECRIT SUR LE FICHIER IOSAU 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 : C 19 : C 20 : IRETOU=0 21 : ILENA(1)=0 22 : ILENA(2)=0 23 : C ... SI LE MSOLUT EST NUL ON MET LES 2 VAL DE TETE A ZERO POUR LE RESTAURER 24 : IF (MSOLUT.NE.0) THEN 25 : SEGACT MSOLUT 26 : NIPO=MSOLIS(/1) 27 : ILENA(1) = NIPO 28 : ILENA(2) = MSOLIS(3) 29 : ENDIF 30 : NTOTO=2 30 : CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) 31 : 32 : IF (MSOLUT.EQ.0) GO TO 110 33 : 34 : NTOTO=2 35 : READ (ITYSOL,FMT='(2A4)') ITABM1(1),ITABM1(2) 35 : CALL ECDIFM (IOSAU,NTOTO,ITABM1,IFORM) 35 : CALL ECDIEE (IOSAU,NIPO,MSOLIS,IFORM) 35 : CALL ECDIFE (IOSAU,NIPO,MSOLIT,IFORM) 36 : 37 : C ... ON PREND LES MSOLIS UN PAR UN 38 : 39 : C ... LISTE DES TEMPS ... 40 : MSOLRE = MSOLIS(1) 41 : IF (MSOLRE.NE.0) THEN 42 : SEGACT MSOLRE 43 : N= SOLRE(/1) 44 : ILENA(1)=N 45 : NTOTO=1 45 : CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) 45 : CALL ECDIFR (IOSAU,N,SOLRE(1),IFORM) 46 : SEGDES MSOLRE 47 : ENDIF 48 : 49 : C ... LISTE DES PAS ... 50 : MSOLEN=MSOLIS(2) 51 : IF (MSOLEN.NE.0) THEN 52 : SEGACT MSOLEN 53 : N=ISOLEN(/1) 54 : ILENA(1)=N 55 : NTOTO=1 55 : CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) 55 : CALL ECDIEE (IOSAU,N,ISOLEN(1),IFORM) 56 : SEGDES MSOLEN 57 : ENDIF 58 : 59 : C ... LISTE DE MMODE ... 60 : MSOLEN=MSOLIS(4) 61 : IF (MSOLEN.NE.0) THEN 62 : SEGACT MSOLEN 63 : N=ISOLEN(/1) 64 : ILENA(1)=N 65 : NTOTO=1 65 : CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) 66 : DO 20 IPAS =1,N 67 : MMODE=ISOLEN(IPAS) 68 : IF (MMODE.EQ.0) THEN 69 : ILENA(1)=IPAS 70 : ILENA(2)=0 71 : ILENA(3)=0 72 : NTOTO=3 72 : CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) 73 : ELSE 74 : SEGACT MMODE 75 : LVALM=FMMODD(/1) 76 : NIMOD=IMMODD(/1) 77 : ILENA(1)=IPAS 78 : ILENA(2)=LVALM 79 : ILENA(3)=NIMOD 80 : NTOTO=3 80 : CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) 80 : CALL ECDIFR (IOSAU,LVALM,FMMODD,IFORM) 80 : CALL ECDIFE (IOSAU,NIMOD,IMMODD,IFORM) 81 : SEGDES MMODE 82 : ENDIF 83 : 20 CONTINUE 84 : SEGDES MSOLEN 85 : 13 ENDIF 86 : 87 : C ... ON VA ENREGISTRER LES POINTEURS CHANGES ... 88 : DO 18 II=5,NIPO 89 : IF(MSOLIS(II).EQ.0) GOTO 18 90 : MSOLEN=MSOLIS(II) 91 : SEGACT MSOLEN 92 : NPAS=ISOLEN(/1) 93 : ILENA(1)=NPAS 94 : NTOTO=1 94 : CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) 94 : CALL ECDIFE (IOSAU,NPAS,ISOLEN(1),IFORM) 95 : 18 CONTINUE 96 : 110 CONTINUE 97 : 11 RETURN 98 : END 99 :
© Cast3M 2003 - All rights reserved.
Disclaimer