C CYNE20 SOURCE OF166741 25/02/20 21:15:59 12165 SUBROUTINE CYNE20(ILIB,IWRK52,itruli) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * voir dyne20.eso * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Remplissage des tableaux de description des liaisons sur * * la base @ partir des informations contenues dans la * * table ILIB. * * * * Parametres: * * * * e ILIB Table rassemblant la description des liaisons * * es KTLIAB Segment descriptif des liaisons sur la base B. * * * * * * Parametres de dimensionnement pour une liaison sur base: * * * * NIPALB : nombre de parametres pour definir le type des * * liaisons (NIPALB est fixe e 3). * * NXPALB : nombre maxi de parametres internes definissant les * * liaisons. * * NPLBB : nombre maxi de points intervenant dans une liaison. * * * * NPLB : nombre total de points. * * NLIAB : nombre total de liaisons. * * * * * * Tableaux fortran pour les liaisons sur base B : * * * * XPALB(NLIAB,NXPALB) : parametres de la liaison. * * IPALB(NLIAB,NIPALB) : renseigne sur le type de liaison. * * et les eventuelles conditions * * XABSCI Tableau contenant les abscisses de la loi plastique * * pour les liaisons point-point- ... -plastique * * XORDON Tableau contenant les ordonnees de la loi plastique * * pour les liaisons point-point- ... -plastique * * * * JPLIB(NPLB) : numero global des points. * * IPLIB(NLIAB,NPLBB) : numeros locaux des points concernes par * * la liaison. * * * * Icorres Pour garder le numero du pointeur des tables de * * liaison * * * * * * Auteur, date de creation: * * * * Lionel VIVAN, le 21 Septembre 1989. * * E de LANGRE 08/94 laisns conditionnelles * * I. Pinto 05/97, liaisons ligne_cercle,appels a dyn207 * * * *--------------------------------------------------------------------* * ** voir DYNE20.ESO remplissage segment MTPHI *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMEVOLL -INC SMLREEL -INC SMMODEL -INC SMCHAML -INC SMELEME -INC SMCHPOI -INC DECHE -INC SMTABLE ** segment sous-structures dynamiques segment struli integer itlia,itbmod,momoda, mostat,itmail,molia integer ldefo(np1),lcgra(np1),lsstru(np1) integer nsstru,nndefo,nliab,nsb,na2,idimb integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0) INTEGER ICHAIN endsegment * SEGMENT,NCPR(nbpts) * segment dimensionnement pour LIAISONS * 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 MLIGNE INTEGER KPLIB(NPLB) ENDSEGMENT * SEGMENT,MTPHI INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) INTEGER IAROTA(NSB) REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) ENDSEGMENT * Segment pour Champoints SEGMENT,MSAM integer jplibb(NPLB) ENDSEGMENT SEGMENT,MTRA INTEGER IPLA(NTRA) ENDSEGMENT SEGMENT MOLIAI integer modtla,modtlb ENDSEGMENT * * LOGICAL Lo1,L0,log1,lvar,lmodyn,lva1 LOGICAL LPERM,LINTER,LECRO,LELAS,REPRIS CHARACTER*40 CMOT,MONMOT,CMOT1 ,MONECR,CMOT2 CHARACTER*8 MONAMO,MONSEUIL,TYPRET,MARAID,MONPER CHARACTER*16 CHARRE CHARACTER*8 TYPREG,MONREC,MONJEU,MONSYM,MONELA,MONINTER CHARACTER*8 MONESC,MONRAY,MONCAL,MONINV CHARACTER*4 NOMTRI(6),NOMAXI(6),NOMPLA(3) REAL*8 XAXROT(3),XDROTA(2,3) DATA NOMAXI/'UR ','UT ','UZ ','RR ','RT ','RZ '/ DATA NOMPLA/'UX ','UY ','RZ '/ DATA NOMTRI/'UX ','UY ','UZ ','RX ','RY ','RZ '/ struli = itruli wrk52 = iwrk52 imodel = ilib segact imodel * fabrique la table de sortie * call crtabl(its1) itsort = its1 L1 = 1 N1 = 1 n3 = 6 segini mchelm itcara = mchelm * kich : reconstruit un mchaml ad hoc : ne pas oublier qu il s agit * de reutilisation . n2 = valmat(/1) segini mchaml ichaml(1) = mchaml imache(1) = imamod conche(1) = conmod do jn2 = 1,n2 nomche(jn2) = commat(jn2) typche(jn2) = tyval(jn2) ielval(jn2) = ivalma(jn2) if(nomche(jn2).eq.'SORT') then if (ielval(jn2).eq.0) then call crtabl(ipsort) else melval = ielval(jn2) * segact melval ipsort = ielche(1,1) if (typche(jn2).ne.'POINTEURTABLE') then MOTERR(1:16) = typche(jn2) MOTERR(17:20) = nomche(jn2) MOTERR(21:36) = ' utile ' CALL ERREUR(552) return endif endif c* mtab1 = ipsort c* segact mtab1 call ecrobj('TABLE',ipsort) call indeta call lirobj('TABLE ',ITAC,1,IRETOU) CALL DIMEN7 (ITAC,IDIMEN) INDICE = 0 5100 CONTINUE INDICE = INDICE + 1 TYPRET = ' ' CALL ACCTAB(ITAC,'ENTIER',INDICE,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,LVA1,ITTL) IF (TYPRET.EQ.'MMODEL ' .AND. ITTL.NE.0) THEN mmode1 = ittl ipttl = ittl segact mmode1 * on attend une liaison elementaire imode1 = mmode1.kmodel(1) segact imode1 if (imode1.conmod.eq.conmod.or.imode1.imamod.eq.imamod) then TYPRET = ' ' CALL ACCTAB(IPSORT,'MMODEL ',I0,X0,' ',L0,ITTL, & TYPRET,I1,X1,CHARRE,LVAR,ITVAR) CALL ECCTAB(ITS1,'MMODEL',0,0.D0,' ',.TRUE.,ittl, & TYPRET,I1,X1,CHARRE,LVAR,ITVAR) goto 5010 endif ENDIF IF(INDICE.LE.IDIMEN) GOTO 5100 endif 5010 continue enddo 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 lmodyn = .true. np = 1 nins = 1 repris = .false. idimb1 = idimb nplb1 = nplb moliai = molia imolia = moliai segact moliai klia = 0 klib = 0 if (modtla.ne.0) then mmode1 = modtla segact mmode1 klia = mmode1.kmodel(/1) endif if (modtlb.ne.0) then mmode1 = modtlb segact mmode1 klib = mmode1.kmodel(/1) endif na1 = 0 nmost0 = 0 if (momoda.gt.0) then mmode2 = momoda segact mmode2 nmost0 = mmode2.kmodel(/1) na1 = nmost0 endif if (mostat.gt.0) then mmode2 = mostat segact mmode2 na1 = na1 + mmode2.kmodel(/1) endif * nliab = klib nliabl=nliab SEGINI,MTLIAB KTLIAB = MTLIAB IF (NLIAB.NE.0) THEN NCPR = kcpr LCPR =nbpts IN = 0 DO 18 I = 1,LCPR IF (NCPR(I).NE.0) THEN IN = IN + 1 JPLIB(IN) = I ENDIF 18 CONTINUE * segement ncpr detruit dans devini ENDIF * * Gestion de la table definissant les resultats attendus: * ( par la suite, on s'occupera de TREDU ) * jchain = ichain ikpref = kpref * if (klia.le.0) klia = 1 CALL DYNE15(ITS1,iKPREF,NA1,NP,NINS,IMOLIA,iktres,jtmail,REPRIS, & JCHAIN,NTVAR,klia,nliabl,nplb1,idimb1,MTRA,ITCARA, &lmodyn,nmost0) IF (IERR.NE.0) RETURN KTRES = iktres itmail = jtmail ichain = jchain * Creation des objets resultats : * SEGINI,MSAM KSAM=MSAM DO 100 IP=1,NPLB JPLIBB(IP)=JPLIB(IP) 100 CONTINUE itkm = 0 jtmail = itmail JTRES = KTRES JPREF = KPREF lmodyn = .true. NPLAA = 0 NXPALA= 0 CALL DYNE17(1,ITKM,jtmail,JTRES,JPREF,NPLAA,NXPALA,KSAM,lmodyn) IF (IERR.NE.0) RETURN MSAM=KSAM SEGSUP,MSAM * mchelm = itcara segact mchelm do im3 = 1,ichaml(/1) mchaml = ichaml(im3) segsup mchaml enddo segsup mchelm * * model élémentaire * II = 0 * imodel = ilib segact imodel ipt8 = imamod segact ipt8 imod = ipt8.num(1,1) inoa = ipt8.num(1,1) isup = ipt8.num(1,1) I = jliaib 51 continue TYPRET = ' ' MONSEUIL = ' ' *--------------------------------------------------------------------* * --- choc elementaire POINT_PLAN_FLUIDE *--------------------------------------------------------------------* if (cmatee.eq.'PO_PL_FL') then ITYP = 7 IPOI = int(valmat(1)) XINER = valmat(2) XCONV = valmat(3) XVISC = valmat(4) XPCEL = valmat(5) XPCRA = valmat(6) XJEU = valmat(7) IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,1) = XINER XPALB(I,2) = XCONV XPALB(I,3) = XVISC XPALB(I,4) = XPCEL XPALB(I,5) = XPCRA XPALB(I,6) = XJEU * IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 70 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 70 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF ID1 = 6 DO 72 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 72 CONTINUE * end do CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) IPLIB(I,1) = IPLAC * * *--------------------------------------------------------------------* * ------ choc elementaire POINT_PLAN_FROTTEMENT *--------------------------------------------------------------------* * else if(cmatee.eq.'PO_PL_FR') then ITYP = 3 MARAID = ' ' TYPRET = ' ' MONAMO = ' ' IPOI = int(valmat(1)) if (valmat(2).gt.0.) then xrain = valmat(2) MARAID = 'FLOTTANT' endif XJEU = valmat(3) XGLIS = valmat(4) XADHE = valmat(5) XRAIT = valmat(6) XAMOT = valmat(7) if (valmat(/1).gt.7) then if (valmat(8).gt.0.) then xamon = valmat(8) MONAMO = 'FLOTTANT' endif if (tyval(9)(9:16).eq.'EVOLUTIO') then ipevo = int(valmat(9)) TYPRET = 'EVOLUTIO' endif endif IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN CALL ERREUR(891) RETURN ENDIF IF (TYPRET.EQ.'EVOLUTIO') THEN ITYP = 103 XRAIN = 0.d0 ENDIF IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,1) = XRAIN XPALB(I,2) = XJEU XPALB(I,3) = XGLIS XPALB(I,4) = XADHE XPALB(I,5) = XRAIT XPALB(I,6) = XAMOT IF (MONAMO.EQ.'FLOTTANT') THEN XPALB(I,7) = XAMON ELSE XPALB(I,7) = 0.D0 ENDIF * NORMALE IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 20 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 20 CONTINUE IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF cbp,2020 ID1 = 7 ID1 = 9 DO 22 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 22 CONTINUE IF (IPALB(I,1) .EQ. 103) THEN MEVOLL = IPEVO * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) * Ici, on recupere les abscisses et les ordonnees de l'evolution dans * des tableaux xabsci et xordon SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 NIP = XABSCI(/2) DO 26 MM=1,NIP XABSCI (I,MM) = MLREE1.PROG(MM) XORDON (I,MM) = MLREE2.PROG(MM) 26 CONTINUE SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ENDIF * CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) IPLIB(I,1) = IPLAC * *--------------------------------------------------------------------* * ------ choc elementaire POINT_PLAN *--------------------------------------------------------------------* else if(cmatee.eq.'PO_PL') then ITYP = 1 IPERM = 0 XPALB(I,3) = 0.D0 MONSEUIL =' ' TYPRET= ' ' IPOI = int(valmat(1)) xraid = valmat(2) xjeu = valmat(3) if (ivalma(6).gt.0) then MONSEUIL ='FLOTTANT' xseuil = valmat(6) endif xamon = valmat(7) XPALB(I,3) = XAMON if (ivalma(4).gt.0) then ipevo = int(valmat(4)) TYPRET = 'EVOLUTIO' endif *? if (valmat(5).ne.0) IPERM = 1 IPALB(I,1) = ITYP IPALB(I,3) = IDIM IPALB(I,4) = IPERM XPALB(I,1) = XRAID XPALB(I,2) = XJEU * IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 17 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 17 CONTINUE * IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF ID1 = 3 IF (MONSEUIL .EQ.'FLOTTANT') THEN IF (TYPRET .EQ. 'EVOLUTIO') THEN IPALB(I,1) = 101 ELSE IPALB(I,1) = 100 ENDIF ID1 = 4 XPALB(I,ID1) = XSEUIL ELSE IF (TYPRET .EQ. 'EVOLUTIO') THEN IPALB(I,1) = 102 ENDIF ENDIF * DO 12 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 12 CONTINUE * IF (IPALB(I,1) .EQ. 101 .OR. IPALB(I,1) .EQ. 102) THEN MEVOLL = IPEVO * * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) * Ici, on recupere les abscisses et les ordonnees de l'evolution dans * des tableaux xabsci et xordon * SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 NIP = XABSCI(/2) * DO 16 MM=1,NIP XABSCI (I,MM) = MLREE1.PROG(MM) XORDON (I,MM) = MLREE2.PROG(MM) 16 CONTINUE * SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ENDIF * c IMOD = num(1,1) CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) IPLIB(I,1) = IPLAC * *--------------------------------------------------------------------* * ------ choc elementaire POINT_POINT_FROTTEMENT *--------------------------------------------------------------------* else if (cmatee.eq.'PO_PO_FR') then ITYP = 13 MARAID = ' ' MONPER = ' ' MONAMO = ' ' TYPRET = ' ' TYPREG = ' ' CHARRE = ' ' igibe = 0 IPOI = int(valmat(1)) xraid = valmat(2) xjeu = valmat(3) INOB = int(valmat(4)) xadhe = valmat(5) xrait = valmat(6) xamot = valmat(7) xglis = valmat(8) if (valmat(/1).gt.8) then if (tyval(10)(9:16).eq.'EVOLUTIO') then ipevo = int(valmat(10)) TYPRET = 'EVOLUTIO' endif if (tyval(11)(1:6).eq.'ENTIER') then igibe = int(valmat(11)) TYPREG = 'MOT' if (igibe.eq.1) CHARRE = 'NEDJAI-GIBERT' endif if (tyval(9)(1:6).eq.'REAL*8') then xamon = valmat(9) MONAMO='FLOTTANT' endif endif IF (IERR.NE.0) RETURN ** dans quel cas monamo est il entier? PV ** IF (MONAMO .EQ. 'ENTIER ') THEN ** XAMON = 1.D0*I0 ** MONAMO = 'FLOTTANT' ** ENDIF IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN CALL ERREUR(891) RETURN ENDIF IF (TYPRET.EQ.'EVOLUTIO') THEN ITYP = 113 XRAID = 0.d0 ENDIF * IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,1) = XRAID XPALB(I,2) = XJEU XPALB(I,3) = XGLIS XPALB(I,4) = XADHE XPALB(I,5) = XRAIT XPALB(I,6) = XAMOT IF (MONAMO.EQ.'FLOTTANT') THEN XPALB(I,7) = XAMON ELSE XPALB(I,7) = 0.D0 ENDIF * cas particulier pas tres orthodoxe pour Gibert * on passe a ityp = -13 et on modifie et ajoute * devlb2, devlb1-->devfb2--->dgcha4--->dgchfr--->dgchgl, devso4 IF (TYPREG.EQ.'MOT') THEN IF (CHARRE.EQ.'NEDJAI-GIBERT') THEN IPALB(I,1) = -13 ELSE CALL ERREUR(891) RETURN ENDIF ELSEIF (IGIBE.NE.0) THEN CALL ERREUR(891) RETURN ENDIF * * normalisation de la normale * IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 420 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 420 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF DO 422 ID = 1,IDIM ID2 = 7 + ID XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 422 CONTINUE * end do * IF (IPALB(I,1) .EQ. 113) THEN MEVOLL = IPEVO * * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) * Ici, on recupere les abscisses et les ordonnees de l'evolution dans * des tableaux xabsci et xordon * SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 NIP = XABSCI(/2) * DO 424 MM=1,NIP XABSCI (I,MM) = MLREE1.PROG(MM) XORDON (I,MM) = MLREE2.PROG(MM) 424 CONTINUE * SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ENDIF * CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) IPLIB(I,1) = IPLAC CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) IPLIB(I,2) = IPLAC * *--------------------------------------------------------------------* * ------ choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE *--------------------------------------------------------------------* else if(cmatee.eq.'PO_PO_DP') then ITYP = 16 MARAID = ' ' MONPER = ' ' LPERM = .false. IPERM = 0 MONAMO = ' ' TYPRET = ' ' IPOI = int(valmat(1)) IECRO = int(valmat(2)) * IECRO = 1 <= isotrope , IECRO = 2 <= cinematique LECRO = .true. if (iecro.eq.1) monecr = 'ISOTROPE' if (iecro.eq.2) monecr = 'CINEMATIQUE' xjeu = valmat(3) inob = int(valmat(4)) * IPERM = 2 <= isotrope , IPERM = 3 <= cinematique if (valmat(5).gt.0) LPERM = .true. IPERM = int(valmat(5)) IPEVO = int(valmat(6)) if (tyval(10)(9:16).eq.'EVOLUTIO') then TYPRET = 'EVOLUTIO' endif if (valmat(/1).gt.6) then xamon = valmat(7) MONAMO='FLOTTANT' endif IF (IERR.NE.0) RETURN IF (LPERM) THEN IF (.NOT.(XJEU.EQ.0.D0)) THEN * WRITE (*,*) 'Liaison permanente, mise a zero du jeu.' XJEU = 0.D0 ENDIF IF (IPERM.ne.3.and.IPERM.ne.2) THEN call erreur(21) RETURN ENDIF ENDIF * MEVOLL = IPEVO * * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) * Ici, on recupere les abscisses et les ordonnees de l'evolution dans * des tableaux xabsci et xordon * SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 NIP = XABSCI(/2) * DO 426 MM=1,NIP XABSCI (I,MM) = MLREE1.PROG(MM) XORDON (I,MM) = MLREE2.PROG(MM) 426 CONTINUE * SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL * IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,1) = XJEU IPALB(I,5) = IPERM * * normalisation de la normale * IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 30 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 30 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF IF (MONAMO.EQ.'FLOTTANT') THEN IPALB(I,1) = 17 XPALB(I,2) = XAMON DO 32 ID = 1,IDIM ID2 = 2 + ID XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 32 CONTINUE * end do ELSE DO 34 ID = 1,IDIM ID2 = 1 + ID XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 34 CONTINUE * end do ENDIF * CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) IPLIB(I,1) = IPLAC CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) IPLIB(I,2) = IPLAC * *--------------------------------------------------------------------* * ------ choc elementaire POINT_POINT_ROTATION_PLASTIQUE *--------------------------------------------------------------------* else if(cmatee.eq.'PO_PO_RP') then ITYP = 50 MARAID = ' ' MONPER = ' ' MONELA = ' ' LPERM = .FALSE. LELAS = .FALSE. LECRO = .FALSE. IPERM = 0 MONAMO = ' ' TYPRET = ' ' IPOI = int(valmat(1)) IECRO = int(valmat(2)) * IECRO = 1 <= isotrope , IECRO = 2 <= cinematique LECRO = .true. if (iecro.eq.1) monecr = 'ISOTROPE' if (iecro.eq.2) monecr = 'CINEMATIQUE' xjeu = valmat(3) inob = int(valmat(4)) * iperm = -2 : liaison elastique permanente * iperm = -1 : choc elastique * iperm = 0 : donnees incoherentes ou insuffisantes * iperm = 1 : choc plastique * iperm = 2 : liaison plastique isotrope * iperm = 3 : liaison plastique cinematique if (valmat(5).gt.0) LPERM = .true. IPERM = int(valmat(5)) IPEVO = int(valmat(6)) if (tyval(10)(9:16).eq.'EVOLUTIO') then TYPRET = 'EVOLUTIO' endif if (valmat(/1).gt.6) then xamon = valmat(7) if (valmat(7).gt.0) MONAMO='FLOTTANT' if (valmat(8).gt.0) LELAS = .true. endif IF (IERR.NE.0) RETURN IF (LPERM) THEN IF (LELAS.AND.(.NOT.LECRO)) IPERM = -2 IF (MONECR.EQ.'ISOTROPE'.AND.(.NOT.LELAS)) IPERM = 2 IF (MONECR.EQ.'CINEMATIQUE'.AND.(.NOT.LELAS)) IPERM = 3 IF (.NOT.(XJEU.EQ.0.)) THEN * WRITE(*,*) 'Liaison permanente, mise a zero du jeu.' XJEU = 0.D0 ENDIF ELSE IF (.NOT.LECRO) THEN IF (LELAS) THEN IPERM = -1 ELSE IPERM = 1 ENDIF ENDIF ENDIF IF (IPERM.EQ.0) THEN CALL ERREUR(905) RETURN ENDIF * MEVOLL = IPEVO * * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) * Ici, on recupere les abscisses et les ordonnees de l'evolution dans * des tableaux xabsci et xordon * SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 * NIP = MLREE1.PROG(/1) NIP = XABSCI(/2) * DO 110 MM=1,NIP XABSCI (I,MM) = MLREE1.PROG(MM) XORDON (I,MM) = MLREE2.PROG(MM) 110 CONTINUE * SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL * IPALB(I,1) = ITYP IPALB(I,3) = IDIM IPALB(I,5) = IPERM XPALB(I,1) = XJEU * * normalisation de l'axe de rotation * IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 120 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 120 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF IF (MONAMO.EQ.'FLOTTANT') THEN IPALB(I,1) = 51 XPALB(I,2) = XAMON DO 122 ID = 1,IDIM ID2 = 2 + ID XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 122 CONTINUE * end do ELSE DO 124 ID = 1,IDIM ID2 = 1 + ID XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 124 CONTINUE * end do ENDIF * CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) IPLIB(I,1) = IPLAC CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) IPLIB(I,2) = IPLAC * * *--------------------------------------------------------------------* * ------ choc elementaire POINT_POINT *--------------------------------------------------------------------* else if(cmatee.eq.'PO_PO') then ITYP = 11 MARAID = ' ' MONPER = ' ' LPERM = .FALSE. IPERM = 0 MONAMO = ' ' TYPRET = ' ' IPOI = int(valmat(1)) XRAID = valmat(2) if (valmat(2).gt.0) MARAID = 'FLOTTANT' XJEU = valmat(3) INOB = int(valmat(4)) IPERM = int(valmat(5)) if (IPERM.gt.0) LPERM = .true. if (valmat(/1).gt.5) then xamon = valmat(6) if (valmat(6).gt.0) MONAMO='FLOTTANT' IPEVO = int(valmat(7)) if (tyval(7)(9:16).eq.'EVOLUTIO') then TYPRET = 'EVOLUTIO' endif endif IF (IERR.NE.0) RETURN IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN CALL ERREUR(891) RETURN ENDIF * IF (TYPRET.EQ.'EVOLUTIO') THEN ITYP = 111 XRAID = 0.d0 ENDIF IPALB(I,1) = ITYP IPALB(I,3) = IDIM IPALB(I,4) = IPERM XPALB(I,1) = XRAID XPALB(I,2) = XJEU * * normalisation de la normale * IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 111 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 111 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF IF (MONAMO.EQ.'FLOTTANT') THEN XPALB(I,3) = XAMON ELSE XPALB(I,3) = 0.d0 ENDIF DO 112 ID = 1,IDIM ID2 = 3 + ID XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 112 CONTINUE * end do * IF (IPALB(I,1) .EQ. 111) THEN MEVOLL = IPEVO * * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) * Ici, on recupere les abscisses et les ordonnees de l'evolution dans * des tableaux xabsci et xordon * SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 NIP = XABSCI(/2) * DO 116 MM=1,NIP XABSCI (I,MM) = MLREE1.PROG(MM) XORDON (I,MM) = MLREE2.PROG(MM) 116 CONTINUE * SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ENDIF * CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) IPLIB(I,1) = IPLAC CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) IPLIB(I,2) = IPLAC * *--------------------------------------------------------------------* * ------ choc elementaire POINT_CERCLE_MOBILE *--------------------------------------------------------------------* else if(cmatee.eq.'PO_CE_MO') then ITYP = 33 MONAMO = ' ' MARAID = ' ' MONINTER = ' ' LINTER = .true. IPOI = int(valmat(1)) xraid = valmat(2) if (valmat(2).gt.0) MARAID = 'FLOTTANT' INOB = int(valmat(3)) XRAYO = valmat(4) XGLIS = valmat(5) XADHE = valmat(6) XRAIT = valmat(7) XAMOT = valmat(8) if (valmat(/1).gt.8) then xamon = valmat(10) if(valmat(10).gt.0) MONAMO = 'FLOTTANT' xinter = valmat(9) if(valmat(9).gt.0) LINTER = .FALSE. endif IF (IERR.NE.0) RETURN IPALB(I,1) = ITYP IPALB(I,3) = IDIM cbp IPALB(I,4) = 1 IF (.NOT.LINTER) THEN cbp IPALB(I,4) = 0 cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles ITYP=ITYP+100 IPALB(I,1) = ITYP ENDIF XPALB(I,1) = XRAID XPALB(I,2) = XRAYO XPALB(I,3) = XGLIS XPALB(I,4) = XADHE XPALB(I,5) = XRAIT XPALB(I,6) = XAMOT * * normalisation de la normale * IPNV = (IDIM + 1) * (IPOI - 1) IPNOA = (IDIM + 1) * (INOA - 1) IPNOB = (IDIM + 1) * (INOB - 1) PS = 0.D0 DO 202 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 202 CONTINUE *** IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF IF (MONAMO.EQ.'FLOTTANT') THEN IPALB(I,1) = 34 XPALB(I,7) = XAMON ID1 = 7 ELSE ID1 = 6 ENDIF ID2 = ID1 + IDIM DO 222 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID) 222 CONTINUE CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) IPLIB(I,1) = IPLAC CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) IPLIB(I,2) = IPLAC * * *--------------------------------------------------------------------* * ----- choc elementaire POINT_CERCLE_FROTTEMENT *--------------------------------------------------------------------* * else if(cmatee.eq.'PO_CE_FR') then ITYP = 23 MONAMO = ' ' MARAID = ' ' MONINTER = ' ' LINTER = .true. IPOI = int(valmat(1)) XRAIN = valmat(2) if (valmat(2).gt.0) MARAID = 'FLOTTANT' IEXC = int(valmat(3)) XRAYO = valmat(4) XGLIS = valmat(5) XADHE = valmat(6) XRAIT = valmat(7) XAMOT = valmat(8) if (valmat(/1).gt.8) then xamon = valmat(10) if(valmat(10).gt.0) MONAMO = 'FLOTTANT' xinter = valmat(9) if(valmat(9).gt.0) LINTER = .FALSE. else xamon=0.D0 endif IF (IERR.NE.0) RETURN * IPALB(I,1) = ITYP IPALB(I,3) = IDIM IF (.NOT.LINTER) THEN ITYP=ITYP+100 IPALB(I,1) = ITYP ENDIF XPALB(I,1) = XRAIN XPALB(I,2) = XRAYO XPALB(I,3) = XGLIS XPALB(I,4) = XADHE XPALB(I,5) = XRAIT XPALB(I,6) = XAMOT cbp,2020 IF (MONAMO.EQ.'FLOTTANT') THEN cbp,2020 IPALB(I,1) = 24 XPALB(I,7) = XAMON cbp,2020 ID1 = 7 cbp,2020 : ajout 3 reels pour la regularisation + Ventrainement ID1 = 10 cbp,2020 ELSE cbp,2020 ID1 = 6 cbp,2020 ENDIF * * normale au Cercle et excentrement IPNV = (IDIM + 1) * (IPOI - 1) IPEX = (IDIM + 1) * (IEXC - 1) PS = 0.D0 DO 320 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 320 CONTINUE IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF ID2 = ID1 + IDIM DO 322 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) XPALB(I,ID2+ID) = XCOOR(IPEX + ID) 322 CONTINUE CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) IPLIB(I,1) = IPLAC * else if(cmatee.eq.'PO_CE') then ITYP = 21 MARAID = ' ' MONPER = ' ' MONAMO = ' ' TYPRET = ' ' IPOI = int(valmat(1)) XRAID = valmat(2) if (valmat(2).gt.0) MARAID = 'FLOTTANT' IEXC = int(valmat(3)) XRAYO = valmat(4) if (valmat(/1).gt.4) then xamon = valmat(5) if(valmat(5).gt.0) MONAMO = 'FLOTTANT' endif IF (IERR.NE.0) RETURN IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,1) = XRAID XPALB(I,2) = XRAYO * * normalisation de la normale * IPNV = (IDIM + 1) * (IPOI - 1) IPEX = (IDIM + 1) * (IEXC - 1) PS = 0.D0 DO 210 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 210 CONTINUE IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF IF (MONAMO.EQ.'FLOTTANT') THEN IPALB(I,1) = 22 XPALB(I,3) = XAMON ID1 = 3 ELSE ID1 = 2 ENDIF ID2 = ID1 + IDIM DO 212 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) XPALB(I,ID2+ID) = XCOOR(IPEX + ID) 212 CONTINUE * end do CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) IPLIB(I,1) = IPLAC * else if(cmatee.eq.'CE_PL_FR') then ITYP = 5 MONAMO = ' ' IPOI = int(valmat(1)) xrain = valmat(2) XJEU = valmat(3) MARAID = 'FLOTTANT' XRAYP = valmat(4) XGLIS = valmat(5) XADHE = valmat(6) XRAIT = valmat(7) XAMOT = valmat(8) xamon = valmat(9) if (xamon.ne.0.d0) MONAMO = 'FLOTTANT' IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,1) = XRAIN XPALB(I,2) = XJEU XPALB(I,3) = XGLIS XPALB(I,4) = XADHE XPALB(I,5) = XRAIT XPALB(I,6) = XAMOT * IPNV = (IDIM + 1) * (IPOI - 1) PS = 0.D0 DO 230 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 230 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF IF (MONAMO.EQ.'FLOTTANT') THEN IPALB(I,1) = 6 XPALB(I,7) = XAMON ID1 = 7 ELSE ID1 = 6 ENDIF ID8 = ID1 + 7*IDIM XPALB(I,ID8+1) = XRAYP DO 232 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 232 CONTINUE * end do CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) IPLIB(I,1) = IPLAC * else if(cmatee.eq.'CE_CE_FR') then ITYP = 25 MONAMO = ' ' MARAID = ' ' MONINTER = ' ' LINTER = .true. IPOI = int(valmat(1)) xrain = valmat(2) if(valmat(2).gt.0) MARAID = 'FLOTTANT' IEXC = int(valmat(3)) XRAYP = valmat(4) XGLIS = valmat(5) XADHE = valmat(6) XRAIT = valmat(7) XAMOT = valmat(8) XRAYB = valmat(9) if(valmat(10).gt.0) then xamon = valmat(10) if (valmat(10).gt.0) MONAMO = 'FLOTTANT' xinter = valmat(11) if (valmat(11).gt.0) LINTER = .false. endif IF (IERR.NE.0) RETURN * IPALB(I,1) = ITYP IPALB(I,3) = IDIM cbp IPALB(I,4) = 1 IF (.NOT.LINTER) THEN cbp IPALB(I,4) = 0 cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles ITYP=ITYP+100 IPALB(I,1) = ITYP ENDIF XPALB(I,1) = XRAIN XPALB(I,2) = XRAYB XPALB(I,3) = XGLIS XPALB(I,4) = XADHE XPALB(I,5) = XRAIT XPALB(I,6) = XAMOT * * normalisation de la normale * IPNV = (IDIM + 1) * (IPOI - 1) IPEX = (IDIM + 1) * (IEXC - 1) PS = 0.D0 DO 330 ID = 1,IDIM XC = XCOOR(IPNV + ID) PS = PS + XC * XC 330 CONTINUE * end do *** IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF IF (MONAMO.EQ.'FLOTTANT') THEN ID1 = 7 IPALB(I,1) = 26 XPALB(I,7) = XAMON ELSE ID1 = 6 ENDIF ID10 = ID1 + 9*IDIM XPALB(I,ID10+1) = XRAYP ID2 = ID1 + IDIM ID3 = ID1 + 2*IDIM DO 332 ID = 1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) XPALB(I,ID2+ID) = XCOOR(IPEX + ID) 332 CONTINUE * end do CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) IPLIB(I,1) = IPLAC * *--------------------------------------------------------------------* * ----- choc elementaire ... *--------------------------------------------------------------------* * else if(cmatee.eq.'PR_PR_IN'.OR.cmatee.eq.'PR_PR_EX') then if(cmatee.eq.'PR_PR_IN') ityp = 31 IF(cmatee.eq.'PR_PR_EX') ITYP = 32 INOR = int(valmat(1)) xraid = valmat(2) MARAID = 'FLOTTANT' IMA1 = int(valmat(3)) IMA2 = int(valmat(4)) xpuis = valmat(5) IF (IERR.NE.0) RETURN * IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,1) = XRAID XPALB(I,3) = XPUIS ID1 = 3 IP1 = 5 * * le maillage IMA1 est en {l{ment de type POI1 MELEME = IMA1 SEGACT MELEME NOMBN1 = NUM(/2) IPALB(I,4) = NOMBN1 IDP = ID1 + 5*IDIM DO 512 IE = 1,NOMBN1 IPT = NUM(1,IE) INPT = ( IDIM + 1 ) * ( IPT - 1 ) DO 514 ID = 1,IDIM XPALB(I,IDP+ID) = XCOOR(INPT + ID) 514 CONTINUE * end do IDP = IDP + IDIM 512 CONTINUE * end do SEGDES MELEME * * le maillage IMA2 est en {l{ment de type POI1 MELEME = IMA2 SEGACT MELEME NOMBN2 = NUM(/2) IPALB(I,5) = NOMBN2 DO 516 IE = 1,NOMBN2 IPT = NUM(1,IE) INPT = ( IDIM + 1 ) * ( IPT - 1 ) DO 518 ID = 1,IDIM XPALB(I,IDP+ID) = XCOOR(INPT + ID) 518 CONTINUE * end do IDP = IDP + IDIM 516 CONTINUE * end do SEGDES MELEME CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP) IPLIB(I,1) = IPLAC * * cr{ation d'un rep}re orthonorm{ dans le plan des maillages * le point origine est le premier point de IMA1 CALL DYNE28(INOR,ISUP,XPALB,NLIABl,I,ID1) IF (IERR.NE.0) RETURN * * coefficient des droites form{es par les {l{ments de IMA1 CALL DYNE29(IPALB,XPALB,NLIABl,NOMBN1,NOMBN2,I,ID1,IP1) * * position initiale de IMA2 par rapport @ IMA1 CALL DYNE30(IPALB,XPALB,NLIABl,NOMBN1,NOMBN2,I,ID1,IP1) * * calcul de la section du profil mobile CALL DYNE33(XPALB,IPALB,NLIABl,I,ID1,XSECT) XPALB(I,2) = XSECT * * *--------------------------------------------------------------------* * ----- choc elementaire ... *--------------------------------------------------------------------* else if(cmatee.eq.'LI_LI_FR') then ITYP = 35 MONJEU = ' ' MONAMO = ' ' MARAID = ' ' CMOT = ' ' MONESC = ' ' MONSYM = ' ' MONREC = ' ' INOR = 0 SEGINI MLIGNE * INOR = int(valmat(1)) IMAI = int(valmat(2)) MONESC = tyval(3)(9:16) IESC = int(valmat(3)) MELEME = IESC SEGACT MELEME if (num(/2).eq.1) then MONESC = 'POINT' IESC = num(1,1) segdes meleme endif if (valmat(4).gt.0) then if (tyval(4)(1:8).eq.'POINTEUR') then IRAIES = int(valmat(4)) MARAID = 'CHPOINT' else xraide = valmat(4) MARAID = 'FLOTTANT' endif endif IPALB(I,1) = ITYP IPALB(I,3) = IDIM c XPALB(I,3) = XGLIS c XPALB(I,4) = XADHE c XPALB(I,5) = XRAIT c XPALB(I,6) = XAMOT XPALB(I,3) = valmat(5) XPALB(I,4) = valmat(6) XPALB(I,5) = valmat(7) XPALB(I,6) = valmat(8) xjeu = valmat(9) if (xjeu.gt.0.) MONJEU = 'FLOTTANT' if (valmat(10).gt.0) then if (tyval(10)(1:8).eq.'POINTEUR') then typret=tyval(10)(9:16) iamoes = int(valmat(10)) MONAMO = 'CHPOINT' else XAMO = valmat(10) MONAMO = 'FLOTTANT' endif endif irchec = int(valmat(11)) if (irchec.gt.0) MONREC = 'MOT' if (irchec.eq.1) CMOT(1:7)= 'GLOBALE' isyme = int(valmat(12)) if (isyme.gt.0) MONSYM = 'MOT' if (isyme.eq.1) CMOT1(1:7)='LOCALE' if (isyme.eq.2) CMOT1(1:4)='VRAI' if (isyme.eq.3) CMOT1(1:7)='GLOBALE' * IF (MONAMO.EQ.'CHPOINT') THEN IPALB(I,1) = 36 ID1 = 7 ELSE ID1 = 6 ENDIF * Normale au plan IF (IDIM.EQ.3) THEN if (inor.eq.0) call erreur(26) IPNO = (IDIM + 1) * (INOR - 1) PS = 0.D0 DO 80 ID = 1,IDIM XC = XCOOR(IPNO + ID) PS = PS + XC * XC 80 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF DO 81 ID=1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS) 81 CONTINUE ELSE DO 82 ID=1,IDIM XPALB(I,ID1+ID) = 0.D0 82 CONTINUE ENDIF IF (MONJEU.EQ.'FLOTTANT') THEN XPALB(I,2) = XJEU ELSE XPALB(I,2) = 0.D0 ENDIF * La recherche s'effectue par defaut localement IF (MONREC.EQ.'MOT') THEN IF (CMOT(1:7).EQ.'GLOBALE') THEN IPALB(I,23) = 1 ELSE IPALB(I,23) = 0 ENDIF ELSE IPALB(I,23) = 0 ENDIF * Coordonnees du maillage_maitre MELEME = IMAI SEGACT MELEME * Pour savoir si le contour est ferme NELEMA = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN NNOEMA = NELEMA IFERMA = 1 ELSE NNOEMA = NELEMA +1 IFERMA = 0 ENDIF IPALB(I,21) = NNOEMA IPALB(I,24) = IFERMA ID2 = ID1 + 4*IDIM IPT = NUM(1,1) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,1) = IPLAC KPLIB(1) = IPT DO 84 ID=1,IDIM XPALB(I,ID2+ID) = XCOOR(INPT+ID) 84 CONTINUE DO 85 IE=1,(NNOEMA-1) IPT = NUM(2,IE) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,IE+1) = IPLAC KPLIB(IE+1) = IPT IDIE = ID2 + IE*IDIM DO 86 ID=1,IDIM XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 86 CONTINUE 85 CONTINUE SEGDES MELEME * Maillage_esclave ID3 = ID2 + NNOEMA*IDIM IF (MONESC.EQ.'POINT') THEN * La ligne esclave est un point NNOEES=1 IFERES=0 ISYMET=-1 * Lecture des coordonnees IPESC = (IDIM+1)*(IESC-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IESC) IPLIB(I,NNOEMA+1) = IPLAC KPLIB(NNOEMA+1) = IESC DO 90 ID = 1,IDIM XPALB(I,ID3+ID) = XCOOR(IPESC+ID) 90 CONTINUE * IPALB(I,22) = NNOEES IPALB(I,25) = IFERES IPALB(I,26) = ISYMET ELSE IF (MONESC.EQ.'MAILLAGE') THEN * La ligne esclave est un maillage MELEME = IESC SEGACT MELEME * Pour savoir si le contour est ferme NELEES = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN NNOEES = NELEES IFERES = 1 ELSE NNOEES = NELEES +1 IFERES = 0 ENDIF IPALB(I,22) = NNOEES IPALB(I,25) = IFERES * Coordonnees du maillage_esclave IPT = NUM(1,1) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,NNOEMA+1) = IPLAC KPLIB(NNOEMA+1) = IPT DO 94 ID=1,IDIM XPALB(I,ID3+ID) = XCOOR(INPT+ID) 94 CONTINUE DO 95 IE=1,(NNOEES-1) IPT = NUM(2,IE) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,NNOEMA+IE+1) = IPLAC KPLIB(NNOEMA+IE+1) = IPT IDIE = ID3 + IE*IDIM DO 96 ID=1,IDIM XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 96 CONTINUE 95 CONTINUE SEGDES MELEME * Le traitement symetrique par defaut ne s'effectue pas IF (MONSYM.EQ.'MOT') THEN IF (CMOT1(1:7).EQ.'LOCALE') THEN IPALB(I,26) = 1 ELSE IF (CMOT1(1:4).EQ.'VRAI'.OR. & CMOT1(1:7).EQ.'GLOBALE') THEN IPALB(I,26) = 0 ELSE IPALB(I,26) = -1 ENDIF ENDIF ELSE IPALB(I,26) = -1 ENDIF ELSE * La ligne esclave n'est ni un point ni un maillage * CALL ERREUR(...) RETURN ENDIF ENDIF * Lecture des chpoints de raideur et d amortissement * Raideurs des noeuds esclaves et maitres ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM MCHPOI=IRAIES SEGACT,MCHPOI NSOUP=IPCHP(/1) DO 700 IPC=1,NSOUP MSOUPO=IPCHP(IPC) SEGACT,MSOUPO MELEME = IGEOC SEGACT,MELEME MPOVAL = IPOVAL SEGACT,MPOVAL NNN = NUM(/2) DO 711 INN=1,NNN IPT = NUM(1,INN) CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) IF (IPLAC.NE.0) THEN XPALB(I,ID4+IPLAC)=VPOCHA(INN,1) ENDIF 711 CONTINUE SEGDES,MPOVAL,MELEME SEGDES MSOUPO 700 CONTINUE SEGDES,MCHPOI * Amortissement des noeuds esclaves et maitres ID5=ID4+NNOEMA+NNOEES IF (IPALB(I,1).EQ.36) THEN MCHPOI=IAMOES SEGACT,MCHPOI NSOUP = IPCHP(/1) DO 121 IPC=1,NSOUP MSOUPO=IPCHP(IPC) SEGACT,MSOUPO MELEME = IGEOC SEGACT,MELEME MPOVAL = IPOVAL SEGACT,MPOVAL NNN=NUM(/2) DO 130 INN=1,NNN IPT = NUM(1,INN) CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) IF (IPLAC.NE.0) THEN XPALB(I,ID5+IPLAC)=VPOCHA(INN,1) ENDIF 130 CONTINUE SEGDES MPOVAL,MELEME SEGDES MSOUPO 121 CONTINUE SEGDES MCHPOI ENDIF SEGSUP MLIGNE *--------------------------------------------------------------------* * ----- choc elementaire LIGNE_CERCLE_FROTTEMENT *--------------------------------------------------------------------* else if(cmatee.eq.'LI_CE_FR') then * * --- choc élémentaire LIGNE_CERCLE_FROTTEMENT * avec ou sans amortissement * ITYP = 37 MONJEU = ' ' MONAMO = ' ' MARAID = ' ' CMOT = ' ' MONESC = ' ' MONSYM = ' ' MONREC = ' ' INOR = 0 SEGINI MLIGNE IMAI = int(valmat(2)) MONESC = tyval(3)(9:16) IESC = int(valmat(3)) MELEME = IESC SEGACT MELEME if (num(/2).eq.1) then MONESC = 'POINT' IESC = num(1,1) segdes meleme endif IRAIES = int(valmat(4)) XGLIS = valmat(5) XADHE = valmat(6) XRAIT = valmat(7) XAMOT = valmat(8) * if (valmat(/1).gt.8) MONAMO = tyval(9)(9:16) IAMOES = int(valmat(9)) * if (valmat(/1).gt.8) MONREC = tyval(10) iorec = int(valmat(10)) if (iorec.eq.1) CMOT='VRAI' * if (valmat(/1).gt.8) MONRAY = tyval(11) XRAY = valmat(11) if (valmat(/1).gt.8) MONCAL = tyval(12) iotnor = int(valmat(12)) if (iotnor.eq.1) CMOT2='VRAI' * IPALB(I,1) = ITYP IPALB(I,3) = IDIM XPALB(I,3) = XGLIS XPALB(I,4) = XADHE XPALB(I,5) = XRAIT XPALB(I,6) = XAMOT * IF (MONCAL.EQ.'ENTIER') THEN IF (CMOT2(1:4).EQ.'VRAI') THEN IPALB(I,1)=39 ENDIF ENDIF IF (MONAMO.EQ.'CHPOINT') THEN IPALB(I,1) = IPALB(I,1)+1 ID1 = 7 ELSE ID1 = 6 ENDIF * Normale aux butees ou au cylindre enveloppant le segment IF (IDIM.EQ.3) THEN INOR = int(valmat(1)) IF (IERR.NE.0) RETURN IPNO = (IDIM + 1) * (INOR - 1) PS = 0.D0 DO 3780 ID = 1,IDIM XC = XCOOR(IPNO + ID) PS = PS + XC * XC 3780 CONTINUE * end do IF (PS.LE.0.D0) THEN CALL ERREUR(162) RETURN ENDIF DO 3781 ID=1,IDIM XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS) 3781 CONTINUE ELSE DO 3782 ID=1,IDIM XPALB(I,ID1+ID) = 0.D0 3782 CONTINUE ENDIF IF (MONRAY.EQ.'FLOTTANT') THEN XPALB(I,2) = XRAY ELSE XPALB(I,2) = 0.D0 ENDIF * La recherche s'effectue par défaut localement IF (MONREC.EQ.'MOT') THEN IF (CMOT(1:7).EQ.'GLOBALE') THEN IPALB(I,23) = 1 ELSE IPALB(I,23) = 0 ENDIF ELSE IPALB(I,23) = 0 ENDIF * * Coordonnées du maillage_maitre MELEME = IMAI SEGACT MELEME * Pour savoir si le contour est fermé NELEMA = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN NNOEMA = NELEMA IFERMA = 1 ELSE NNOEMA = NELEMA +1 IFERMA = 0 ENDIF IPALB(I,21) = NNOEMA IPALB(I,24) = IFERMA ID2 = ID1 + 4*IDIM IPT = NUM(1,1) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,1) = IPLAC KPLIB(1) = IPT DO 3784 ID=1,IDIM XPALB(I,ID2+ID) = XCOOR(INPT+ID) 3784 CONTINUE DO 3785 IE=1,(NNOEMA-1) IPT = NUM(2,IE) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,IE+1) = IPLAC KPLIB(IE+1) = IPT IDIE = ID2 + IE*IDIM DO 3786 ID=1,IDIM XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 3786 CONTINUE 3785 CONTINUE SEGDES MELEME * * Maillage_esclave ID3 = ID2 + NNOEMA*IDIM IF (MONESC.EQ.'POINT') THEN * La ligne esclave est un point NNOEES=1 IFERES=0 ISYMET=-1 * Lecture des coordonnées IPESC = (IDIM+1)*(IESC-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IESC) IPLIB(I,NNOEMA+1) = IPLAC KPLIB(NNOEMA+1) = IESC DO 3790 ID = 1,IDIM XPALB(I,ID3+ID) = XCOOR(IPESC+ID) 3790 CONTINUE * IPALB(I,22) = NNOEES IPALB(I,25) = IFERES IPALB(I,26) = ISYMET ELSE IF (MONESC.EQ.'MAILLAGE') THEN * La ligne esclave est un maillage MELEME = IESC SEGACT MELEME * Pour savoir si le contour est fermé NELEES = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN NNOEES = NELEES IFERES = 1 ELSE NNOEES = NELEES +1 IFERES = 0 ENDIF IPALB(I,22) = NNOEES IPALB(I,25) = IFERES * Coordonnées du maillage_esclave IPT = NUM(1,1) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,NNOEMA+1) = IPLAC KPLIB(NNOEMA+1) = IPT DO 3794 ID=1,IDIM XPALB(I,ID3+ID) = XCOOR(INPT+ID) 3794 CONTINUE DO 3795 IE=1,(NNOEES-1) IPT = NUM(2,IE) INPT = (IDIM+1)*(IPT-1) CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) IPLIB(I,NNOEMA+IE+1) = IPLAC KPLIB(NNOEMA+IE+1) = IPT IDIE = ID3 + IE*IDIM DO 3796 ID=1,IDIM XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 3796 CONTINUE 3795 CONTINUE SEGDES MELEME MONINV=' ' if (valmat(/1).gt.8) then if (valmat(13).gt.0) then MONINV = 'LOGIQUE' Lo1 = .true. endif else endif * Le traitement symétrique ne s'effectue pas PAR DÉFAUT IF (MONINV.EQ.'LOGIQUE') THEN IF (.NOT.Lo1) THEN IPALB(I,26) = -1 ELSE IPALB(I,26) = 0 ENDIF ELSE IPALB(I,26) = -1 ENDIF ELSE * La ligne esclave n'est ni un point ni un maillage * CALL ERREUR(...) RETURN ENDIF ENDIF * Lecture des chpoints de raideur et d amortissement * Raideurs des noeuds esclaves et maitres ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM MCHPOI=IRAIES SEGACT,MCHPOI NSOUP=IPCHP(/1) DO 37100 IPC=1,NSOUP MSOUPO=IPCHP(IPC) SEGACT,MSOUPO MELEME = IGEOC SEGACT,MELEME MPOVAL = IPOVAL SEGACT,MPOVAL NNN = NUM(/2) DO 37110 INN=1,NNN IPT = NUM(1,INN) CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) IF (IPLAC.NE.0) THEN XPALB(I,ID4+IPLAC)=VPOCHA(INN,1) ENDIF 37110 CONTINUE SEGDES,MPOVAL,MELEME SEGDES MSOUPO 37100 CONTINUE SEGDES,MCHPOI * Amortissement des noeuds esclaves et maitres ID5=ID4+NNOEMA+NNOEES IF (IPALB(I,1).EQ.38 .OR. IPALB(I,1).EQ.40) THEN MCHPOI=IAMOES SEGACT,MCHPOI NSOUP = IPCHP(/1) DO 37120 IPC=1,NSOUP MSOUPO=IPCHP(IPC) SEGACT,MSOUPO MELEME = IGEOC SEGACT,MELEME MPOVAL = IPOVAL SEGACT,MPOVAL NNN=NUM(/2) DO 37130 INN=1,NNN IPT = NUM(1,INN) CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) IF (IPLAC.NE.0) THEN XPALB(I,ID5+IPLAC)=VPOCHA(INN,1) ENDIF 37130 CONTINUE SEGDES MPOVAL,MELEME SEGDES MSOUPO 37120 CONTINUE SEGDES MCHPOI ENDIF SEGSUP MLIGNE * *--------------------------------------------------------------------* * ----- choc elementaire PALIER_FLUIDE (RODELI) *--------------------------------------------------------------------* else if(cmatee.eq.'PA_FL_RO') then ITYP = 60 MONMOT='RODELI' MTLIAB = KTLIAB * NUML = I IP1 = imod IF (IERR.NE.0) RETURN CALL PLACE2(JPLIB,NPLB,IPLAC,IP1) IPLIB(NUML,1) = IPLAC * * Valeurs de IPALB et XPALB communes à tous les types de * paliers fluides : * IPALB(NUML,1) = ITYP IPALB(NUML,2) = 0 IPALB(NUML,3) = 3 IPALB(NUML,4) = 0 * XPALB(NUML,4) = valmat(1) XPALB(NUML,6) = valmat(2) XPALB(NUML,1) = valmat(3) XPALB(NUML,2) = valmat(4) XPALB(NUML,3) = valmat(5) XPALB(NUML,7) = valmat(6) XPALB(NUML,8) = valmat(7) XPALB(NUML,9) = valmat(8) XPALB(NUML,5) = valmat(9) itgeom = int(valmat(10)) * IF (MONMOT.EQ.'RODELI'.and.itgeom.gt.0) THEN * ----- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li * IPALB(NUML,5) = 1 CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0, & 'ENTIER',NLOB,X1,' ',Lo1,IP1) IF (IERR.NE.0) RETURN IPALB(NUML,6) = NLOB C Nombre de parametres reels : NBPR = 6 IPALB(NUML,7) = NBPR CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0, & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1) XPALB(NUML,10) = X1 IF (IERR.NE.0) RETURN DO 610 ILOB = 1, NLOB * CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0, & 'TABLE',I1,X1,' ',Lo1,ITLOB) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0, & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1) XPALB(NUML,11+NBPR*(ILOB-1)) = X1 IF (IERR.NE.0) RETURN CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0, & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1) XPALB(NUML,12+NBPR*(ILOB-1)) = X1 IF (IERR.NE.0) RETURN CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0, & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1) XPALB(NUML,13+NBPR*(ILOB-1)) = X1 IF (IERR.NE.0) RETURN CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0, & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1) XPALB(NUML,14+NBPR*(ILOB-1)) = X1 ANGDEB = X1 IF (IERR.NE.0) RETURN CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0, & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1) XPALB(NUML,15+NBPR*(ILOB-1)) = X1 AMPLIT=X1 IF (IERR.NE.0) RETURN CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0, & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1) XPALB(NUML,16+NBPR*(ILOB-1)) = X1 IF (IERR.NE.0) RETURN CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0, & 'ENTIER',I1,X1,' ',Lo1,IP1) cbp2018 IPALB(NUML,7+ILOB) = I1 NMAIL=I1 CALL COS208(ANGDEB,AMPLIT,NMAIL,KLREEL) IPALB(NUML,7+ILOB) = KLREEL c on ecrit ce listreel dans la table afin qu'il ne soit pas c supprime si menage pendant l'execution (concerne pasapas) CALL ECCTAB(ITLOB,'MOT',0,0.d0,'COSSIN',.false.,0, & 'LISTREEL',0,0.d0,' ',.false.,KLREEL) IF (IERR.NE.0) RETURN 610 CONTINUE ENDIF * else c write(6,*) 'verifier nom liaison', cmatee call erreur(5) return endif * * traiter liaisons conditionnelles * if (.false.) then DO I = 1,kmodel(/1) ksi = 0 imodel = kmodel(I) segact imodel if (tymode(/2).gt.0) then do 722 ilc = 1,tymode(/2) do j =1,kmodel(/1) if (kmodel(j).eq.ivamod(ilc)) then ksi = ksi + 1 ipalb(i,4) = 1 IF (tymode(ilc).EQ.'CONDINFE' ) THEN ipalb (i,4+ksi) = j ELSE IF (tymode(ilc).EQ.'CONDSUPE' ) THEN ipalb (i,4+ksi) = -1 * j ENDIF endif goto 722 enddo 722 continue endif 723 continue ENDDO endif * ranger segdes ipt8 * 10 CONTINUE * * * ----- liaisons conditionnelles ? * IF (IIMPI.EQ.333) THEN c NLIAB = IPALB(/1) c NIPALB = IPALB(/2) c NXPALB = XPALB(/2) c NPLBB = IPLIB(/2) c NPLB = JPLIB(/1) DO 1000 IN = 1,NLIAB DO 1002 II = 1,NIPALB WRITE(IOIMP,*)'cYNE20 : IPALB(',IN,',',II,') =',IPALB(IN,II) 1002 CONTINUE DO 1004 IX = 1,NXPALB WRITE(IOIMP,*)'cYNE20 : XPALB(',IN,',',IX,') =',XPALB(IN,IX) 1004 CONTINUE DO 1006 IP = 1,NPLBB WRITE(IOIMP,*)'cYNE20 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP) 1006 CONTINUE 1000 CONTINUE DO 1008 IP = 1,NPLB WRITE(IOIMP,*)'cYNE20 : JPLIB(',IP,') =',JPLIB(IP) 1008 CONTINUE ENDIF * * remplissage MTPHI * NPLSB=1 SEGINI,MTPHI KTPHI = MTPHI MTLIAB = KTLIAB * c NLIAB = IPALB(/1) c NPLB = JPLIB(/1) c NSB = XPHILB(/1) c NPLSB = XPHILB(/2) c NA2 = XPHILB(/3) c IDIMB = XPHILB(/4) IA1 = 0 do IB = 1,nsstru * * de DYNE26.ESO * IORSB(IB) = IA1 + 1 IAROTA(IB) = 0 IROT = 0 IN = 0 do 41 ik =1,ldefo(/1) if (lsstru(ik).ne.ib) goto 41 IN = IN + 1 IA1 = IA1 + 1 icdm = ldefo(ik) ** * Prise en compte d'un mode de rotation de corps rigide if (lcgra(ik).gt.0) then ICDG = lcgra(ik) IAROTA(IB)=IA1 IROT = IN endif * * IF (NLIAB.NE.0) THEN DO 42 ID = 1,IDIMB c cas AXI ou FOURIER IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN CMOT = NOMAXI(ID) ELSE c cas PLAN IF (IFOMOD.EQ.-1) THEN CMOT = NOMPLA(ID) ELSE CMOT = NOMTRI(ID) ENDIF ENDIF IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE26 : composante @ extraire :',CMOT ENDIF ICOMP = 0 DO 44 IP = 1,NPLB IPOINT = JPLIB(IP) * * On extrait du chpoint ICDM au point IPOINT de composante CMOT * CALL EXTRA9(ICDM,IPOINT,CMOT,0,.FALSE.,XVAL,IRET) ICOMP = ICOMP + 1 * * on ajuste la taille si necessaire * MP IF(ICOMP.GT.NPLSB) THEN NPLSB=ICOMP SEGADJ MTPHI ENDIF IPLSB(IP) = ICOMP * suite a la modif dans extra9, car on attribue une valeur meme * si le point n'existe pas dans le chpoint IF (XVAL.NE.0.) THEN IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN call erreur (783) RETURN ENDIF IBASB(IP) = IB ELSE IF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) IBASB(IP) = IB ENDIF * XPHILB(IB,ICOMP,IN,ID) = XVAL IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'cyne20 : IPLSB(',IP,') =',IPLSB(IP) WRITE(IOIMP,*)'cyne20 : IBASB(',IP,') =',IBASB(IP) XVA2 = XPHILB(IB,ICOMP,IN,ID) WRITE(IOIMP,*)'cyne20 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2 ENDIF 44 CONTINUE * end do 42 CONTINUE * end do ENDIF * 41 continue INMSB(IB) = IN IN = IN + 1 ** * Remplissage des fausses d?form?es modales de rotations ** 50 continue IF (IAROTA(IB).NE.0) THEN ** RIGIDE = .TRUE. MERR = 0 NPLUS = IN + 1 IF (NPLUS.GT.NA2) THEN * On r?ajuste le dimension NA2 de XPHILB NA2 = NPLUS SEGADJ MTPHI ENDIF DO 118 IP=1,NPLB IPOINT=JPLIB(IP) IPOS=IPLSB(IP) IBBAS= IBASB(IP) IF (IBBAS.EQ.IB) THEN DO 220 ID=(IDIM+1),IDIMB XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID) 220 CONTINUE * En tridimensionnel l'axe de rotation est le vecteur propre de rotation * On norme l axe du plan de rotation CALL DYNE41(XAXROT,MERR,IDIM) * En bidimensionnel l'axe de rotation est fixe * Calcul des fausses d?form?es modales de rotation CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR) DO 622 ID =1,IDIMB XPHILB(IB,IPOS,IN,ID) = XDROTA(1,ID) XPHILB(IB,IPOS,IN+1,ID)= XDROTA(2,ID) 622 CONTINUE ENDIF 118 CONTINUE ENDIF IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE26 : INMSB(',IB,') =',INMSB(IB) WRITE(IOIMP,*)'DYNE26 : IORSB(',IB,') =',IORSB(IB) WRITE(IOIMP,*)'DYNE26 : IAROTA(',IB,') =',IAROTA(IB) ENDIF * IF (IERR.NE.0) RETURN * fin boucle sousstructure enddo RETURN END