C DEVALO SOURCE CB215821 20/11/04 21:16:09 10766 SUBROUTINE DEVALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS, & ITSORT,ITREDU,KPREF,KTQ,KTKAM,KTPHI,KTLIAA, & KTLIAB,KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS, & ICHAIN,KOCLFA,KOCLB1,ITCARA,LMODYN) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Dimensionnement des tableaux de travail ( allocation de la * * memoire ). * * * * Parametres: * * * * e ITBAS Table representant une base modale * * e ITKM Table contenant les matrices XK et XM * * e ITA Table contenant la matrice XASM * * e ITLIA Table rassemblant la description des liaisons * * e ITCHAR Table contenant les chargements * * e ITINIT Table donnant les conditions initiales * * e NP Nombre de pas de calcul * * e PDT Valeur du pas de temps * * e NINS On veut une sortie tous les NINS pas de calcul * * e ITSORT Table definissant les resultats attendus * * e ITREDU Table contenant les noms d'inconnues de la base B * * auxquelles on se restreint * * e KPREF Segment des points de reference * * s MTQ Segment contenant les variables generalisees * * (et les travaux) * s MTKAM Segment contenant les vecteurs XK, XASM et XM * * s MTPHI Segment contenant les deformees modales * * s MTLIAA Segment descriptif des liaisons en base A * * s MTLIAB Segment descriptif des liaisons en base B * * s MTFEX Segment contenant les chargements libres * * s MTPAS Segment des variables au cours d'un pas de temps * * s MTRES Segment de sauvegarde des resultats * * s MTNUM Segment contenant les parametres temporels * * s IPMAIL Maillage de reference pour les CHPOINTs resultats * * s REPRIS Vrai si reprise de calcul, faux sinon * * s ICHAIN Segment MLENTI (ACTIF) contenant les adresses des * * chaines dans la pile des mots de CCNOYAU * * s KOCLFA Segment contenant les tableaux locaux de la subroutine * * DEVLFA * * s KOCLB1 Segment contenant les tableaux locaux de la subroutine * * DEVLB1 * * * * Auteur, date de creation: * * * * Denis ROBERT-MOUGIN, le 25 mai 1989. * * NTRA passe a 10000 le 28/1/93 par D. R. * *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMMODEL -INC SMELEME -INC SMCHAML -INC SMLENTI * * Segment des variables generalisees: * SEGMENT,MTQ REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) REAL*8 WEXT(NA1,2),WINT(NA1,2) ENDSEGMENT * * Segment contenant les matrices XK, XASM et XM: * SEGMENT,MTKAM REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M) REAL*8 XOPER(NB1,NB1,NOPER) ENDSEGMENT * * Segment des deformees modales: * SEGMENT,MTPHI INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) INTEGER IAROTA(NSB) REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) ENDSEGMENT * * Segment descriptif des liaisons en base A: * SEGMENT,MTLIAA INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA) REAL*8 XPALA(NLIAA,NXPALA) ENDSEGMENT * * Segment descriptif des liaisons en base B: * SEGMENT MTLIAB INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) REAL*8 XPALB(NLIAB,NXPALB) REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) ENDSEGMENT * * Segment representant les chargements libres: * SEGMENT,MTFEX REAL*8 FEXA(NPFEXA,NPC1,2) REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB) REAL*8 FTEXB(NPLB,NPC1,2,IDIM) * INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB) ENDSEGMENT * * Segment contenant les variables au cours d'un pas de temps: * SEGMENT,MTPAS REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1) REAL*8 XPTB(NPLB,2,IDIMB),FINERT(NA1,4) REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR) REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB) ENDSEGMENT * * Segment de sauvegarde des resultats (active dans DYNE15) : * SEGMENT,MTRES REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) REAL*8 XMREP(NLIAB,4,IDIMB) INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP) INTEGER ILIRES(NRESLI,NCRES) INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) INTEGER ILPOLA(NLIAA,2) ENDSEGMENT * * Segment contenant les parametres temporels: * SEGMENT,MTNUM REAL*8 XDT(NPC1),XTEMPS(NPC1) ENDSEGMENT * * Segment des points de reference: * SEGMENT,MPREF INTEGER IPOREF(NPREF) ENDSEGMENT * * Segment de points * SEGMENT,NCPR(nbpts) * * Segment de travail pour reprise force POLYNOMIALE base A * SEGMENT,MTRA INTEGER IPLA(NTRA) ENDSEGMENT * * Segment "local" pour DEVLFA ... SEGMENT,LOCLFA REAL*8 FTEST(NA1,4) ENDSEGMENT * Segment "local" pour DEVLB1 ... SEGMENT,LOCLB1 REAL*8 FTEST2(NPLB,6) ENDSEGMENT * Segment pour Champoints SEGMENT,MSAM integer jplibb(NPLB) ENDSEGMENT * segment chapeau modeles liaisons SEGMENT MOLIAI integer modtla,modtlb ENDSEGMENT * segment mwinit integer jpdep,jpvit,jrepr endsegment segment mtbas integer itbmod,lsstru(np1),nsstru endsegment segment icma(0) segment icnna2(0) LOGICAL L0,L1,REPRIS,LMODYN CHARACTER*6 MO2 CHARACTER*8 TYPRET,CHARRE CHARACTER*10 MO1 CHARACTER*40 MONMOT * ITREP = 0 MTQ = 0 MTKAM = 0 MTPHI = 0 MTLIAA = 0 MTLIAB = 0 MTFEX = 0 MTPAS = 0 MTRES = 0 MTNUM = 0 MTRA = 0 XTINI = 0.D0 ITLA = 0 ITLB = 0 REPRIS = .FALSE. * ************************************************************************ * On recupere le cas echeant, le temps de reprise: ************************************************************************ * IF (ITINIT.NE.0) THEN if (lmodyn) then mwinit = itinit segact mwinit if (jrepr.gt.0) then itrep = jrepr REPRIS = .TRUE. CALL ACCTAB(ITREP,'MOT',I0,X0,'TEMPS_DE_REPRISE',L0,IP0, & 'FLOTTANT',I1,XTINI,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN endif else TYPRET = ' ' CALL ACCTAB(ITINIT,'MOT',I0,X0,'REPRISE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITREP) IF (IERR.NE.0) RETURN IF (ITREP.NE.0) THEN IF (TYPRET.EQ.'TABLE ') THEN REPRIS = .TRUE. CALL ACCTAB(ITREP,'MOT',I0,X0,'TEMPS_DE_REPRISE',L0,IP0, & 'FLOTTANT',I1,XTINI,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN ELSE CALL ERREUR(487) RETURN ENDIF ENDIF endif ENDIF IF (IIMPI.EQ.333) write(ioimp,*)'devalo: TEMPS_DE_REPRISE=',XTINI * ************************************************************************ * Parametres temporels: pas de temps constant ************************************************************************ * NPC1 = NP + 1 SEGINI,MTNUM KTNUM = MTNUM XDT(1) = PDT XTEMPS(1) = XTINI c ancienne methode c DO 10 I = 2,NPC1 c XDT(I) = PDT c XTEMPS(I) = XTEMPS(I-1) + PDT c 10 CONTINUE c new methode (bp,2020) : on constate une derive (accumulation d'erreur) * --> on remplace par un produit (un peu + cher mais + precis) DO 10 I = 2,NPC1 XDT(I) = PDT XTEMPS(I) = XTINI + (DBLE(I-1)*PDT) 10 CONTINUE * ************************************************************************ * Recherche du nombre de modes: autant que de points de reference ************************************************************************ * MPREF = KPREF NA1 = IPOREF(/1) c on intialise NB1 a 1; le segment sera eventuellement ajuste c lors du remplissage par DEVTRA (OU D2VTRA) NB1 = 1 NB1K = 1 NB1C = 1 NB1M = 1 NOPER=0 SEGINI,MTQ,MTKAM SEGINI,LOCLFA KOCLFA = LOCLFA KTQ = MTQ KTKAM = MTKAM * ************************************************************************ * Gestion des segments descriptifs des liaisons ************************************************************************ * NLIAA = 0 NIPALA = 0 NXPALA = 0 NPLAA = 0 NPLA = 0 NLIAB = 0 NIPALB = 0 NXPALB = 0 NIP = 0 NPLBB = 0 NPLB = 0 NPLSB = 0 IDIMB = 0 NA2 = 0 NSB = 0 KCPR = 0 NTVAR = 6 + 4 * IDIM * * MTRA indiquera la presence de liaisons POLYNOMIALEs * (on suppose un maximum de 100 liaisons en base A) *+* passe a 10000 le 28/1/93 NTRA = 10000 SEGINI,MTRA * IF (ITLIA.NE.0) THEN if (lmodyn) then mtbas = itbas ipbmod = itbmod call ecrcha('MAIL') call ecrobj('MMODEL',ipbmod) call extrai call lirobj('MAILLAGE',ipt1,0,iret) if (ierr.ne.0) return if (iret.ne.1) then write(6,*) 'pb developpement devalo' return endif itmail = ipt1 segact ipt1 segini ncpr do ie = 1,ipt1.num(/2) ncpr(ipt1.num(1,ie)) = 1 enddo mmodel = itlia segact mmodel n1 = kmodel(/1) segini mmode1,mmode2 klia = 0 klib = 0 do ik = 1,kmodel(/1) imodel = kmodel(ik) segact imodel meleme = imamod segact meleme if (ncpr(num(1,1)).gt.0) then klia = klia + 1 mmode1.kmodel(klia) = imodel else klib = klib + 1 mmode2.kmodel(klib) = imodel endif enddo segdes mmodel n1 = klia itla = mmode1 segadj mmode1 n1 = klib segadj mmode2 itlb = mmode2 segsup ncpr segini moliai modtla = itla if (klia.eq.0) modtla = 0 modtlb = itlb if (klib.eq.0) modtlb = 0 * distingue liasons A et B ITLIA = MOLIAI * else * TYPRET = ' ' CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_A',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITLA) IF (IERR.NE.0) RETURN * * Liaisons sur la base A : determination des parametres * IF (ITLA.NE.0.and.(.not.lmodyn)) THEN IF (TYPRET.EQ.'TABLE ') THEN CALL DYNE21(ITLA,PDT,MTRA,KLIAA,KXPALA,KPLAA,KIPALA) IF (IERR.NE.0) RETURN NLIAA = KLIAA NIPALA = KIPALA NXPALA = KXPALA NPLAA = KPLAA NPLA = NA1 ELSE CALL ERREUR(492) RETURN ENDIF ENDIF * * Liaisons sur la base B : determination des parametres * TYPRET = ' ' CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_B',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITLB) IF (IERR.NE.0) RETURN IF (ITLB.NE.0.and.(.not.lmodyn)) THEN IF (TYPRET.EQ.'TABLE ') THEN CALL DYNE22(ITLB,KLIAB,KXPALB,KPLBB,KPLB,KDIMB,KCPR, & KIPALB,KNIP) IF (IERR.NE.0) RETURN NLIAB = KLIAB NIPALB = KIPALB NXPALB = KXPALB NPLBB = KPLBB NPLB = KPLB IDIMB = KDIMB NIP = KNIP ELSE CALL ERREUR(493) RETURN ENDIF ENDIF * endif * if (lmodyn.and.klia.gt.0) then CALL DYNE71(ITLA,PDT,MTRA,KLIAA,KXPALA,KPLAA,KIPALA) IF (IERR.NE.0) RETURN NLIAA = KLIAA NIPALA = KIPALA NXPALA = KXPALA NPLAA = KPLAA NPLA = NA1 endif if (lmodyn.and.klib.gt.0) then CALL DYNE72(ITLB,KLIAB,KXPALB,KPLBB,KPLB,KDIMB,KCPR, & KIPALB,KNIP,ITCARA) IF (IERR.NE.0) RETURN NLIAB = KLIAB NIPALB = KIPALB NXPALB = KXPALB NPLBB = KPLBB NPLB = KPLB IDIMB = KDIMB NIP = KNIP endif ENDIF SEGINI,LOCLB1 KOCLB1 = LOCLB1 * * Les segments seront remplis dans le s-p DEVLIA: * SEGINI,MTLIAA SEGINI,MTLIAB KTLIAA = MTLIAA KTLIAB = MTLIAB IF (NLIAB.NE.0) THEN NCPR = KCPR LCPR = nbpts IN = 0 DO 20 I = 1,LCPR IF (NCPR(I).NE.0) THEN IN = IN + 1 JPLIB(IN) = I ENDIF 20 CONTINUE * en do SEGSUP,NCPR ENDIF * ************************************************************************ * Segment des deformees modales: ************************************************************************ ***** Cas table BASE_MODALE et RAIDEUR_ET_MASSE ***** IF (ITKM.GT.0) THEN TYPRET = ' ' CALL ACCTAB(ITKM,'MOT',I0,X0,'BASE_MODALE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITBAS2) ELSE ITBAS2=ITBAS ENDIF c IF (ITBAS.NE.0.and.(.not.lmodyn)) THEN IF (ITBAS2.NE.0.and.(.not.lmodyn)) THEN CALL ACCTAB(ITBAS2,'MOT',I0,X0,'SOUSTYPE',L0,IP0, & 'MOT',I1,X1,MONMOT,L1,IP1) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.333) write(ioimp,*) ITBAS2,'de SOUSTYPE',MONMOT * * -Cas ou la base est unique IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN NSB = 1 NA2 = NA1 * changement de dimension en cas de corps rigide CALL ACCTAB(ITBAS2,'MOT',I0,X0,'MODES',L0,IP0, & 'TABLE',I1,X1,' ',L1,IBAS) IP = 0 22 CONTINUE IP = IP + 1 TYPRET = ' ' CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITP1) IF (IERR.NE.0) RETURN IF (TYPRET.NE.'TABLE') GOTO 23 IF (ITP1.LE.0) GOTO 23 TYPRET = ' ' CALL ACCTAB(ITP1,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0, & TYPRET,I1,X1,MONMOT,L1,IP1) IF (IERR.NE.0) RETURN IF (TYPRET.EQ.'MOT') THEN IF (MONMOT(1:4).EQ.'VRAI') THEN if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3 if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6 GOTO 23 ENDIF ENDIF GOTO 22 23 CONTINUE * -Cas ou la base est un ensemble de bases ELSE IB = 0 NA2 = 0 * changement de dimension en cas de corps rigide IR = 0 30 CONTINUE IB = IB + 1 c write(ioimp,*) IB,'ieme base de l ensemble' TYPRET = ' ' CALL ACCTAB(ITBAS2,'ENTIER',IB,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITBB) IF (IERR.NE.0) RETURN c --cas lecture table de la IB ieme base modale ok IF (ITBB.NE.0) THEN IF (TYPRET.EQ.'TABLE ') THEN CALL ACCTAB(ITBB,'MOT',I0,X0,'MODES',L0,IP0, & 'TABLE',I1,X1,' ',L1,IBAS) IF (IERR.NE.0) RETURN NNA2 = 0 IP = 0 32 CONTINUE IP = IP + 1 c write(ioimp,*) ' +',IP,'ieme mode de la ',IB,'ieme base' TYPRET = ' ' CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITPP) IF (IERR.NE.0) RETURN c --cas lecture table du IP ieme mode ok IF (ITPP.NE.0) THEN IF (TYPRET.EQ.'TABLE ') THEN * changement de dimension en cas de corps rigide IF (IR.GT.1) GOTO 24 TYPRET = ' ' CALL ACCTAB(ITPP,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0, & TYPRET,I1,X1,MONMOT,L1,IP1) IF (IERR.NE.0) RETURN IF (TYPRET.EQ.'MOT') THEN IF (MONMOT(1:4).EQ.'VRAI') THEN if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3 if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6 ENDIF ENDIF 24 CONTINUE NNA2 = NNA2 + 1 GOTO 32 c --fin du cas lecture table du IP ieme mode ok ELSE CALL ERREUR(491) RETURN ENDIF ENDIF c --fin du cas lecture table du IP ieme mode non ok NA2 = MAX(NNA2,NA2) GOTO 30 c --fin du cas lecture table de la IB ieme base modale ok ELSE CALL ERREUR(491) RETURN ENDIF ENDIF c --fin du cas lecture table de la IB ieme base modale non ok NSB = IB - 1 ENDIF * -fin distinction base modale simple / ensemble de bases NPLSB = NPLB ***** Cas table PASAPAS ***** ELSEIF (LMODYN) THEN mchelm = itcara segact mchelm n1 = imache(/1) segini icma,icnna2 mtbas = ITBAS MMODEL = ITBMOD segact MMODEL kstru = 0 do im = 1,kmodel(/1) imodel = kmodel(im) segact imodel * recherche sommaire nombre de sous-structures independantes do 46 in = 1,n1 meleme = imache(in) if (meleme.ne.imamod) goto 46 if (conche(in).ne.conmod) goto 46 segact meleme mchaml = ichaml(in) segact mchaml n2 = ielval(/1) do io = 1,n2 if (nomche(io)(1:4).eq.'CGRA') then * recherche corps rigide if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3 if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6 else if (nomche(io)(1:4).eq.'DEFO') then melval = ielval(io) segact melval * assume que le maillage modèle se réduit au point support icdef1 = ielche(1,1) call ecrcha('NOMU') call ecrcha('MAIL') call ecrobj('CHPOINT ',icdef1) call extrai call lirobj('MAILLAGE', icmaio,1,iret) if (ierr.ne.0) return if (kstru.eq.0) then kstru = 1 icma(**)=icmaio icnna2(**)=1 lsstru(im) = kstru endif if (in.gt.1) then ipt5 = icmaio do ic = 1,kstru icmic = icma(ic) CALL INTERB(icmaio,icmic,IRETIB,icinte) if (iretib.eq.0) then ipt6 = icinte segact ipt6,ipt5 if (ipt5.num(/2).eq.ipt6.num(/2)) then segsup ipt6 icnna2(ic) = icnna2(ic) + 1 lsstru(im) = ic goto 47 endif segsup ipt6 endif enddo kstru = kstru + 1 icma(**) = icmaio icnna2(**) = 1 lsstru(im) = kstru endif goto 47 endif enddo 46 continue 47 continue segdes imodel enddo NSB = icma(/1) NA2 = icnna2(1) do ic = 1,icnna2(/1) na2 = MAX(icnna2(ic),NA2) enddo nsstru = kstru segsup icma,icnna2 segdes mmodel * ENDIF * * on met NPLSB a 1 car le calcul actuel est debile * on ajuste la dimension dans dyne26 * * MP * NPLSB=1 SEGINI,MTPHI KTPHI = MTPHI * ************************************************************************ * Variables au cours d'un pas de temps: ************************************************************************ * SEGINI,MTPAS KTPAS = MTPAS * ************************************************************************ * Initialisation du segment representant les chargements ( bases A * et B ), il sera rempli dans le s-p DEVFX0: ************************************************************************ * NPFEXA = NA1 NPFEXB = 0 SEGINI,MTFEX KTFEX = MTFEX * ************************************************************************ * Gestion de la table definissant les resultats attendus: * ( par la suite, on s'occupera de TREDU ) ************************************************************************ * CALL DYNE15(ITSORT,KPREF,NA1,NP,NINS,ITLIA,KTRES,IPMAIL,REPRIS, & ICHAIN,NTVAR,NLIAA,NLIAB,NPLB,IDIMB,MTRA,ITCARA,lmodyn, & na1) IF (IERR.NE.0) RETURN MTRES = KTRES * ************************************************************************ * Creation des objets resultats : ************************************************************************ * SEGINI,MSAM KSAM=MSAM DO 100 IP=1,NPLB JPLIBB(IP)=JPLIB(IP) 100 CONTINUE CALL DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA,KSAM, & lmodyn) IF (IERR.NE.0) RETURN MSAM=KSAM SEGSUP,MSAM * ************************************************************************ * Impressions : ************************************************************************ IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DEVALO : nombre de pas de temps ',NP WRITE(IOIMP,*)'DEVALO : temps de reprise ',XTINI * WRITE(IOIMP,*)' segment MTLIAB' WRITE(IOIMP,*)' NLIAB =',IPALB(/1) WRITE(IOIMP,*)' NIPALB =',IPALB(/2) WRITE(IOIMP,*)' NXPALB =',XPALB(/2) WRITE(IOIMP,*)' NPLBB =',IPLIB(/2) WRITE(IOIMP,*)' NPLB =',JPLIB(/1) WRITE(IOIMP,*)' NIP =',XABSCI(/2) * WRITE(IOIMP,*)' segment MTLIAA' WRITE(IOIMP,*)' NLIAA =',IPALA(/1) WRITE(IOIMP,*)' NIPALA =',IPALA(/2) WRITE(IOIMP,*)' NXPALA =',XPALA(/2) WRITE(IOIMP,*)' NPLAA =',IPLIA(/2) WRITE(IOIMP,*)' NPLA =',JPLIA(/1) * WRITE(IOIMP,*)' segment MTRES' WRITE(IOIMP,*)' NLSA =',XRESLA(/1) WRITE(IOIMP,*)' NVALA =',XRESLA(/3) WRITE(IOIMP,*)' NLSB =',XRESLB(/1) WRITE(IOIMP,*)' NVALB =',XRESLB(/3) WRITE(IOIMP,*)' NRES =',XRES(/1) WRITE(IOIMP,*)' NCRES =',XRES(/2) WRITE(IOIMP,*)' NPRES =',XRES(/3) WRITE(IOIMP,*)' NREP =',XREP(/1) WRITE(IOIMP,*)' NTVAR =',ILIREB(/2) WRITE(IOIMP,*)' NLIAB =',XMREP(/1) WRITE(IOIMP,*)' IDIMB =',XMREP(/3) WRITE(IOIMP,*)' NLIAA =',ILPOLA(/1) * WRITE(IOIMP,*)' segment MTFEX' WRITE(IOIMP,*)' NPC1 =',FEXA(/2) WRITE(IOIMP,*)' NPLB =',FEXPSM(/1) WRITE(IOIMP,*)' IDIMB =',FEXPSM(/4) WRITE(IOIMP,*)' NPFEXA =',FEXA(/1) * DO 1000 IP = 1,NPLB WRITE(IOIMP,*)'DEVALO : JPLIB(',IP,') =',JPLIB(IP) 1000 CONTINUE ENDIF * RETURN END