Télécharger wrmmat.eso

Retour à la liste

wrmmat
C WRMMAT    SOURCE    PV        20/09/26    21:20:15     10724          
      SUBROUTINE WRMMAT (ISORTI,ITLACC,IMAX1,IFORM,IDEB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C=======================================================================
C      BUT     : ECRITURE DES MMATRI SUR LE FICHIER ISORTI
C      APPELE PAR WRPIL
C      APPELLE :  ECDIFE ECDIFM ECDIFR
C              : ECDES ECDIFP  JDANSI
C      ECRIT PAR FARVACQUE   - REPRIS PAR LENA
C=======================================================================
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRI
      SEGMENT/ITLACC/(ITLAC(0)),ITLAC1.ITLACC,ITLAC2.ITLACC,
     1 ITLAC3.ITLACC,ITLAC4.ITLACC,ITLAC5.ITLACC,ITLAC6.ITLACC
C=======================================================================
C=======================================================================
      SEGMENT/ITBBM1/( ITABM1(NM))
C
      DIMENSION ILENA(30)
C======================================================================
C
C     ***************************** MMATRI *****************************
 6016 CONTINUE
      DO 2600 IEL=IDEB,IMAX1
         MMATRI=ITLAC(IEL)
         SEGACT MMATRI
         IF(IILIGS.NE.0.AND.IONIVE.LE.8) THEN
            CALL ERREUR(723)
            SEGDES MMATRI
            RETURN
         ENDIF
         MILIGN=IILIGN
         SEGACT MILIGN
         NNOE=ILIGN(/1)
         INC=ITTR(/1)
         MINCPO=IINCPO
         SEGACT MINCPO
         NCOMP=INCPO(/1)
         SEGDES MINCPO
         MHARK=IHARK
         SEGACT MHARK
         LHAR=IHAR(/1)
         SEGDES MHARK
         MIMIK=IIMIK
         SEGACT MIMIK
         LMIK=IMIK(/2)
         SEGDES MIMIK
         MIDUA=IIDUA
         SEGACT MIDUA
         LDUA=IDUA(/2)
         SEGDES MIDUA
         ILENA(1) = INC
         ILENA(2) = IGEOMA
         ILENA(3) = IJMAX
         ILENA(4) = INEG
         ILENA(5) = NENS
         ILENA(6) = NCOMP
         ILENA(7) = NNOE
         ILENA(8) = LHAR
         ILENA(9) = LMIK
         ILENA(10)= LDUA
         IF(IONIVE.LE.8) THEN
            ITOTO    = 10
         ELSE
            IF(IILIGS.NE.0) THEN
               ILENA(11)=1
            ELSE
               ILENA(11)=0
            ENDIF
            ITOTO    = 11
         ENDIF
         CALL ECDIFE (ISORTI,ITOTO,ILENA,IFORM)
         CALL ECDIFE (ISORTI,INC,ITTR,IFORM)
         CALL ECDIFE (ISORTI,INC,IPNO,IFORM)
         DO 2601 I=1,NNOE
            LIGN=ILIGN(I)
            SEGACT LIGN
            NVALL=VAL(/1)
            NA=IMMM(/1)
            NA1=IPPVV(/1)
            NBPAR=IVPO(/1)/2
            KLM=1
            ILENA(KLM  )=NVALL
            ILENA(KLM+1)=NA
            ILENA(KLM+2)=NA1
            ILENA(KLM+3)=IMM
            ILENA(KLM+4)=IPREL
            ILENA(KLM+5)=IDERL
            ILENA(KLM+6)=NBPAR
            NN=7
            CALL ECDIFE(ISORTI,NN,ILENA,IFORM)
            CALL ECDIFR(ISORTI,NVALL,VAL,IFORM)
            CALL ECDIFE (ISORTI,NA,IMMM,IFORM)
            CALL ECDIFE (ISORTI,NA1,IPPVV,IFORM)
            CALL ECDIFE (ISORTI,2*NBPAR,IVPO,IFORM)
            SEGDES LIGN
 2601    CONTINUE
         SEGDES MILIGN
C
         IF(IILIGS.NE.0.AND.IONIVE.GE.9) THEN
            MILIGN = IILIGS
            SEGACT MILIGN
 
         DO 2602 I=1,NNOE
            LIGN=ILIGN(I)
            SEGACT LIGN
            NVALL=VAL(/1)
            NA=IMMM(/1)
            NA1=IPPVV(/1)
            NBPAR=IVPO(/1)/2
            KLM=1
            ILENA(KLM  )=NVALL
            ILENA(KLM+1)=NA
            ILENA(KLM+2)=NA1
            ILENA(KLM+3)=IMM
            ILENA(KLM+4)=IPREL
            ILENA(KLM+5)=IDERL
            ILENA(KLM+6)=NBPAR
            NN=7
            CALL ECDIFE(ISORTI,NN,ILENA,IFORM)
            CALL ECDIFR(ISORTI,NVALL,VAL,IFORM)
            CALL ECDIFE (ISORTI,NA,IMMM,IFORM)
            CALL ECDIFE (ISORTI,NA1,IPPVV,IFORM)
            CALL ECDIFE (ISORTI,2*NBPAR,IVPO,IFORM)
            SEGDES LIGN
 2602    CONTINUE
 
 
            SEGDES MILIGN
         ENDIF
C
         MINCPO=IINCPO
         SEGACT MINCPO
         L=NCOMP*NNOE
         CALL ECDIFE(ISORTI,L,INCPO,IFORM)
         SEGDES MINCPO
         MHARK=IHARK
         SEGACT MHARK
         CALL ECDIFE (ISORTI,LHAR,IHAR(1),IFORM)
         SEGDES MHARK
         MIMIK=IIMIK
         MIDUA=IIDUA
         NM=LMIK+LDUA
         SEGINI ITBBM1
         SEGACT MIMIK
         DO 2231 IPV=1,LMIK
            READ (IMIK(IPV),FMT='(A4)') ITABM1(IPV)
 2231    CONTINUE
         SEGDES MIMIK
         SEGACT MIDUA
         DO 2232 IPV=1,LDUA
            READ (IDUA(IPV),FMT='(A4)') ITABM1(IPV+LMIK)
 2232    CONTINUE
         SEGDES MIDUA
         CALL ECDIFM (ISORTI,NM,ITABM1,IFORM)
         SEGSUP ITBBM1
         MDNOR=IDNORM
         SEGACT MDNOR
         CALL ECDIFR(ISORTI,INC,DNOR,IFORM)
         SEGDES MDNOR
         MDIAG=IDIAG
         SEGACT MDIAG
         CALL ECDIFR(ISORTI,INC,DIAG,IFORM)
         SEGDES MDIAG
         SEGDES MMATRI
 2600 CONTINUE
      GOTO 1098
 1098 CONTINUE
      RETURN
      END
 
 
 
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales