1 : C WRMMAT SOURCE CHAT 05/01/13 04:12:18 5004 2 : SUBROUTINE WRMMAT (ISORTI,ITLACC,IMAX1,IFORM,IDEB) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : ECRITURE DES MMATRI SUR LE FICHIER ISORTI 7 : C APPELE PAR WRPIL 8 : C APPELLE : ECDIFE ECDIFM ECDIFR 9 : C : ECDES ECDIFP JDANSI 10 : C ECRIT PAR FARVACQUE - REPRIS PAR LENA 11 : C======================================================================= 12 : -INC CCOPTIO 13 : -INC SMMATRI 14 : SEGMENT/ITLACC/(ITLAC(0)),ITLAC1.ITLACC,ITLAC2.ITLACC, 15 : 1 ITLAC3.ITLACC,ITLAC4.ITLACC,ITLAC5.ITLACC,ITLAC6.ITLACC 16 : C======================================================================= 17 : C======================================================================= 18 : SEGMENT/ITBBM1/( ITABM1(NM)) 19 : C 20 : DIMENSION ILENA(30) 21 : C====================================================================== 22 : C 23 : C ***************************** MMATRI ***************************** 24 : 6016 CONTINUE 25 : DO 2600 IEL=IDEB,IMAX1 26 : MMATRI=ITLAC(IEL) 27 : SEGACT MMATRI 28 : IF(IILIGS.NE.0.AND.IONIVE.LE.8) THEN 28 : CALL ERREUR(723) 29 : SEGDES MMATRI 30 : RETURN 31 : ENDIF 32 : MILIGN=IILIGN 33 : SEGACT MILIGN 34 : NNOE=ILIGN(/1) 35 : INC=ITTR(/1) 36 : MINCPO=IINCPO 37 : SEGACT MINCPO 38 : NCOMP=INCPO(/1) 39 : SEGDES MINCPO 40 : MHARK=IHARK 41 : SEGACT MHARK 42 : LHAR=IHAR(/1) 43 : SEGDES MHARK 44 : MIMIK=IIMIK 45 : SEGACT MIMIK 46 : LMIK=IMIK(/2) 47 : SEGDES MIMIK 48 : MIDUA=IIDUA 49 : SEGACT MIDUA 50 : LDUA=IDUA(/2) 51 : SEGDES MIDUA 52 : ILENA(1) = INC 53 : ILENA(2) = IGEOMA 54 : ILENA(3) = IJMAX 55 : ILENA(4) = INEG 56 : ILENA(5) = NENS 57 : ILENA(6) = NCOMP 58 : ILENA(7) = NNOE 59 : ILENA(8) = LHAR 60 : ILENA(9) = LMIK 61 : ILENA(10)= LDUA 62 : IF(IONIVE.LE.8) THEN 63 : ITOTO = 10 64 : ELSE 65 : IF(IILIGS.NE.0) THEN 66 : ILENA(11)=1 67 : ELSE 68 : ILENA(11)=0 69 : ENDIF 70 : ITOTO = 11 71 : ENDIF 71 : CALL ECDIFE (ISORTI,ITOTO,ILENA,IFORM) 71 : CALL ECDIFE (ISORTI,INC,ITTR,IFORM) 71 : CALL ECDIFE (ISORTI,INC,IPNO,IFORM) 72 : DO 2601 I=1,NNOE 73 : LIGN=ILIGN(I) 74 : SEGACT LIGN 75 : NVALL=VAL(/1) 76 : NA=IMMM(/1) 77 : NA1=IPPVV(/1) 78 : NBPAR=IVPO(/1)/2 79 : KLM=1 80 : ILENA(KLM )=NVALL 81 : ILENA(KLM+1)=NA 82 : ILENA(KLM+2)=NA1 83 : ILENA(KLM+3)=IMM 84 : ILENA(KLM+4)=IPREL 85 : ILENA(KLM+5)=IDERL 86 : ILENA(KLM+6)=NBPAR 87 : NN=7 87 : CALL ECDIFE(ISORTI,NN,ILENA,IFORM) 87 : CALL ECDIFR(ISORTI,NVALL,VAL,IFORM) 87 : CALL ECDIFE (ISORTI,NA,IMMM,IFORM) 87 : CALL ECDIFE (ISORTI,NA1,IPPVV,IFORM) 87 : CALL ECDIFE (ISORTI,2*NBPAR,IVPO,IFORM) 88 : SEGDES LIGN 89 : 2601 CONTINUE 90 : SEGDES MILIGN 91 : C 92 : IF(IILIGS.NE.0.AND.IONIVE.GE.9) THEN 93 : MILIGN = IILIGS 94 : SEGACT MILIGN 95 : 96 : DO 2602 I=1,NNOE 97 : LIGN=ILIGN(I) 98 : SEGACT LIGN 99 : NVALL=VAL(/1) 100 : NA=IMMM(/1) 101 : NA1=IPPVV(/1) 102 : NBPAR=IVPO(/1)/2 103 : KLM=1 104 : ILENA(KLM )=NVALL 105 : ILENA(KLM+1)=NA 106 : ILENA(KLM+2)=NA1 107 : ILENA(KLM+3)=IMM 108 : ILENA(KLM+4)=IPREL 109 : ILENA(KLM+5)=IDERL 110 : ILENA(KLM+6)=NBPAR 111 : NN=7 111 : CALL ECDIFE(ISORTI,NN,ILENA,IFORM) 111 : CALL ECDIFR(ISORTI,NVALL,VAL,IFORM) 111 : CALL ECDIFE (ISORTI,NA,IMMM,IFORM) 111 : CALL ECDIFE (ISORTI,NA1,IPPVV,IFORM) 111 : CALL ECDIFE (ISORTI,2*NBPAR,IVPO,IFORM) 112 : SEGDES LIGN 113 : 2602 CONTINUE 114 : 115 : 116 : SEGDES MILIGN 117 : ENDIF 118 : C 119 : MINCPO=IINCPO 120 : SEGACT MINCPO 121 : L=NCOMP*NNOE 121 : CALL ECDIFE(ISORTI,L,INCPO,IFORM) 122 : SEGDES MINCPO 123 : MHARK=IHARK 124 : SEGACT MHARK 124 : CALL ECDIFE (ISORTI,LHAR,IHAR(1),IFORM) 125 : SEGDES MHARK 126 : MIMIK=IIMIK 127 : MIDUA=IIDUA 128 : NM=LMIK+LDUA 129 : SEGINI ITBBM1 130 : SEGACT MIMIK 131 : DO 2231 IPV=1,LMIK 132 : READ (IMIK(IPV),FMT='(A4)') ITABM1(IPV) 133 : 2231 CONTINUE 134 : SEGDES MIMIK 135 : SEGACT MIDUA 136 : DO 2232 IPV=1,LDUA 137 : READ (IDUA(IPV),FMT='(A4)') ITABM1(IPV+LMIK) 138 : 2232 CONTINUE 139 : SEGDES MIDUA 139 : CALL ECDIFM (ISORTI,NM,ITABM1,IFORM) 140 : SEGSUP ITBBM1 141 : MDNOR=IDNORM 142 : SEGACT MDNOR 142 : CALL ECDIFR(ISORTI,INC,DNOR,IFORM) 143 : SEGDES MDNOR 144 : MDIAG=IDIAG 145 : SEGACT MDIAG 145 : CALL ECDIFR(ISORTI,INC,DIAG,IFORM) 146 : SEGDES MDIAG 147 : SEGDES MMATRI 148 : 2600 CONTINUE 149 : GOTO 1098 150 : 1098 CONTINUE 151 : RETURN 152 : END 153 : 154 : 155 : 156 : 157 : 158 :
© Cast3M 2003 - All rights reserved.
Disclaimer