C WRMODL SOURCE OF166741 24/12/18 21:15:40 12090 SUBROUTINE WRMODL(IOSAU,ITLACC,IDEB,IFIN,NIVEAU,IFORM) *----------------------------------------------------------------------* * Ecriture d'un MODELE sur le fichier IOSAU * * * * Parametres : * * * * IOSAU Numero du fichier de sortie * * ITLACC Pile contenant les nouveaux modeles (MMODEL) * * IDEB Indice dans la pile du premier MMODEL a traiter * * IFIN Indice dans la pile du dernier MMODEL a traiter * * NIVEAU Niveau de sauvegarde * * IFORM Si sauvegarde en format ou non * * * * Appele par : WRPIL * *----------------------------------------------------------------------* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC SMMODEL SEGMENT,ITLACC INTEGER ITLAC(0) ENDSEGMENT SEGMENT,MTABE1 INTEGER ITABE1(NM1) ENDSEGMENT SEGMENT,MTABE2 CHARACTER*(8) ITABE2(NM2) ENDSEGMENT SEGMENT,MTABE3 CHARACTER*(8) ITABE3(NM3) ENDSEGMENT SEGMENT,MTABE4 INTEGER ITABE4(NM4) ENDSEGMENT SEGMENT,MTABE5 CHARACTER*(8) ITABE5(NM5) ENDSEGMENT SEGMENT,MTABE6 CHARACTER*(8) ITABE6(NM6) ENDSEGMENT SEGMENT,MTABE7 CHARACTER*(8) ITABE7(NM7) ENDSEGMENT SEGMENT,MTABE8 INTEGER itabe8(nm7) ENDSEGMENT SEGMENT MTABE9 INTEGER itabe9(nm9) ENDSEGMENT INTEGER IDAN(10) c-dbg write(6,*) 'WRMODL : NIVEAU =',niveau C============= NIVEAU COURANT : 26 et + ================================ IF (NIVEAU.LE.25) GOTO 9925 NIDAN = 1 * -------- * BOUCLE SUR LES MODELES CONTENUS DANS LA PILE : * -------- DO IEL = IDEB, IFIN MMODEL = ITLAC(IEL) IF (MMODEL.EQ.0) then write(6,*) 'WRMODL : MMODEL = 0 pour ITLAC(',IEL,')' GOTO 10 ENDIF SEGACT,MMODEL N1 = mmodel.KMODEL(/1) IDAN(1) = N1 CALL ECDIFE(IOSAU,NIDAN,IDAN,IFORM) IF (N1 .GT. 0) THEN CALL ECDIFE(IOSAU,N1,mmodel.KMODEL,IFORM) ENDIF SEGDES,MMODEL 10 CONTINUE ENDDO * -------- RETURN C============= NIVEAUX ANCIENS < 26 ==================================== 9925 CONTINUE MN3=0 N45=38 NIDAN=10 * -------- * BOUCLE SUR LES MODELES CONTENUS DANS LA PILE : * -------- DO IEL = IDEB, IFIN MMODEL = ITLAC(IEL) IF (MMODEL.eq.0) GO TO 1025 DO INI=1,NIDAN IDAN(INI) = 0 ENDDO SEGACT,MMODEL N1 = KMODEL(/1) * * Boucles sur les zones élémentaires du MODELE: * NM1 = N1 * N45 NM2 = 0 NM3 = 0 NM4 = 0 NM6 = 0 nm7= 0 nm9=n1*16 SEGINI,MTABE1 segini mtabe9 * IF(IONIVE.GE.4) THEN * a partir du niveau 13 on stocke aussi PHAMOD IDECMO=4 NM5 = N1 * idecmo SEGINI,MTABE5 * ENDIF DO 21 ISOUEL=1,N1 ISOU = N45 * (ISOUEL - 1) IMODEL = KMODEL(ISOUEL) SEGACT IMODEL NFOR = FORMOD(/2) NMAT = MATMOD(/2) MN3 = INFMOD(/1) nobmod=tymode(/2) NM2 = NM2 + NFOR NM3 = NM3 + NMAT NM4 = NM4 + MN3 nm7=nm7+nobmod c* llmova=0 c* llmoma=0 c* llfama=0 ITABE1(ISOU+1) = IMAMOD ITABE1(ISOU+2) = NEFMOD ITABE1(ISOU+3) = NFOR ITABE1(ISOU+4) = NMAT * ITABE1(ISOU+5) = IPDPGE * IF(IONIVE.GE.4) THEN ITABE1(ISOU+5) = MN3 ITABE5(idecmo*(ISOUEL-1) +1)=CONMOD(1:8) ITABE5(idecmo*(ISOUEL-1) +2)=CONMOD(9:16) ITABE5(idecmo*(ISOUEL-1) +3)=CONMOD(17:24) ITABE5(idecmo*(ISOUEL-1) +4)=CMATEE * ENDIF ITABE1(ISOU+6) = IPDPGE ITABE1(ISOU+7)= IMATEE ITABE1(ISOU+8)=INATUU DO iou=1,14 nomid=lnomid(iou) nbrobl=0 nbrfac=0 if(nomid.ne.0) then segact nomid nbrobl=lesobl(/2) nbrfac=lesfac(/2) endif nm6=nm6+nbrobl+nbrfac itabe1(isou+7+2*IOU)=nbrobl itabe1(isou+8+2*IOU)=nbrfac ENDDO ITABE1(ISOU+37)=nobmod ITABE1(ISOU+38)=ideriv do iyu=1,16 itabe9(iyu+(isouel-1)*16)=infele(iyu) enddo 21 CONTINUE * * PASSAGE MATMOD ET FORMOD DE CHARACTER*8 EN CHARACTER*16 * ON DECOMPOSE LE CHARACTER*16 EN DEUX CHARACTER*8 * IDEM POUR CONMOD * NM2=NM2*2 NM3=NM3*2 * IDAN(1) = N1 IDAN(2) = NM2 IDAN(3) = NM3 IDAN(4) = NM4 idan(5) = NM5 idan(6) = N45 idan(7) = nm6 idan(8) = nm7 idan(9) = 0 idan(10)= 0 CALL ECDIFE(IOSAU,NIDAN,IDAN,IFORM) CALL ECDIFE(IOSAU,NM1,ITABE1,IFORM) CALL ECDIFE(IOSAU,NM9,ITABE9,IFORM) SEGSUP MTABE1 * IF(IONIVE.GE.4) THEN CALL ECDIFN(IOSAU,NM5,MTABE5,IFORM) SEGSUP MTABE5 SEGINI,MTABE4 * ENDIF * SEGINI,MTABE2 SEGINI,MTABE3 segini,mtabe6 * segini,mtab6b IF (nm7 .gt. 0) then segini mtabe7,mtabe8 END IF JFOR= 0 JMAT= 0 JINF= 0 JNOMID=0 Jobj=0 DO 20 ISOUEL=1,N1 IMODEL = KMODEL(ISOUEL) NFOR = FORMOD(/2) NMAT = MATMOD(/2) nobmod=tymode(/2) * DO 30 IFOR=1,NFOR JFOR = JFOR + 1 ITABE2(JFOR) = FORMOD(IFOR)(1:8) JFOR = JFOR + 1 ITABE2(JFOR) = FORMOD(IFOR)(9:16) 30 CONTINUE * DO 40 IMAT=1,NMAT JMAT = JMAT + 1 ITABE3(JMAT) = MATMOD(IMAT)(1:8) JMAT = JMAT + 1 ITABE3(JMAT) = MATMOD(IMAT)(9:16) 40 CONTINUE * * IF(IONIVE.GE.4) THEN MN3 = INFMOD(/1) DO 50 IMN3=1,MN3 JINF = JINF + 1 ITABE4(JINF) = INFMOD(IMN3) 50 CONTINUE * ENDIF do iou=1,14 nomid = lnomid(iou) if(nomid.ne.0) then segact nomid nbrobl=lesobl(/2) if(nbrobl.ne.0)then do ityo=1,nbrobl jnomid=jnomid+1 itabe6(jnomid)=lesobl (ityo) enddo endif nbrfac=lesfac(/2) if(nbrfac.ne.0)then do ityo=1,nbrfac jnomid=jnomid+1 itabe6(jnomid)=lesfac (ityo) enddo endif segdes nomid endif enddo if(nobmod.ne.0) then do 51 ihy=1,nobmod jobj=jobj+1 itabe7(jobj)=tymode(ihy) itabe8(jobj)=ivamod(ihy) 51 continue endif * SEGDES,IMODEL 20 CONTINUE * CALL ECDIFN(IOSAU,NM2,MTABE2,IFORM) CALL ECDIFN(IOSAU,NM3,MTABE3,IFORM) SEGSUP MTABE2,MTABE3 * if(ionive.ge.4) then CALL ECDIFE(IOSAU,NM4,ITABE4,IFORM) SEGSUP MTABE4 * endif * if(ionive.eq.13)call ecdien(iosau,nm6,mtab6b,iform) * if(ionive.ge.14) then call ecdifn(iosau,nm6,mtabe6,iform) segsup mtabe6 * endif IF (NM7.NE.0) THEN call ECDIFN(IOSAU,NM7,MTABE7,IFORM) CALL ECDIFE(IOSAU,NM7,ITABE8,IFORM) SEGSUP,MTABE7,MTABE8 END IF SEGDES,MMODEL 1025 CONTINUE ENDDO * -------- c RETURN END