1 : C WRMODL SOURCE CHAT 11/03/16 21:33:39 6902 2 : SUBROUTINE WRMODL(IOSAU,ITLACC,IMAX1,IFORM,IONIVE,IDEB) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *--------------------------------------------------------------------* 6 : * * 7 : * Ecriture d'un nouveau MODELE sur le fichier IOSAU. * 8 : * * 9 : * Paramètres: * 10 : * * 11 : * IOSAU Numéro du fichier de sortie * 12 : * ITLACC Pile contenant les nouveaux MODELEs * 13 : * IMAX1 Nombre de MODELEs dans la pile * 14 : * IFORM Si sauvegarde en format ou non * 15 : * * 16 : * Appelé par: WRPIL * 17 : * * 18 : * Auteur, date de création: * 19 : * * 20 : * Denis ROBERT-MOUGIN, le 5 juillet 1989. * 21 : * * 22 : *--------------------------------------------------------------------* 23 : -INC SMMODEL 24 : * 25 : SEGMENT,ITLACC 26 : INTEGER ITLAC(0) 27 : ENDSEGMENT 28 : SEGMENT,MTABE1 29 : INTEGER ITABE1(NM1) 30 : ENDSEGMENT 31 : SEGMENT,MTABE2 32 : CHARACTER*(8) ITABE2(NM2) 33 : ENDSEGMENT 34 : SEGMENT,MTABE3 35 : CHARACTER*(8) ITABE3(NM3) 36 : ENDSEGMENT 37 : SEGMENT,MTABE4 38 : INTEGER ITABE4(NM4) 39 : ENDSEGMENT 40 : SEGMENT,MTABE5 41 : CHARACTER*(8) ITABE5(NM5) 42 : ENDSEGMENT 43 : SEGMENT,MTABE6 44 : CHARACTER*(8) ITABE6(NM6) 45 : ENDSEGMENT 46 : SEGMENT,MTAB6B 47 : CHARACTER*(4) ITAB6B(NM6) 48 : ENDSEGMENT 49 : SEGMENT,MTABE7 50 : CHARACTER*(8) ITABE7(NM7) 51 : ENDSEGMENT 52 : SEGMENT,MTABE8 53 : integer itabe8(nm7) 54 : ENDSEGMENT 55 : SEGMENT MTABE9 56 : integer itabe9(nm9) 57 : endsegment 58 : 59 : * 60 : INTEGER IDAN(10) 61 : * 62 : MN3=0 63 : N45=38 64 : NIDAN=10 65 : * pour l'instant idan(9 et 10) sont libres 66 : 67 : * 68 : * BOUCLE SUR LES MODELES CONTENUS DANS LA PILE: 69 : * 70 : DO 10 IEL=IDEB,IMAX1 71 : DO 110 INI=1,NIDAN 72 : IDAN(INI) = 0 73 : 110 CONTINUE 74 : MMODEL = ITLAC(IEL) 75 : IF (MMODEL.eq.0) GO TO 10 76 : SEGACT,MMODEL 77 : N1 = KMODEL(/1) 78 : * 79 : * Boucles sur les zones élémentaires du MODELE: 80 : * 81 : NM1 = N1 * N45 82 : NM2 = 0 83 : NM3 = 0 84 : NM4 = 0 85 : NM6 = 0 86 : nm7= 0 87 : nm9=n1*16 88 : segini mtabe9 89 : SEGINI,MTABE1 90 : * IF(IONIVE.GE.4) THEN 91 : * a partir du niveau 13 on stocke aussi PHAMOD 92 : IDECMO=4 93 : NM5 = N1 * idecmo 94 : SEGINI,MTABE5 95 : * ENDIF 96 : * 97 : DO 21 ISOUEL=1,N1 98 : ISOU = N45 * (ISOUEL - 1) 99 : IMODEL = KMODEL(ISOUEL) 100 : SEGACT IMODEL 101 : NFOR = FORMOD(/2) 102 : NMAT = MATMOD(/2) 103 : MN3 = INFMOD(/1) 104 : nobmod=tymode(/2) 105 : NM2 = NM2 + NFOR 106 : NM3 = NM3 + NMAT 107 : NM4 = NM4 + MN3 108 : nm7=nm7+nobmod 109 : llmova=0 110 : llmoma=0 111 : llfama=0 112 : ITABE1(ISOU+1) = IMAMOD 113 : ITABE1(ISOU+2) = NEFMOD 114 : ITABE1(ISOU+3) = NFOR 115 : ITABE1(ISOU+4) = NMAT 116 : * ITABE1(ISOU+5) = IPDPGE 117 : * IF(IONIVE.GE.4) THEN 118 : ITABE1(ISOU+5) = MN3 119 : ITABE5(idecmo*(ISOUEL-1) +1)=CONMOD(1:8) 120 : ITABE5(idecmo*(ISOUEL-1) +2)=CONMOD(9:16) 121 : ITABE5(idecmo*(ISOUEL-1) +3)=CONMOD(17:24) 122 : ITABE5(idecmo*(ISOUEL-1) +4)=CMATEE 123 : * ENDIF 124 : ITABE1(ISOU+6) = IPDPGE 125 : ITABE1(ISOU+7)= IMATEE 126 : ITABE1(ISOU+8)=INATUU 127 : DO iou=1,14 128 : nomid=lnomid(iou) 129 : nbrobl=0 130 : nbrfac=0 131 : if(nomid.ne.0) then 132 : segact nomid 133 : nbrobl=lesobl(/2) 134 : nbrfac=lesfac(/2) 135 : endif 136 : nm6=nm6+nbrobl+nbrfac 137 : itabe1(isou+7+2*IOU)=nbrobl 138 : itabe1(isou+8+2*IOU)=nbrfac 139 : ENDDO 140 : ITABE1(ISOU+37)=nobmod 141 : ITABE1(ISOU+38)=ideriv 142 : do iyu=1,16 143 : itabe9(iyu+(isouel-1)*16)=infele(iyu) 144 : enddo 145 : 21 CONTINUE 146 : * 147 : * PASSAGE MATMOD ET FORMOD DE CHARACTER*8 EN CHARACTER*16 148 : * ON DECOMPOSE LE CHARACTER*16 EN DEUX CHARACTER*8 149 : * IDEM POUR CONMOD 150 : * 151 : NM2=NM2*2 152 : NM3=NM3*2 153 : * 154 : IDAN(1) = N1 155 : IDAN(2)= NM2 156 : IDAN(3)= NM3 157 : IDAN(4)= NM4 158 : idan(5)= NM5 159 : idan(6)= N45 160 : idan(7)= nm6 161 : idan(8)=nm7 161 : CALL ECDIFE(IOSAU,NIDAN,IDAN,IFORM) 161 : CALL ECDIFE(IOSAU,NM1,ITABE1,IFORM) 161 : CALL ECDIFE(IOSAU,NM9,ITABE9,IFORM) 162 : SEGSUP MTABE1 163 : IF(IONIVE.GE.4) THEN 163 : CALL ECDIFN(IOSAU,NM5,MTABE5,IFORM) 164 : SEGSUP MTABE5 165 : SEGINI,MTABE4 166 : ENDIF 167 : * 168 : SEGINI,MTABE2 169 : SEGINI,MTABE3 170 : segini,mtabe6,mtab6b 171 : segini mtabe7,mtabe8 172 : JFOR= 0 173 : JMAT= 0 174 : JINF= 0 175 : JNOMID=0 176 : Jobj=0 177 : DO 20 ISOUEL=1,N1 178 : IMODEL = KMODEL(ISOUEL) 179 : NFOR = FORMOD(/2) 180 : NMAT = MATMOD(/2) 181 : nobmod=tymode(/2) 182 : * 183 : DO 30 IFOR=1,NFOR 184 : JFOR = JFOR + 1 185 : ITABE2(JFOR) = FORMOD(IFOR)(1:8) 186 : JFOR = JFOR + 1 187 : ITABE2(JFOR) = FORMOD(IFOR)(9:16) 188 : 30 CONTINUE 189 : * 190 : DO 40 IMAT=1,NMAT 191 : JMAT = JMAT + 1 192 : ITABE3(JMAT) = MATMOD(IMAT)(1:8) 193 : JMAT = JMAT + 1 194 : ITABE3(JMAT) = MATMOD(IMAT)(9:16) 195 : 40 CONTINUE 196 : * 197 : IF(IONIVE.GE.4) THEN 198 : MN3 = INFMOD(/1) 199 : DO 50 IMN3=1,MN3 200 : JINF = JINF + 1 201 : ITABE4(JINF) = INFMOD(IMN3) 202 : 50 CONTINUE 203 : ENDIF 204 : do iou=1,14 205 : nomid = lnomid(iou) 206 : if(nomid.ne.0) then 207 : segact nomid 208 : nbrobl=lesobl(/2) 209 : if(nbrobl.ne.0)then 210 : do ityo=1,nbrobl 211 : jnomid=jnomid+1 212 : itabe6(jnomid)=lesobl (ityo) 213 : enddo 214 : endif 215 : nbrfac=lesfac(/2) 216 : if(nbrfac.ne.0)then 217 : do ityo=1,nbrfac 218 : jnomid=jnomid+1 219 : itabe6(jnomid)=lesfac (ityo) 220 : enddo 221 : endif 222 : segdes nomid 223 : endif 224 : enddo 225 : if(nobmod.ne.0) then 226 : do 51 ihy=1,nobmod 227 : jobj=jobj+1 228 : itabe7(jobj)=tymode(ihy) 229 : itabe8(jobj)=ivamod(ihy) 230 : 51 continue 231 : endif 232 : * 233 : SEGDES,IMODEL 234 : 20 CONTINUE 235 : * 235 : CALL ECDIFN(IOSAU,NM2,MTABE2,IFORM) 235 : CALL ECDIFN(IOSAU,NM3,MTABE3,IFORM) 236 : * IF(IONIVE.GE.4) THEN 236 : CALL ECDIFE(IOSAU,NM4,ITABE4,IFORM) 237 : SEGSUP MTABE4 238 : * ENDIF 238 : if(ionive.eq.13)call ecdien(iosau,nm6,mtab6b,iform) 238 : if(ionive.ge.14)call ecdifn(iosau,nm6,mtabe6,iform) 239 : segsup mtabe6 240 : if(nm7.ne.0) then 240 : call ECDIFN(IOSAU,NM7,MTABE7,IFORM) 240 : CALL ECDIFE(IOSAU,NM7,ITABE8,IFORM) 241 : endif 242 : 243 : SEGSUP MTABE2,MTABE3 244 : SEGDES,MMODEL 245 : * 246 : 10 CONTINUE 247 : * 248 : RETURN 249 : END 250 : 251 : 252 : 253 : 254 : 255 : 256 : 257 : 258 :
© Cast3M 2003 - All rights reserved.
Disclaimer