C WRSOLU SOURCE CHAT 05/01/13 04:12:56 5004 SUBROUTINE WRSOLU(MSOLUT,IRETOU,IFORM) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C======================================================================= C CE SUBROUTINE ECRIT SUR LE FICHIER IOSAU UN OBJET MSOLUT C APPELE PAR WRPIL C APPELLE : SOPAPF ECDIFE ECDIFR C ECRIT PAR FARVACQUE - REPRIS PAR LENA C======================================================================= C DIMENSION ILENA(10) DIMENSION ITABM1(2) -INC CCOPTIO -INC SMSOLUT C----------------------------------------- C======================================================================= C C IRETOU=0 ILENA(1)=0 ILENA(2)=0 C ... SI LE MSOLUT EST NUL ON MET LES 2 VAL DE TETE A ZERO POUR LE RESTAURER IF (MSOLUT.NE.0) THEN SEGACT MSOLUT NIPO=MSOLIS(/1) ILENA(1) = NIPO ILENA(2) = MSOLIS(3) ENDIF NTOTO=2 CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) IF (MSOLUT.EQ.0) GO TO 110 NTOTO=2 READ (ITYSOL,FMT='(2A4)') ITABM1(1),ITABM1(2) CALL ECDIFM (IOSAU,NTOTO,ITABM1,IFORM) CALL ECDIEE (IOSAU,NIPO,MSOLIS,IFORM) CALL ECDIFE (IOSAU,NIPO,MSOLIT,IFORM) C ... ON PREND LES MSOLIS UN PAR UN C ... LISTE DES TEMPS ... MSOLRE = MSOLIS(1) IF (MSOLRE.NE.0) THEN SEGACT MSOLRE N= SOLRE(/1) ILENA(1)=N NTOTO=1 CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) CALL ECDIFR (IOSAU,N,SOLRE(1),IFORM) SEGDES MSOLRE ENDIF C ... LISTE DES PAS ... MSOLEN=MSOLIS(2) IF (MSOLEN.NE.0) THEN SEGACT MSOLEN N=ISOLEN(/1) ILENA(1)=N NTOTO=1 CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) CALL ECDIEE (IOSAU,N,ISOLEN(1),IFORM) SEGDES MSOLEN ENDIF C ... LISTE DE MMODE ... MSOLEN=MSOLIS(4) IF (MSOLEN.NE.0) THEN SEGACT MSOLEN N=ISOLEN(/1) ILENA(1)=N NTOTO=1 CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) DO 20 IPAS =1,N MMODE=ISOLEN(IPAS) IF (MMODE.EQ.0) THEN ILENA(1)=IPAS ILENA(2)=0 ILENA(3)=0 NTOTO=3 CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) ELSE SEGACT MMODE LVALM=FMMODD(/1) NIMOD=IMMODD(/1) ILENA(1)=IPAS ILENA(2)=LVALM ILENA(3)=NIMOD NTOTO=3 CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) CALL ECDIFR (IOSAU,LVALM,FMMODD,IFORM) CALL ECDIFE (IOSAU,NIMOD,IMMODD,IFORM) SEGDES MMODE ENDIF 20 CONTINUE SEGDES MSOLEN 13 ENDIF C ... ON VA ENREGISTRER LES POINTEURS CHANGES ... DO 18 II=5,NIPO IF(MSOLIS(II).EQ.0) GOTO 18 MSOLEN=MSOLIS(II) SEGACT MSOLEN NPAS=ISOLEN(/1) ILENA(1)=NPAS NTOTO=1 CALL ECDIFE (IOSAU,NTOTO,ILENA(1),IFORM) CALL ECDIFE (IOSAU,NPAS,ISOLEN(1),IFORM) 18 CONTINUE 110 CONTINUE 11 RETURN END