C DYVOIS SOURCE BP208322 20/09/18 21:16:28 10718 SUBROUTINE DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB, & ILOCAL,IROLE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *-----------------------------------------------------------------------* * * * Opérateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Pour la liaison Ligne_Ligne ,ligne_cercle * * Donne le noeud du maillage maitre ,le plus proche de chaque , * * point esclave * * * * Paramètres * * * * e IPALB Renseigne sur la liaison. * * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. * * e XPALB Tableau contenant les paramètres de la liaison. * * * e XPTB Tableau des d{placements des points * * e NLIAB Nombre de liaisons sur la base B. * * e NPLB Nombre total de points intervenant dans les liaisons. * * e IND Indice du pas. * * e I numéro de la liaison. * * e ILOCAL Indicateur d'une recherche locale (0) ou globale (1) sur * * les noeuds du maillage. * * e IROLE Indique quel est le maillage maitre et le maillage * * esclave * * * * * * Auteur, date de création: * * * * Samuel DURAND : le 08 Aout 1996 : Création * * Ibrahim Pinto, 05/97 , liaisons ligne_cercle * *-----------------------------------------------------------------------* ************************************************************************* * * INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*) REAL*8 XPTB(NPLB,2,*),XPALB(NLIAB,*) REAL*8 XPCOM(3),XPCOB(3) * ITYP = IPALB(I,1) IDIM = IPALB(I,3) IF (ITYP.EQ.35 .OR. ITYP.EQ.37 .OR. ITYP.EQ.39) THEN ID1 = 6 ELSE ID1 = 7 ENDIF IF (IROLE.EQ.0) THEN KMAI = 0 IMAI = ID1 +4*IDIM IBUT = IMAI + (IPALB(I,21))*IDIM NNOEMA = IPALB(I,21) NNOEES = IPALB(I,22) IFERMA = IPALB(I,24) KBUT = IPALB(I,21) JVOI = 26 ELSE KMAI = IPALB(I,21) IBUT = ID1 + 4*IDIM IMAI = IBUT + (IPALB(I,21))*IDIM NNOEMA = IPALB(I,22) NNOEES = IPALB(I,21) IFERMA = IPALB(I,25) KBUT = 0 JVOI = 26+IPALB(I,22) ENDIF * IF (ILOCAL.EQ.0) THEN * DO 100 IESC=1,NNOEES * IDESC = IBUT+(IESC-1)*IDIM IFMOIN = 1 IFPLUS = 1 * Recherche locale IM = IPALB(I,JVOI+IESC) XPOS = 0.D0 DO 400 ID=1,IDIM IDM = IMAI + (IM-1)*IDIM + ID XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+IM),1,ID) XPCOB(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),1,ID) XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*(XPCOM(ID)-XPCOB(ID)) 400 CONTINUE XPOS = SQRT(XPOS) XREF = XPOS IREF = IM IPLUS = IM+1 IMOIN = IM-1 410 CONTINUE IF (IMOIN.EQ.0) THEN IF (IFERMA.EQ.0) THEN IFMOIN = 0 ELSE IMOIN = NNOEMA ENDIF ENDIF IF (IPLUS.EQ.(NNOEMA+1)) THEN IF (IFERMA.EQ.0) THEN IFPLUS = 0 ELSE IPLUS = 1 ENDIF ENDIF IF (IFMOIN.NE.0) THEN XPOS = 0.D0 DO 412 ID=1,IDIM IDL = IMAI + (IMOIN-1)*IDIM + ID XPCOM(ID) = XPALB(I,IDL) &+XPTB(IPLIB(I,KMAI+IMOIN),1,ID) XPCOB(ID) = XPALB(I,IDESC+ID) &+XPTB(IPLIB(I,KBUT+IESC),1,ID) XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))* &(XPCOM(ID)-XPCOB(ID)) 412 CONTINUE XPOS = SQRT(XPOS) IF (XPOS.LT.XREF) THEN XREF = XPOS IREF = IMOIN IMOIN = IMOIN-1 ELSE IFMOIN = 0 ENDIF ENDIF IF (IFPLUS.NE.0) THEN XPOS = 0.D0 DO 414 ID=1,IDIM IDN = IMAI + (IPLUS-1)*IDIM + ID XPCOM(ID) = XPALB(I,IDN) &+XPTB(IPLIB(I,KMAI+IPLUS),1,ID) XPCOB(ID) = XPALB(I,IDESC+ID) &+XPTB(IPLIB(I,KBUT+IESC),1,ID) XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))* &(XPCOM(ID)-XPCOB(ID)) 414 CONTINUE XPOS = SQRT(XPOS) IF (XPOS.LT.XREF) THEN XREF = XPOS IREF = IPLUS IPLUS = IPLUS+1 ELSE IFPLUS = 0 ENDIF ENDIF IF ((IFMOIN.EQ.0).AND.(IFPLUS.EQ.0)) GOTO 420 GOTO 410 420 CONTINUE IPALB(I,JVOI+IESC) = IREF * 100 CONTINUE ELSE DO 200 IESC=1,NNOEES * Recherche globale XPOS = 0.D0 * Premier noeud du maillage IDESC = IBUT+(IESC-1)*IDIM DO 422 ID=1,IDIM IDM = IMAI + ID XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+1),1,ID) XPCOB(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),1,ID) XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))*(XPCOM(ID)-XPCOB(ID)) 422 CONTINUE XREF = XPOS IREF = 1 DO 424 IM=2,NNOEMA XPOS = 0.D0 DO 426 ID=1,IDIM IDM = IMAI + (IM-1)*IDIM + ID XPCOM(ID) = XPALB(I,IDM) +XPTB(IPLIB(I,KMAI+IM),1,ID) XPCOB(ID) = XPALB(I,IDESC+ID) &+XPTB(IPLIB(I,KBUT+IESC),1,ID) XPOS = XPOS +(XPCOM(ID)-XPCOB(ID))* &(XPCOM(ID)-XPCOB(ID)) 426 CONTINUE XPOS = SQRT(XPOS) IF (XPOS.LT.XREF) THEN XREF = XPOS IREF = IM ENDIF 424 CONTINUE IPALB(I,JVOI+IESC) = IREF 200 CONTINUE ENDIF * END