Sources Esope | Cast3M

wrsolu
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 PPARAM
-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