C LIMODL SOURCE MB234859 25/09/08 21:15:49 12358 *--------------------------------------------------------------------* * LECTURE D'UN NOUVEAU MODELE SUR LE FICHIER IURES. * * * * Parametres : * * * * IURES Numero du fichier de sortie * * ITLACC Pile contenant les nouveaux MODELEs * * IMAX1 Nombre de MODELEs dans la pile * * IFORM Si sauvegarde en format ou non * * * * APPELE PAR : LIPIL * *--------------------------------------------------------------------* SUBROUTINE LIMODL(IURES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMMODEL -INC SMLMOTS -INC SMELEME 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 MTAB6B CHARACTER*(4) ITAB6B(NM6) ENDSEGMENT SEGMENT,MTABE7 CHARACTER*(8) ITABE7(NM7) ENDSEGMENT SEGMENT,MTABE8 INTEGER ITABE8(NM7) ENDSEGMENT SEGMENT MTABE9 INTEGER ITABE9(NM9) ENDSEGMENT INTEGER IDAN(10) CHARACTER*16 MOMODL(10) CHARACTER*8 cma LOGICAL b_z iimpil = IIMPI c-dbg iimpil = 1972 if (iimpil.eq.1972) write(ioimp,*) 'LIMODEL niveau =',niveau C=================== NIVEAU = 26+ ==========MMODEL avec Pile IMODEL===== IF (NIVEAU.LE.25) GOTO 9925 DO in = 1, 10 IDAN(in) = 0 ENDDO NIDAN = 1 DO IEL = 1, IMAX1 IRETOU = 0 CALL LFCDIE(IURES,NIDAN,IDAN,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN N1 = IDAN(1) SEGINI,MMODEL IF (N1.GT.0) THEN IRETOU = 0 CALL LFCDIE(IURES,N1,mmodel.KMODEL,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN ENDIF SEGDES,MMODEL ITLAC(**) = MMODEL ENDDO RETURN C=================== NIVEAU < 26 ==========MMODEL complet=============== 9925 CONTINUE if (niveau.lt.4) then write(ioimp,*) 'Attention : Niveau tres ancien (< 4) !!!' write(ioimp,*) 'Relire puis sauver le fichier avec une ', & 'version de niveau intermediaire' call erreur(5) return endif NIDAN = 10 if (niveau.lt.15) NIDAN = 7 if (niveau.lt.13) NIDAN = 4 * Boucle (10) sur les MODELEs contenus dans la pile : * ----------- DO 10 IEL = 1, IMAX1 c* DO in = 1, NIDAN DO in = 1, 10 IDAN(in) = 0 ENDDO mtabe1 = 0 mtabe2 = 0 mtabe3 = 0 mtabe4 = 0 mtabe5 = 0 mtabe6 = 0 mtab6b = 0 mtabe7 = 0 mtabe8 = 0 mtabe9 = 0 IRETOU = 0 CALL LFCDIE(IURES,NIDAN,IDAN,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN N1 = IDAN(1) SEGINI,MMODEL N45 = IDAN(6) if (niveau.lt.13) then N45 = 6 if (niveau.lt.12) N45 = 5 endif NM1 = N1 * N45 NM2 = IDAN(2) NM3 = IDAN(3) NM4 = IDAN(4) NM5 = IDAN(5) idecmo = 0 IF (N1.gt.0) idecmo = NM5 / N1 if (niveau.lt.13) then idecmo = 2 NM5 = N1 * idecmo endif NM6 = IDAN(7) c* if (niveau.ge.13) then : nm6 lu sinon 0 NM7 = IDAN(8) c* if (niveau.ge.15) then : nm7 lu sinon 0 NM9 = N1 * 16 if (iimpil.eq.1972) then write(ioimp,*) 'N1, N45 = ',N1,n45 write(ioimp,*) 'nm1 nm2 nm3 nm4 nm5 nm6 nm7 nm9' write(ioimp,*) nm1, nm2 ,nm3, nm4, nm5, nm6, nm7, nm9 endif SEGINI,mtabe1,mtabe2,mtabe3,mtabe9 SEGINI,mtabe4,mtabe5 if (nm6.gt.0) then SEGINI,mtabe6,mtab6b endif if (nm7.gt.0) then SEGINI,mtabe7,mtabe8 endif CALL LFCDIE(IURES,NM1,itabe1,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN if (iimpil.eq.1972) then write(ioimp,*) ' itabe1 ' write(ioimp,fmt='(10i5)') (itabe1(in),in=1,nm1) endif IF (n45.gt.28) then CALL LFCDIE(IURES,NM9,itabe9,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN if (iimpil.eq.1972) then write(ioimp,*) ' itabe9 ' write(ioimp,fmt='(10i5)') (itabe9(in),in=1,nm9) endif ENDIF CALL LFCDIN(IURES,NM5,itabe5,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN CALL LFCDIN(IURES,NM2,itabe2,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN CALL LFCDIN(IURES,NM3,itabe3,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN CALL LFCDIE(IURES,NM4,itabe4,IRETOU,IFORM) IF (IRETOU.NE.0) RETURN if (nm6.gt.0) then if (niveau.ge.14) then CALL LFCDIN(iures,nm6,itabe6,iretou,IFORM) IF (IRETOU.NE.0) RETURN endif if (niveau.eq.13) then call lfcden(iures,nm6,itab6b,iretou,IFORM) if (iretou.ne.0) return endif endif if (nm7.gt.0) then if (niveau.ge.15) then if (iimpil.eq.1972) write(ioimp,*) 'nm7 ',nm7 CALL LFCDIN(IURES,NM7,itabe7,IRETOU,IFORM) if (iimpil.eq.1972) write(ioimp,*) 'itabe7 ',(itabe7(in),in=1,nm7) if (iretou.ne.0) return CALL LFCDIE(IURES,NM7,itabe8,IRETOU,IFORM) if (iimpil.eq.1972) write(ioimp,*) 'itabe8 ',(itabe8(in),in=1,nm7) if (iretou.ne.0) return endif endif * BOUCLE (20) SUR LES ZONES ELEMENTAIRES DU MODELE : nparmo = 0 nobmod = 0 jfor = 0 jmat = 0 jinf = 0 jnomid = 0 jobj = 0 DO 20 ISOUEL = 1, N1 ISOU = N45 * ( ISOUEL - 1 ) NFOR = itabe1(ISOU+3) NMAT = itabe1(ISOU+4) if (niveau.ge.13) nparmo = itabe1(isou+10) if (niveau.ge.15) nobmod = itabe1(isou+11) if (n45.ge.37) nobmod = itabe1(isou+37) mn3lu = itabe1(ISOU+5) MN3 = mn3lu if (n45.lt.28) MN3 = 7 MN3 = MAX(MN3,12) if (iimpil.eq.1972) write(ioimp,*) ' nparmo MN3',nparmo,MN3 SEGINI,IMODEL mmodel.KMODEL(ISOUEL) = IMODEL imodel.CONMOD = ' ' imodel.IMAMOD = itabe1(ISOU+1) imodel.NEFMOD = itabe1(ISOU+2) IF (niveau.GE.20) THEN imodel.IPDPGE = itabe1(ISOU+6) ELSE imodel.IPDPGE = 0 IF (niveau.GE.12) THEN ii_z = itabe1(ISOU+6) IF (ii_z.GT.0) THEN ipt1 = ii_z + NBANC CALL CRELEM(ipt1) C On verifie s'il n'a pas deja ete preconditionne. CALL CRECH1(ipt1,1) segdes,ipt1 imodel.IPDPGE = ipt1 ENDIF ENDIF ENDIF if (n45.ge.38) then jderiv = itabe1(isou+38) else cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL) c jderiv=mepsil jderiv = 0 endif imodel.IDERIV = jderiv imodel.CONMOD(1:8) = itabe5(idecmo*(ISOUEL-1)+1) imodel.CONMOD(9:16) = itabe5(idecmo*(ISOUEL-1)+2) if (niveau.ge.13) then imodel.CONMOD(17:24) = itabe5(idecmo*(ISOUEL-1)+3) endif c* Lecture de la formulation : DO in = 1, NFOR jfor = jfor + 1 imodel.FORMOD(in)(1:8) = itabe2(jfor) jfor = jfor + 1 imodel.FORMOD(in)(9:16) = itabe2(jfor) ENDDO DO in = 1, NMAT jmat = jmat + 1 imodel.MATMOD(in)(1:8) = itabe3(jmat) jmat = jmat + 1 imodel.MATMOD(in)(9:16) = itabe3(jmat) ENDDO c* Cas particuliers : inconv = 0 inraye = 0 do in = 1, NFOR if (imodel.FORMOD(in).eq.'CONVECTION ' ) then if (inconv.eq.0) then inconv = in NMAT = NMAT+1 SEGADJ,imodel imodel.FORMOD(in) = 'THERMIQUE ' imodel.MATMOD(NMAT) = 'CONVECTION ' else write(ioimp,*) 'CONVECTION lue > 1 !!!' endif endif if (imodel.FORMOD(in).eq.'RAYONNEMENT ' ) then if (inraye.eq.0) then inraye = in NMAT = NMAT+1 SEGADJ,imodel imodel.FORMOD(in) = 'THERMIQUE ' DO i = NMAT, 2, -1 imodel.MATMOD(i) = imodel.MATMOD(i-1) ENDDO imodel.MATMOD(1) = 'RAYONNEMENT ' else write(ioimp,*) 'RAYONNEMENT lu > 1 !!!' endif endif enddo if (inconv.ne.0 .and. inraye.ne.0) then write(ioimp,*) 'CONVECTION & RAYONNEMENT lus > 1 !!!' call erreur(5) return endif CALL PRQUOI(IMODEL) c* Lecture de INFMOD : do in = 1, mn3lu jinf = jinf + 1 imodel.INFMOD(in) = itabe4(jinf) enddo if (iimpil.eq.1972) then write(ioimp,*) ' MN3 & mn3lu',MN3,mn3lu write(ioimp,*) ' infmod',(infmod(in),in=1,mn3) endif C* Cas standard : if (niveau.ge.13) then if (n45.gt.28) then imodel.CMATEE = itabe5(idecmo*(ISOUEL-1)+4) imodel.IMATEE = itabe1(ISOU+7) imodel.INATUU = itabe1(ISOU+8) c* do iou = 1, imodel.infele(/1) do in = 1, 16 imodel.INFELE(in) = itabe9(in+(ISOUEL-1)*16) enddo c* do iou = 1, imodel.lnomid(/2) do iou = 1, 14 nbrobl = itabe1(isou+7+2*iou) nbrfac = itabe1(isou+8+2*iou) if (nbrobl+nbrfac .ne. 0) then SEGINI,nomid do in = 1, nbrobl jnomid = jnomid+1 nomid.lesobl(in) = itabe6(jnomid) enddo do in = 1, nbrfac jnomid = jnomid+1 nomid.lesfac(in) = itabe6(jnomid) enddo SEGDES,nomid imodel.LNOMID(iou) = nomid endif enddo C* Cas particuliers : else CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina) if (ierr.ne.0) return imodel.CMATEE = cma imodel.IMATEE = ima imodel.INATUU = ina lmotva = 0 lmotma = 0 lmotmf = 0 lmotpa = 0 llmova = itabe1(ISOU+7) llmoma = itabe1(ISOU+8) llfama = itabe1(ISOU+9) c-dbg write(ioimp,*)'llmova llmoma llfama',llmova,llmoma,llfama jgn = LOCOMP if (llmova.ne.0) then jgm = llmova SEGINI,mlmots do in = 1, jgm jnomid=jnomid+1 c-dbg write(ioimp,*) ' jnomid1' , jnomid mots(in) = itabe6(jnomid) enddo lmotva = mlmots endif if (llmoma.ne.0) then jgm = llmoma SEGINI,mlmots do in = 1, jgm jnomid = jnomid+1 c-dbg write(ioimp,*) ' jnomid2 ' , jnomid mots(in) = itabe6(jnomid) enddo lmotma = mlmots endif if (llfama.ne.0) then jgm = llfama SEGINI,mlmots do in = 1, jgm jnomid = jnomid+1 c-dbg write(ioimp,*) ' jnomid3 ' , jnomid mots(in)=itabe6(jnomid) enddo lmotmf = mlmots endif if (nparmo.ne.0) then jgm = nparmo SEGINI, mlmots do in = 1, nparmo jnomid=jnomid+1 mots(in)=itabe6(jnomid) enddo lmotpa = mlmots endif c-dbg write(ioimp,*) 'Ici on a FORMOD(1)=',FORMOD(1),FORMOD(/2) c-dbg write(ioimp,*) ' cmate=',cmatee,imatee,inatuu CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa) endif C* Anciens niveaux < 13 : else CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina) if (ierr.ne.0) return imodel.CMATEE = cma imodel.IMATEE = ima imodel.INATUU = ina IF (FORMOD(1).eq.'MECANIQUE ' .or. & FORMOD(1).eq.'POREUX ' .or. & FORMOD(1).eq.'DIFFUSION ' .or. & FORMOD(1).eq.'ELECTROSTATIQUE ' .or. & FORMOD(/2).eq.2) then IF (MN3.lt.12) then MN3 = 12 SEGADJ,imodel endif call prquoi(imodel) ENDIF lmotva = 0 lmotma = 0 lmotmf = 0 lmotpa = 0 CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa) endif C* Cas particuliers : c-dbg write(ioimp,*) FORMOD(1),niveau,MN3 IF (FORMOD(1).eq.'MAGNETODYNAMIQUE') THEN if (niveau.le.24 .and. MN3.lt.12) then MN3 = 12 SEGADJ,imodel call prquoi(imodel) endif ENDIF IF (FORMOD(1).eq.'CHANGEMENT_PHASE' .or. & FORMOD(1).eq.'THERMOHYDRIQUE ') THEN if (niveau.le.25 .and. MN3.lt.12) then MN3 = 12 SEGADJ,imodel call prquoi(imodel) endif ENDIF if (niveau.ge.15) then c-dbg write(ioimp,*) ' nobmod jobj',nobmod,jobj do in = 1, nobmod jobj = jobj+1 imodel.TYMODE(in) = itabe7(jobj) imodel.IVAMOD(in) = itabe8(jobj) enddo endif *Petite modification en cas de modele externe : if (imodel.FORMOD(/2).eq.1) then if (imodel.FORMOD(1).eq.'MECANIQUE ' .or. & imodel.FORMOD(1).eq.'POREUX ') then if (imodel.INATUU.GE.0) goto 200 iumat = 0 ivisc = 0 iviex = 0 do in = 1, nmat if (matmod(in).eq.'NON_LINEAIRE ') iumat = in if (matmod(in).eq.'VISCO_EXTERNE ') ivisc = in enddo if (iumat.ne.0) then if (matmod(iumat+1).ne.'UTILISATEUR ') then write(ioimp,*) 'maj modele umat incorrect' call erreur(5) return endif imodel.INATUU = -1 endif if (ivisc.ne.0) then if (imodel.INATUU.eq.-2) goto 200 c* mise a jour du modele CALL MODVIX(momodl,nmod) CALL PLACE(momodl,nmod,iviex,matmod(ivisc+1)) if (iviex.eq.0) then write(ioimp,*) 'MAJ modele IVIEX incorrect' call erreur(5) return endif imodel.INATUU = -2 nobmod = nobmod + 1 SEGADJ,imodel imodel.TYMODE(nobmod+1) = 'IVIEX ' imodel.IVAMOD(nobmod+1) = iviex endif 200 continue endif endif *Petite verification en diffusion if (FORMOD(1).eq.'DIFFUSION ') then if (niveau.lt.17) then write(ioimp,*) 'Incompatibilite de niveau !' call erreur(5) return endif *SG: Au-dessus du niveau 18, les noms d'inconnues lnomdd et lnomdu sont sauvegardes if (niveau.le.18) then call vermdi(tymode(1),tymode(2)) if (ierr.ne.0) then write(ioimp,*) 'Revoir votre mise en donnees !' call erreur(5) return endif endif endif SEGDES,IMODEL 20 CONTINUE SEGSUP,mtabe1,mtabe2,mtabe3 SEGSUP,mtabe4,mtabe5 if (nm6.gt.0) then SEGSUP,mtabe6,mtab6b endif if (nm7.gt.0) then SEGSUP,mtabe7,mtabe8 endif SEGDES,MMODEL ITLAC(**) = MMODEL 10 CONTINUE c RETURN END